diff options
| -rw-r--r-- | stdlib/camlinternalFormat.ml | 87 | ||||
| -rw-r--r-- | stdlib/pervasives.ml | 53 | ||||
| -rw-r--r-- | stdlib/pervasives.mli | 11 | ||||
| -rw-r--r-- | typing/typecore.ml | 8 |
4 files changed, 83 insertions, 76 deletions
diff --git a/stdlib/camlinternalFormat.ml b/stdlib/camlinternalFormat.ml index 5c704fb8a..c915e0329 100644 --- a/stdlib/camlinternalFormat.ml +++ b/stdlib/camlinternalFormat.ml @@ -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 = diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml index e56688f0d..6f7e27792 100644 --- a/stdlib/pervasives.ml +++ b/stdlib/pervasives.ml @@ -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. *) -let create_char_set () = - let str = string_create 32 in - for i = 0 to 31 do str.[i] <- '\000' done; - str +type mutable_char_set = bytes -(* 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 +(* Create a fresh, empty, mutable char set. *) +let create_char_set () = + (* 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 char set. *) +(* 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 - char_set.[str_ind] <- char_of_int (int_of_char char_set.[str_ind] lor mask) + 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. *) -(* 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); + bytes_set char_set' i + (char_of_int (int_of_char (string_get char_set i) lxor 0xFF)); done; - char_set' + 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 (string_get char_set str_ind) land mask) <> 0 (******************************************************************************) (* Reader count *) diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli index fb927b9be..7755af816 100644 --- a/stdlib/pervasives.mli +++ b/stdlib/pervasives.mli @@ -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 diff --git a/typing/typecore.ml b/typing/typecore.ml index 89dfd6897..5acb0b839 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -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 |