Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

convert Benoît's first patch to bytes/string 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14807 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Gabriel Scherer 2014-05-12 15:37:31 +00:00
parent 43647ba502
commit 736876eaea
4 changed files with 88 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
stdlib/camlinternalFormat.ml
View File

@ -107,41 +107,39 @@ external format_int64: string -> int64 -> string
(* Type of extensible character buffers. *)
type buffer = {
mutable ind : int;
mutable str : string;
mutable bytes : bytes;
}
(* Create a fresh buffer. *)
let buffer_create init_size = { ind = 0; str = String.create init_size }
let buffer_create init_size = { ind = 0; bytes = Bytes.create init_size }
(* Check size of the buffer and grow it if needed. *)
let buffer_check_size buf overhead =
let len = String.length buf.str in
let len = Bytes.length buf.bytes in
let min_len = buf.ind + overhead in
if min_len > len then (
let new_len = max (len * 2) min_len in
let new_str = String.create new_len in
String.blit buf.str 0 new_str 0 len;
buf.str <- new_str;
let new_str = Bytes.create new_len in
Bytes.blit buf.bytes 0 new_str 0 len;
buf.bytes <- new_str;
)
(* Add the character `c' to the buffer `buf'. *)
let buffer_add_char buf c =
buffer_check_size buf 1;
buf.str.[buf.ind] <- c;
Bytes.set buf.bytes buf.ind c;
buf.ind <- buf.ind + 1
(* Add the string `s' to the buffer `buf'. *)
let buffer_add_string buf s =
let str_len = String.length s in
buffer_check_size buf str_len;
String.blit s 0 buf.str buf.ind str_len;
String.blit s 0 buf.bytes buf.ind str_len;
buf.ind <- buf.ind + str_len
(* Get the content of the buffer. *)
let buffer_contents buf =
let str = String.create buf.ind in
String.blit buf.str 0 str 0 buf.ind;
str
Bytes.sub_string buf.bytes 0 buf.ind
(***)
@ -327,10 +325,7 @@ let string_of_formatting formatting = match formatting with
| Magic_size (str, _) -> str
| Escaped_at -> "@@"
| Escaped_percent -> "@%"
| Scan_indic c ->
let str = String.create 2 in
str.[0] <- '@'; str.[1] <- c;
str
| Scan_indic c -> "@" ^ (String.make 1 c)
(***)
@ -814,47 +809,43 @@ fun sub_fmtty fmt fmtty -> match sub_fmtty, fmtty with
let fix_padding padty width str =
let len = String.length str in
if width <= len then str else
let res = String.make width (if padty = Zeros then '0' else ' ') in
let res = Bytes.make width (if padty = Zeros then '0' else ' ') in
begin match padty with
| Left -> String.blit str 0 res 0 len
| Right -> String.blit str 0 res (width - len) len
| Zeros when len > 0 && (str.[0] = '+' || str.[0] = '-') ->
res.[0] <- str.[0];
Bytes.set res 0 str.[0];
String.blit str 1 res (width - len + 1) (len - 1)
| Zeros when len > 1 && str.[0] = '0' && (str.[1] = 'x' || str.[1] = 'X') ->
res.[1] <- str.[1];
Bytes.set res 1 str.[1];
String.blit str 2 res (width - len + 2) (len - 2)
| Zeros ->
String.blit str 0 res (width - len) len
end;
res
Bytes.unsafe_to_string res
(* Add '0' padding to int, int32, nativeint or int64 string representation. *)
let fix_int_precision prec str =
let len = String.length str in
if prec <= len then str else
let res = String.make prec '0' in
let res = Bytes.make prec '0' in
begin match str.[0] with
| ('+' | '-' | ' ') as c ->
res.[0] <- c;
Bytes.set res 0 c;
String.blit str 1 res (prec - len + 1) (len - 1);
| '0' when len > 1 && (str.[1] = 'x' || str.[1] = 'X') ->
res.[1] <- str.[1];
Bytes.set res 1 str.[1];
String.blit str 2 res (prec - len + 2) (len - 2);
| '0' .. '9' ->
String.blit str 0 res (prec - len) len;
| _ ->
assert false
end;
res
Bytes.unsafe_to_string res
(* Escape a string according to the OCaml lexing convention. *)
let string_to_caml_string str =
let esc = String.escaped str in
let len = String.length esc in
let res = String.create (len + 2) in
res.[0] <- '"'; String.blit esc 0 res 1 len; res.[len + 1] <- '"';
res
String.concat (String.escaped str) ["\""; "\""]
(* Generate the format_int first argument from an int_conv. *)
let format_of_iconv iconv = match iconv with
@ -865,17 +856,17 @@ let format_of_iconv iconv = match iconv with
| Int_o -> "%o" | Int_Co -> "%#o"
| Int_u -> "%u"
(* Generate the format_int32, format_nativeint and format_int64 first argument
from an int_conv. *)
(* Generate the format_int32, format_nativeint and format_int64 first
argument from an int_conv. *)
let format_of_aconv iconv c =
let fix i fmt = fmt.[i] <- c; fmt in
match iconv with
| Int_d -> fix 1 "% d" | Int_pd -> fix 2 "%+ d" | Int_sd -> fix 2 "% d"
| Int_i -> fix 1 "% i" | Int_pi -> fix 2 "%+ i" | Int_si -> fix 2 "% i"
| Int_x -> fix 1 "% x" | Int_Cx -> fix 2 "%# x"
| Int_X -> fix 1 "% X" | Int_CX -> fix 2 "%# X"
| Int_o -> fix 1 "% o" | Int_Co -> fix 2 "%# o"
| Int_u -> fix 1 "% u"
let seps = match iconv with
| Int_d -> ["%";"d"] | Int_pd -> ["%+";"d"] | Int_sd -> ["% ";"d"]
| Int_i -> ["%";"i"] | Int_pi -> ["%+";"i"] | Int_si -> ["% ";"i"]
| Int_x -> ["%";"x"] | Int_Cx -> ["%#";"x"]
| Int_X -> ["%";"X"] | Int_CX -> ["%#";"X"]
| Int_o -> ["%";"o"] | Int_Co -> ["%#";"o"]
| Int_u -> ["%";"u"]
in String.concat (String.make 1 c) seps
(* Generate the format_float first argument form a float_conv. *)
let format_of_fconv fconv prec =
@ -912,11 +903,7 @@ let convert_float fconv prec x =
(* Convert a char to a string according to the OCaml lexical convention. *)
let format_caml_char c =
let esc = Char.escaped c in
let len = String.length esc in
let res = String.create (len + 2) in
res.[0] <- '\''; String.blit esc 0 res 1 len; res.[len+1] <- '\'';
res
String.concat (Char.escaped c) ["'"; "'"]
(* Convert a format type to string *)
let string_of_fmtty fmtty =
@ -1807,12 +1794,14 @@ let fmt_ebb_of_string str =
(* Parse and construct a char set. *)
and parse_char_set str_ind end_ind =
if str_ind = end_ind then unexpected_end_of_format end_ind;
let char_set = create_char_set () in
match str.[str_ind] with
| '^' ->
let next_ind = parse_char_set_start (str_ind + 1) end_ind char_set in
next_ind, rev_char_set char_set
| _ -> parse_char_set_start str_ind end_ind char_set, char_set
let mut_char_set = create_char_set () in
let str_ind, reverse =
match str.[str_ind] with
| '^' -> str_ind + 1, true
| _ -> str_ind, false in
let next_ind = parse_char_set_start str_ind end_ind mut_char_set in
let char_set = freeze_char_set mut_char_set in
next_ind, (if reverse then rev_char_set char_set else char_set)
(* Parse the first character of a char set. *)
and parse_char_set_start str_ind end_ind char_set =

63
stdlib/pervasives.ml
View File

@ -169,11 +169,22 @@ external bytes_length : bytes -> int = "%string_length"
external bytes_create : int -> bytes = "caml_create_string"
external string_blit : string -> int -> bytes -> int -> int -> unit
= "caml_blit_string" "noalloc"
external bytes_get : bytes -> int -> char = "%string_safe_get"
external bytes_set : bytes -> int -> char -> unit = "%string_safe_set"
external bytes_blit : bytes -> int -> bytes -> int -> int -> unit
= "caml_blit_string" "noalloc"
external bytes_unsafe_to_string : bytes -> string = "%identity"
external bytes_unsafe_of_string : string -> bytes = "%identity"
let copy_bytes byt =
let len = bytes_length byt in
let res = bytes_create len in
bytes_blit byt 0 res 0 len;
res
let bytes_to_string byt =
bytes_unsafe_to_string (copy_bytes byt)
let ( ^ ) s1 s2 =
let l1 = string_length s1 and l2 = string_length s2 in
let s = bytes_create (l1 + l2) in
@ -222,10 +233,7 @@ let string_of_int n =
format_int "%d" n
external int_of_string : string -> int = "caml_int_of_string"
module String = struct
external get : string -> int -> char = "%string_safe_get"
external set : string -> int -> char -> unit = "%string_safe_set"
end
external string_get : string -> int -> char = "%string_safe_get"
let valid_float_lexem s =
let l = string_length s in
@ -849,32 +857,39 @@ fun fmt1 fmt2 -> match fmt1 with
(******************************************************************************)
(* Tools to manipulate scanning set of chars (see %[...]) *)
(* Create a fresh empty char set. *)
type mutable_char_set = bytes
(* Create a fresh, empty, mutable char set. *)
let create_char_set () =
let str = string_create 32 in
for i = 0 to 31 do str.[i] <- '\000' done;
str
(* Bytes.make isn't defined yet, so we'll fill manually *)
let cs = bytes_create 32 in
for i = 0 to 31 do bytes_set cs i '\000' done;
cs
(* Add a char in a mutable char set. *)
let add_in_char_set char_set c =
let ind = int_of_char c in
let str_ind = ind lsr 3 and mask = 1 lsl (ind land 0b111) in
bytes_set char_set str_ind
(char_of_int (int_of_char (bytes_get char_set str_ind) lor mask))
let freeze_char_set char_set =
bytes_to_string char_set
(* Compute the complement of a char set. *)
let rev_char_set char_set =
let char_set' = create_char_set () in
for i = 0 to 31 do
bytes_set char_set' i
(char_of_int (int_of_char (string_get char_set i) lxor 0xFF));
done;
bytes_unsafe_to_string char_set'
(* Return true if a `c' is in `char_set'. *)
let is_in_char_set char_set c =
let ind = int_of_char c in
let str_ind = ind lsr 3 and mask = 1 lsl (ind land 0b111) in
(int_of_char char_set.[str_ind] land mask) <> 0
(* Add a char in a char set. *)
let add_in_char_set char_set c =
let ind = int_of_char c in
let str_ind = ind lsr 3 and mask = 1 lsl (ind land 0b111) in
char_set.[str_ind] <- char_of_int (int_of_char char_set.[str_ind] lor mask)
(* Compute the complement of a char set. *)
(* Return a fresh string, do not modify its argument. *)
let rev_char_set char_set =
let char_set' = create_char_set () in
for i = 0 to 31 do
char_set'.[i] <- char_of_int (int_of_char char_set.[i] lxor 0xFF);
done;
char_set'
(int_of_char (string_get char_set str_ind) land mask) <> 0
(******************************************************************************)
(* Reader count *)

11
stdlib/pervasives.mli
View File

@ -1187,10 +1187,13 @@ module CamlinternalFormatBasics : sig
('f, 'b, 'c, 'e, 'g, 'h) fmt ->
('a, 'b, 'c, 'd, 'g, 'h) fmt
val create_char_set : unit -> string
val is_in_char_set : string -> char -> bool
val add_in_char_set : string -> char -> unit
val rev_char_set : string -> string
val is_in_char_set : char_set -> char -> bool
val rev_char_set : char_set -> char_set
type mutable_char_set = bytes
val create_char_set : unit -> mutable_char_set
val add_in_char_set : mutable_char_set -> char -> unit
val freeze_char_set : mutable_char_set -> char_set
val reader_nb_unifier_of_fmtty :
('a, 'b, 'c, 'd, 'e, 'f) fmtty -> ('d, 'e, 'd, 'e) reader_nb_unifier

8
typing/typecore.ml
View File

@ -2758,10 +2758,10 @@ and type_format loc str env =
| [] -> None
| [ e ] -> Some e
| _ :: _ :: _ -> Some (mk_exp_loc (Pexp_tuple args)) in
mk_exp_loc (Pexp_construct (mk_lid_loc lid, arg, true)) in
mk_exp_loc (Pexp_construct (mk_lid_loc lid, arg)) in
let mk_cst cst = mk_exp_loc (Pexp_constant cst) in
let mk_int n = mk_cst (Const_int n)
and mk_string str = mk_cst (Const_string str)
and mk_string str = mk_cst (Const_string (str, None))
and mk_char chr = mk_cst (Const_char chr) in
let mk_block_type bty = match bty with
| Pp_hbox -> mk_constr "Pp_hbox" []
@ -2831,10 +2831,10 @@ and type_format loc str env =
and mk_int_opt n_opt = match n_opt with
| None ->
let lid_loc = mk_lid_loc (Longident.Lident "None") in
mk_exp_loc (Pexp_construct (lid_loc, None, true))
mk_exp_loc (Pexp_construct (lid_loc, None))
| Some n ->
let lid_loc = mk_lid_loc (Longident.Lident "Some") in
mk_exp_loc (Pexp_construct (lid_loc, Some (mk_int n), true)) in
mk_exp_loc (Pexp_construct (lid_loc, Some (mk_int n))) in
let rec mk_reader_nb_unifier : type d1 e1 d2 e2 .
(d1, e1, d2, e2) reader_nb_unifier -> Parsetree.expression =
fun rnu -> match rnu with