diff --git a/jscomp/bin/all_ounit_tests.d b/jscomp/bin/all_ounit_tests.d index a5d04fd4b0..63753a9dd0 100644 --- a/jscomp/bin/all_ounit_tests.d +++ b/jscomp/bin/all_ounit_tests.d @@ -7,6 +7,7 @@ bin/all_ounit_tests.ml : ext/set_gen.ml bin/all_ounit_tests.ml : ext/set_int.ml bin/all_ounit_tests.ml : ext/vec_gen.ml bin/all_ounit_tests.ml : ounit/oUnit.ml +bin/all_ounit_tests.ml : ext/ext_char.ml bin/all_ounit_tests.ml : ext/ext_int.mli bin/all_ounit_tests.ml : ext/ext_json.ml bin/all_ounit_tests.ml : ext/ext_list.ml @@ -23,6 +24,7 @@ bin/all_ounit_tests.ml : ext/set_poly.ml bin/all_ounit_tests.ml : ounit/oUnit.mli bin/all_ounit_tests.ml : ext/ext_array.ml bin/all_ounit_tests.ml : ext/ext_bytes.ml +bin/all_ounit_tests.ml : ext/ext_char.mli bin/all_ounit_tests.ml : ext/ext_ident.ml bin/all_ounit_tests.ml : ext/ext_json.mli bin/all_ounit_tests.ml : ext/ext_list.mli @@ -75,6 +77,7 @@ bin/all_ounit_tests.ml : ext/string_hash_set.ml bin/all_ounit_tests.ml : ext/string_hashtbl.mli bin/all_ounit_tests.ml : stubs/bs_hash_stubs.ml bin/all_ounit_tests.ml : ext/string_hash_set.mli +bin/all_ounit_tests.ml : syntax/ast_utf8_string.ml bin/all_ounit_tests.ml : ext/hash_set_ident_mask.ml bin/all_ounit_tests.ml : ext/hash_set_ident_mask.mli bin/all_ounit_tests.ml : ext/ordered_hash_set_gen.ml diff --git a/jscomp/bin/all_ounit_tests.i.ml b/jscomp/bin/all_ounit_tests.i.ml index 24282ef1e5..f5f2d71c79 100644 --- a/jscomp/bin/all_ounit_tests.i.ml +++ b/jscomp/bin/all_ounit_tests.i.ml @@ -75,7 +75,7 @@ open OUnitTypes (** Most simple heuristic, just pick the first test. *) let simple state = - (* 157 *) List.hd state.tests_planned + (* 176 *) List.hd state.tests_planned end module OUnitUtils @@ -98,22 +98,22 @@ let is_success = let is_failure = function | RFailure _ -> (* 0 *) true - | RSuccess _ | RError _ | RSkip _ | RTodo _ -> (* 314 *) false + | RSuccess _ | RError _ | RSkip _ | RTodo _ -> (* 352 *) false let is_error = function | RError _ -> (* 0 *) true - | RSuccess _ | RFailure _ | RSkip _ | RTodo _ -> (* 314 *) false + | RSuccess _ | RFailure _ | RSkip _ | RTodo _ -> (* 352 *) false let is_skip = function | RSkip _ -> (* 0 *) true - | RSuccess _ | RFailure _ | RError _ | RTodo _ -> (* 314 *) false + | RSuccess _ | RFailure _ | RError _ | RTodo _ -> (* 352 *) false let is_todo = function | RTodo _ -> (* 0 *) true - | RSuccess _ | RFailure _ | RError _ | RSkip _ -> (* 314 *) false + | RSuccess _ | RFailure _ | RError _ | RSkip _ -> (* 352 *) false let result_flavour = function @@ -145,7 +145,7 @@ let rec was_successful = | [] -> (* 3 *) true | RSuccess _::t | RSkip _::t -> - (* 471 *) was_successful t + (* 528 *) was_successful t | RFailure _::_ | RError _::_ @@ -155,22 +155,22 @@ let rec was_successful = let string_of_node = function | ListItem n -> - (* 628 *) string_of_int n + (* 704 *) string_of_int n | Label s -> - (* 942 *) s + (* 1056 *) s (* Return the number of available tests *) let rec test_case_count = function - | TestCase _ -> (* 157 *) 1 - | TestLabel (_, t) -> (* 180 *) test_case_count t + | TestCase _ -> (* 176 *) 1 + | TestLabel (_, t) -> (* 199 *) test_case_count t | TestList l -> (* 23 *) List.fold_left - (fun c t -> (* 179 *) c + test_case_count t) + (fun c t -> (* 198 *) c + test_case_count t) 0 l let string_of_path path = - (* 314 *) String.concat ":" (List.rev_map string_of_node path) + (* 352 *) String.concat ":" (List.rev_map string_of_node path) let buff_format_printf f = (* 0 *) let buff = Buffer.create 13 in @@ -194,12 +194,12 @@ let mapi f l = let fold_lefti f accu l = (* 23 *) let rec rfold_lefti cnt accup l = - (* 202 *) match l with + (* 221 *) match l with | [] -> (* 23 *) accup | h::t -> - (* 179 *) rfold_lefti (cnt + 1) (f accup h cnt) t + (* 198 *) rfold_lefti (cnt + 1) (f accup h cnt) t in rfold_lefti 0 accu l @@ -217,7 +217,7 @@ open OUnitUtils type event_type = GlobalEvent of global_event | TestEvent of test_event let format_event verbose event_type = - (* 944 *) match event_type with + (* 1058 *) match event_type with | GlobalEvent e -> (* 2 *) begin match e with @@ -276,31 +276,31 @@ let format_event verbose event_type = end | TestEvent e -> - (* 942 *) begin + (* 1056 *) begin let string_of_result = if verbose then - (* 471 *) function - | RSuccess _ -> (* 157 *) "ok\n" + (* 528 *) function + | RSuccess _ -> (* 176 *) "ok\n" | RFailure (_, _) -> (* 0 *) "FAIL\n" | RError (_, _) -> (* 0 *) "ERROR\n" | RSkip (_, _) -> (* 0 *) "SKIP\n" | RTodo (_, _) -> (* 0 *) "TODO\n" else - (* 471 *) function - | RSuccess _ -> (* 157 *) "." + (* 528 *) function + | RSuccess _ -> (* 176 *) "." | RFailure (_, _) -> (* 0 *) "F" | RError (_, _) -> (* 0 *) "E" | RSkip (_, _) -> (* 0 *) "S" | RTodo (_, _) -> (* 0 *) "T" in if verbose then - (* 471 *) match e with + (* 528 *) match e with | EStart p -> - (* 157 *) Printf.sprintf "%s start\n" (string_of_path p) + (* 176 *) Printf.sprintf "%s start\n" (string_of_path p) | EEnd p -> - (* 157 *) Printf.sprintf "%s end\n" (string_of_path p) + (* 176 *) Printf.sprintf "%s end\n" (string_of_path p) | EResult result -> - (* 157 *) string_of_result result + (* 176 *) string_of_result result | ELog (lvl, str) -> (* 0 *) let prefix = match lvl with @@ -312,21 +312,21 @@ let format_event verbose event_type = | ELogRaw str -> (* 0 *) str else - (* 471 *) match e with - | EStart _ | EEnd _ | ELog _ | ELogRaw _ -> (* 314 *) "" - | EResult result -> (* 157 *) string_of_result result + (* 528 *) match e with + | EStart _ | EEnd _ | ELog _ | ELogRaw _ -> (* 352 *) "" + | EResult result -> (* 176 *) string_of_result result end let file_logger fn = (* 1 *) let chn = open_out fn in (fun ev -> - (* 472 *) output_string chn (format_event true ev); + (* 529 *) output_string chn (format_event true ev); flush chn), (fun () -> (* 1 *) close_out chn) let std_logger verbose = (* 1 *) (fun ev -> - (* 472 *) print_string (format_event verbose ev); + (* 529 *) print_string (format_event verbose ev); flush stdout), (fun () -> (* 1 *) ()) @@ -343,7 +343,7 @@ let create output_file_opt verbose (log,close) = (* 0 *) null_logger in (fun ev -> - (* 472 *) std_log ev; file_log ev; log ev), + (* 529 *) std_log ev; file_log ev; log ev), (fun () -> (* 1 *) std_close (); file_close (); close ()) @@ -711,7 +711,7 @@ let assert_string str = (* 0 *) if not (str = "") then (* 0 *) assert_failure str let assert_equal ?(cmp = ( = )) ?printer ?pp_diff ?msg expected actual = - (* 2001508 *) let get_error_string () = + (* 2001528 *) let get_error_string () = (* 0 *) let res = buff_format_printf (fun fmt -> @@ -951,7 +951,7 @@ let (@?) = assert_bool (* Some shorthands which allows easy test construction *) let (>:) s t = (* 0 *) TestLabel(s, t) (* infix *) -let (>::) s f = (* 157 *) TestLabel(s, TestCase(f)) (* infix *) +let (>::) s f = (* 176 *) TestLabel(s, TestCase(f)) (* infix *) let (>:::) s l = (* 23 *) TestLabel(s, TestList(l)) (* infix *) (* Utility function to manipulate test *) @@ -1087,7 +1087,7 @@ let maybe_backtrace = "" (* Run all tests, report starts, errors, failures, and return the results *) let perform_test report test = (* 1 *) let run_test_case f path = - (* 157 *) try + (* 176 *) try f (); RSuccess path with @@ -1106,22 +1106,22 @@ let perform_test report test = let rec flatten_test path acc = function | TestCase(f) -> - (* 157 *) (path, f) :: acc + (* 176 *) (path, f) :: acc | TestList (tests) -> (* 23 *) fold_lefti (fun acc t cnt -> - (* 179 *) flatten_test + (* 198 *) flatten_test ((ListItem cnt)::path) acc t) acc tests | TestLabel (label, t) -> - (* 180 *) flatten_test ((Label label)::path) acc t + (* 199 *) flatten_test ((Label label)::path) acc t in let test_cases = List.rev (flatten_test [] [] test) in let runner (path, f) = - (* 157 *) let result = + (* 176 *) let result = report (EStart path); run_test_case f path in @@ -1130,18 +1130,18 @@ let perform_test report test = result in let rec iter state = - (* 158 *) match state.tests_planned with + (* 177 *) match state.tests_planned with | [] -> (* 1 *) state.results | _ -> - (* 157 *) let (path, f) = !global_chooser state in + (* 176 *) let (path, f) = !global_chooser state in let result = runner (path, f) in iter { results = result :: state.results; tests_planned = List.filter - (fun (path', _) -> (* 12403 *) path <> path') state.tests_planned + (fun (path', _) -> (* 15576 *) path <> path') state.tests_planned } in iter {results = []; tests_planned = test_cases} @@ -1171,7 +1171,7 @@ let run_test_tt ?verbose test = time_fun perform_test (fun ev -> - (* 471 *) log (OUnitLogger.TestEvent ev)) + (* 528 *) log (OUnitLogger.TestEvent ev)) test in @@ -1766,6 +1766,8 @@ val single_colon : string val parent_dir_lit : string val current_dir_lit : string +val append_char : string -> char -> string + end = struct #1 "ext_string.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -1797,6 +1799,7 @@ end = struct +let append_char s c = (* 116 *) s ^ String.make 1 c (* {[ split " test_unsafe_obj_ffi_ppx.cmi" ~keep_empty:false ' ']} @@ -7381,13 +7384,6 @@ let decode_utf8_string s = in decode_utf8_cont s 0 (String.length s); List.rev !lst - -(** To decode {j||j} we need verify in the ast so that we have better error - location, then we do the decode later -*) - -let verify s loc = - (* 0 *) assert false end module Ext_js_regex : sig #1 "ext_js_regex.mli" @@ -14333,6 +14329,364 @@ let suites = ] end +module Ext_char : sig +#1 "ext_char.mli" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + + + + + + +(** Extension to Standard char module, avoid locale sensitivity *) + +val escaped : char -> string + + +val valid_hex : char -> bool +end = struct +#1 "ext_char.ml" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + + + + + + + +external string_unsafe_set : string -> int -> char -> unit + = "%string_unsafe_set" + +external string_create: int -> string = "caml_create_string" + +external unsafe_chr: int -> char = "%identity" + +(** {!Char.escaped} is locale sensitive in 4.02.3, fixed in the trunk, + backport it here + *) +let escaped = function + | '\'' -> (* 0 *) "\\'" + | '\\' -> (* 0 *) "\\\\" + | '\n' -> (* 0 *) "\\n" + | '\t' -> (* 0 *) "\\t" + | '\r' -> (* 0 *) "\\r" + | '\b' -> (* 0 *) "\\b" + | ' ' .. '~' as c -> + (* 0 *) let s = string_create 1 in + string_unsafe_set s 0 c; + s + | c -> + (* 0 *) let n = Char.code c in + let s = string_create 4 in + string_unsafe_set s 0 '\\'; + string_unsafe_set s 1 (unsafe_chr (48 + n / 100)); + string_unsafe_set s 2 (unsafe_chr (48 + (n / 10) mod 10)); + string_unsafe_set s 3 (unsafe_chr (48 + n mod 10)); + s + + +let valid_hex x = + (* 0 *) match x with + | '0' .. '9' + | 'a' .. 'f' + | 'A' .. 'F' -> (* 0 *) true + | _ -> (* 0 *) false +end +module Ast_utf8_string += struct +#1 "ast_utf8_string.ml" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + +let rec check_and_transform loc buf s byte_offset s_len = + (* 0 *) if byte_offset = s_len then (* 0 *) () + else + (* 0 *) let current_char = s.[byte_offset] in + match Ext_utf8.classify current_char with + | Single c -> + (* 0 *) if c = 92 (* Char.code '\\' = 92 *)then + (* 0 *) begin + (* we share the same escape sequence with js *) + Buffer.add_char buf current_char; + escape_code loc buf s (byte_offset+1) s_len + end + else + (* 0 *) begin + (if c = 34 (* Char.code '\"' = 34 *) || c = 39 (* Char.code '\'' = 39 *) then + (* 0 *) begin + Buffer.add_char buf '\\'; + Buffer.add_char buf current_char ; + + end + else (* 0 *) if c = 10 then (* 0 *) begin + (* Char.code '\n' = 10 *) + (* we can not just print new line*) + Buffer.add_string buf "\\n"; + + (* seems we don't need + escape "\b" "\f" + we need escape "\n" "\r" since + ocaml multiple-line allows [\n] + visual input while es5 string + does not + *) + end + else (* 0 *) if c = 13 then (* 0 *) begin + Buffer.add_string buf "\\r" + end + else (* 0 *) begin + Buffer.add_char buf current_char; + + end); + check_and_transform loc buf s (byte_offset + 1) s_len + end + | Invalid + | Cont _ -> (* 0 *) Location.raise_errorf ~loc "Not utf8 source string" + | Leading (n,_) -> + (* 0 *) let i' = Ext_utf8.next s ~remaining:n byte_offset in + if i' < 0 then + (* 0 *) Location.raise_errorf ~loc "Not valid utf8 souce string" + else + (* 0 *) begin + for k = byte_offset to i' do + (* 0 *) Buffer.add_char buf s.[k]; + done; + check_and_transform loc buf s (i' + 1) s_len + end +and escape_code loc buf s offset s_len = + (* 0 *) if offset >= s_len then + (* 0 *) Location.raise_errorf ~loc "\\ is the end of string" + else + (* 0 *) let cur_char = s.[offset] in + match cur_char with + | '\\' + | 'b' + | 't' + | 'n' + | 'v' + | 'f' + | 'r' + | '0' + | '$' + -> + (* 0 *) begin + Buffer.add_char buf cur_char ; + check_and_transform loc buf s (offset + 1) s_len + end + | 'u' -> + (* 0 *) begin + Buffer.add_char buf cur_char; + unicode loc buf s (offset + 1) s_len + end + | 'x' -> (* 0 *) begin + Buffer.add_char buf cur_char ; + two_hex loc buf s (offset + 1) s_len + end + | _ -> (* 0 *) Location.raise_errorf ~loc "invalid escape code" +and two_hex loc buf s offset s_len = + (* 0 *) if offset + 1 >= s_len then + (* 0 *) Location.raise_errorf ~loc "\\x need at least two chars"; + let a, b = s.[offset], s.[offset + 1] in + if Ext_char.valid_hex a && Ext_char.valid_hex b then + (* 0 *) begin + Buffer.add_char buf a ; + Buffer.add_char buf b ; + check_and_transform loc buf s (offset + 2) s_len + end + else (* 0 *) Location.raise_errorf ~loc "%c%c is not a valid hex code" a b + +and unicode loc buf s offset s_len = + (* 0 *) if offset + 3 >= s_len then + (* 0 *) Location.raise_errorf ~loc "\\u need at least four chars"; + let a0,a1,a2,a3 = s.[offset], s.[offset+1], s.[offset+2], s.[offset+3] in + if + Ext_char.valid_hex a0 && + Ext_char.valid_hex a1 && + Ext_char.valid_hex a2 && + Ext_char.valid_hex a3 then + (* 0 *) begin + Buffer.add_char buf a0; + Buffer.add_char buf a1; + Buffer.add_char buf a2; + Buffer.add_char buf a3; + check_and_transform loc buf s (offset + 4) s_len + end + else + (* 0 *) Location.raise_errorf ~loc "%c%c%c%c is not a valid unicode point" + a0 a1 a2 a3 +(* http://www.2ality.com/2015/01/es6-strings.html + console.log('\uD83D\uDE80'); (* ES6*) + console.log('\u{1F680}'); +*) + +type interpo = Text of string | Delim of string + +type ('a, 'b) either = Left of 'a | Right of 'b + +let consume_text s start_index = + (* 18 *) let rec _consume_text s index last_char new_word = + (* 101 *) if index = String.length s then (* 7 *) new_word, String.length s + else (* 94 *) begin + match s.[index] with + | '\\' -> (* 5 *) (if index + 1 = String.length s then (* 0 *) "", index else + (* 5 *) match s.[index+1] with + | '\\' -> (* 2 *) _consume_text s (index+2) ' ' (Ext_string.append_char new_word '\\') + | '$' -> (* 3 *) _consume_text s (index+2) ' ' (Ext_string.append_char new_word '$') + | c -> (* 0 *) _consume_text s (index+1) '\\' (Ext_string.append_char new_word '\\')) + | '$' -> (* 11 *) (new_word, index) + | c -> (* 78 *) _consume_text s (index + 1) c (Ext_string.append_char new_word c) + end + in _consume_text s start_index ' ' "" + +let consume_delim s start_index = + (* 22 *) let with_par = ref false in + let rec _consume_delim s index ident = + (* 59 *) if index = String.length s then (* 4 *) (if !with_par = true then (* 1 *) (None, index) else (* 3 *) (Some ident, index)) + else + (* 55 *) match s.[index] with + | '(' -> (* 5 *) (if !with_par = false then (* 5 *) (with_par := true; _consume_delim s (index+1) ident) else (* 0 *) (None, index)) + | ')' -> (* 4 *) (if !with_par = false then (* 1 *) (None, index + 1) else (* 3 *) (with_par := false; (Some ident, index+1))) + | '$' -> (* 11 *) (_consume_delim s (index+1) ident) + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9'| '_' ->(* 32 *) _consume_delim s (index+1) (Ext_string.append_char ident s.[index]) + | _ -> (* 3 *) if !with_par = false then (* 2 *) (Some ident, index) else (* 1 *) (None, index + 1) + in match s with + | "" -> (* 1 *) (Some "", start_index) + | _ -> (* 21 *) if start_index = String.length s then (* 0 *) (Some "", start_index) + else (* 21 *) (if s.[start_index] <> '$' then (* 10 *) (None, start_index) + else (* 11 *) _consume_delim s start_index "") + + +let compute_new_loc (loc:Location.t) s = (* 0 *) let length = String.length s in + let new_loc = + {loc with loc_start = {loc.loc_start with pos_cnum = loc.loc_end.pos_cnum}; + loc_end = {loc.loc_start with pos_cnum = loc.loc_end.pos_cnum + length}} + in new_loc + +let error_reporting_loc (loc:Location.t) start_index end_index = + (* 0 *) let new_loc = + {loc with loc_start = {loc.loc_start with pos_cnum = loc.loc_start.pos_cnum + start_index}; + loc_end = {loc.loc_end with pos_cnum = loc.loc_start.pos_cnum + end_index }} in new_loc + +let split_es6_string s = + (* 8 *) let rec _split s index nl = + (* 23 *) if index >= String.length s then (* 8 *) Right (List.rev nl) + else (* 15 *) begin + match consume_text s index, consume_delim s index with + | ("" , str_index) , (None , err_index) -> (* 0 *) Left (index, err_index) + | (str, str_index) , (None , _) -> (* 9 *) _split s (str_index) (Text str::nl) + | ("" , _), (Some "" , par_index) -> (* 0 *) Left (index, par_index) + | ("" , _), (Some par, par_index) -> (* 6 *) _split s (par_index) (Delim par::nl) + | _, _ -> (* 0 *) Left (0, String.length s) + end in _split s 0 [] + +let make_string_constant_exp s loc = (* 0 *) let new_loc = compute_new_loc loc s in + let new_exp:Parsetree.expression = { + pexp_loc = new_loc; + pexp_desc = Pexp_constant (Const_string (s, Some Literals.escaped_j_delimiter)); + pexp_attributes = []; + } in new_exp, new_loc + +let make_variable_exp p loc = (* 0 *) let new_loc = compute_new_loc loc p in + let ident = Parsetree.Pexp_ident { txt = (Longident.Lident p); loc = loc } in + let js_to_string = Parsetree.Pexp_ident { txt = + Longident.Ldot (Longident.Ldot ((Longident.Lident "Js"), "String"), "make"); loc = loc } in + let apply_exp:Parsetree.expression_desc = Parsetree.Pexp_apply ({pexp_desc = js_to_string; pexp_loc = new_loc; pexp_attributes = []}, + [("", {pexp_desc = ident; pexp_loc = new_loc; pexp_attributes = []} )]) in + let new_exp:Parsetree.expression = { + pexp_loc = new_loc; + pexp_desc = apply_exp; + pexp_attributes = []; + } in new_exp, new_loc + +let rec _transform_individual_expression exp_list loc nl = (* 0 *) match exp_list with + | [] -> (* 0 *) List.rev nl + | exp::rexp -> (* 0 *) match exp with + | Text s -> (* 0 *) let new_exp, new_loc = make_string_constant_exp s loc in _transform_individual_expression rexp new_loc (new_exp::nl) + | Delim p -> (* 0 *) let new_exp, new_loc = make_variable_exp p loc in _transform_individual_expression rexp new_loc (new_exp::nl) + +let transform_es6_style_template_string s loc = + (* 0 *) let s_len = String.length s in + let buf = Buffer.create (s_len * 2) in + check_and_transform loc buf s 0 s_len; + let sub_strs = split_es6_string (Buffer.contents buf) + in match sub_strs with + | Left (starti, endi) -> (* 0 *) let new_loc = error_reporting_loc loc starti endi in Location.raise_errorf ~loc:new_loc "Not a valid es6 style string" + | Right subs -> (* 0 *) _transform_individual_expression subs loc [] + +let rec fold_expression_list_with_string_concat prev (exp_list:Parsetree.expression list) = (* 0 *) match exp_list with + | [] -> (* 0 *) prev + | (e::re) -> + (* 0 *) let string_concat_exp:Parsetree.expression = {e with pexp_desc = Parsetree.Pexp_ident + {txt = Longident.Ldot (Longident.Lident ("Pervasives"), "^"); loc = e.pexp_loc}} in + let new_string_exp = {e with pexp_desc = Parsetree.Pexp_apply (string_concat_exp, [("", prev); ("", e)])} in + fold_expression_list_with_string_concat new_string_exp re + +end module Ounit_utf8_test = struct #1 "ounit_utf8_test.ml" @@ -14342,23 +14696,123 @@ module Ounit_utf8_test *) let ((>::), - (>:::)) = OUnit.((>::),(>:::)) + (>:::)) = OUnit.((>::),(>:::)) + + +let loc = + { + Location.loc_start = { + pos_fname = "dummy"; + pos_lnum = 0; + pos_bol = 0; + pos_cnum = 0; + }; + loc_end = { + pos_fname = "dummy"; + pos_lnum = 0; + pos_bol = 0; + pos_cnum = 0; + + }; + loc_ghost = false; + };; + +let rec print_es6_string_list = function + | [] -> (* 0 *) () + | (Ast_utf8_string.Text s::nl) -> (* 0 *) print_string "Text "; print_endline (s^";"); print_es6_string_list nl + | (Delim s::nl) -> (* 0 *) print_string "Delim "; print_endline (s^";"); print_es6_string_list nl + + +let print_es6_string_list_either e = (* 0 *) match e with + | Ast_utf8_string.Left _ -> (* 0 *) () + | Right nl -> (* 0 *) print_es6_string_list nl let (=~) = OUnit.assert_equal let suites = - __FILE__ - >::: - [ - __LOC__ >:: begin fun _ -> - (* 1 *) Ext_utf8.decode_utf8_string - "hello 你好，中华民族 hei" =~ - [104; 101; 108; 108; 111; 32; 20320; 22909; 65292; 20013; 21326; 27665; 26063; 32; 104; 101; 105] - end ; - __LOC__ >:: begin fun _ -> - (* 1 *) Ext_utf8.decode_utf8_string - "" =~ [] - end - ] + __FILE__ + >::: + [ + __LOC__ >:: begin fun _ -> + (* 1 *) Ext_utf8.decode_utf8_string + "hello 你好，中华民族 hei" =~ + [104; 101; 108; 108; 111; 32; 20320; 22909; 65292; 20013; 21326; 27665; 26063; 32; 104; 101; 105] + end ; + __LOC__ >:: begin fun _ -> + (* 1 *) Ext_utf8.decode_utf8_string + "" =~ [] + end; + __LOC__ >:: begin fun _ -> + (* 1 *) Ext_string.append_char "Hell" 'o' =~ "Hello" + end; + __LOC__ >:: begin fun _ -> + (* 1 *) let s, i = Ast_utf8_string.consume_text "Hello $world" 0 in + (s, i) =~ ("Hello ", 6) + end; + __LOC__ >:: begin fun _ -> + (* 1 *) let s, new_index = Ast_utf8_string.consume_text "Hello \\$world" 0 in + let _ = s =~ "Hello $world" in + let _ = new_index =~ String.length "Hello \\$world" in () + end; + __LOC__ >:: begin fun _ -> + (* 1 *) Ast_utf8_string.consume_text "" 0 =~ ("", 0) + end; + __LOC__ >:: begin fun _ -> + (* 1 *) Ast_utf8_string.consume_delim "" 0 =~ (Some "", 0) + end; + __LOC__ >:: begin fun _ -> + (* 1 *) Ast_utf8_string.consume_delim "$x" 0 =~ (Some "x", 2) + end; + __LOC__ >:: begin fun _ -> + (* 1 *) Ast_utf8_string.consume_delim "$(x)" 0 =~ (Some "x", 4) + end; + __LOC__ >:: begin fun _ -> + (* 1 *) Ast_utf8_string.consume_delim "hello world" 0 =~ (None, 0) + end; + __LOC__ >:: begin fun _ -> + (* 1 *) Ast_utf8_string.consume_delim "$(hello" 0 =~ (None, 7) + end; + __LOC__ >:: begin fun _ -> + (* 1 *) Ast_utf8_string.consume_delim "$x)" 0 =~ (None, 3) + end; + __LOC__ >:: begin fun _ -> + (* 1 *) Ast_utf8_string.consume_delim "$(hello world)" 0 =~ (None, 8) + end; + __LOC__ >:: begin fun _ -> + (* 1 *) let l = Ast_utf8_string.split_es6_string "Hello World" in + l =~ Right [Text "Hello World"] + end; + __LOC__ >:: begin fun _ -> + (* 1 *) let l = Ast_utf8_string.split_es6_string "Hello $name" in + l =~ Right [Text "Hello "; Delim "name"] + end; + __LOC__ >:: begin fun _ -> + (* 1 *) let l = Ast_utf8_string.split_es6_string "$x is my name" in + l =~ Right [Delim "x"; Text " is my name"] + end; + __LOC__ >:: begin fun _ -> + (* 1 *) let l = Ast_utf8_string.split_es6_string "$(country) is beautiful" in + l =~ Right [Delim "country"; Text " is beautiful"] + end; + __LOC__ >:: begin fun _ -> + (* 1 *) let l = Ast_utf8_string.split_es6_string "hello $x_1, welcome to $(x_2)" in + l =~ Right [Text "hello "; Delim "x_1"; Text ", welcome to "; Delim "x_2"] + end; + __LOC__ >:: begin fun _ -> + (* Testing {j|\\$x|j}*) + (* 1 *) let l = Ast_utf8_string.split_es6_string {|\\$x|} in + l =~ Right [Text "\\"; Delim "x"] + end; + __LOC__ >:: begin fun _ -> + (*{j| \$ |j}*) + (* 1 *) let l = Ast_utf8_string.split_es6_string {|\$|} in + l =~ Right [Text "$"] + end; + __LOC__ >:: begin fun _ -> + (*{j| \\\$x |j}*) + (* 1 *) let l = Ast_utf8_string.split_es6_string {|\\\$x|} in + l =~ Right [Text "\$x"] + end; + ] end module Ounit_vec_test = struct diff --git a/jscomp/bin/all_ounit_tests.ml b/jscomp/bin/all_ounit_tests.ml index 9d1f398acd..bc1c22dfa0 100644 --- a/jscomp/bin/all_ounit_tests.ml +++ b/jscomp/bin/all_ounit_tests.ml @@ -1766,6 +1766,8 @@ val single_colon : string val parent_dir_lit : string val current_dir_lit : string +val append_char : string -> char -> string + end = struct #1 "ext_string.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -1797,6 +1799,7 @@ end = struct +let append_char s c = s ^ String.make 1 c (* {[ split " test_unsafe_obj_ffi_ppx.cmi" ~keep_empty:false ' ']} @@ -7381,13 +7384,6 @@ let decode_utf8_string s = in decode_utf8_cont s 0 (String.length s); List.rev !lst - -(** To decode {j||j} we need verify in the ast so that we have better error - location, then we do the decode later -*) - -let verify s loc = - assert false end module Ext_js_regex : sig #1 "ext_js_regex.mli" @@ -14333,6 +14329,364 @@ let suites = ] end +module Ext_char : sig +#1 "ext_char.mli" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + + + + + + +(** Extension to Standard char module, avoid locale sensitivity *) + +val escaped : char -> string + + +val valid_hex : char -> bool +end = struct +#1 "ext_char.ml" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + + + + + + + +external string_unsafe_set : string -> int -> char -> unit + = "%string_unsafe_set" + +external string_create: int -> string = "caml_create_string" + +external unsafe_chr: int -> char = "%identity" + +(** {!Char.escaped} is locale sensitive in 4.02.3, fixed in the trunk, + backport it here + *) +let escaped = function + | '\'' -> "\\'" + | '\\' -> "\\\\" + | '\n' -> "\\n" + | '\t' -> "\\t" + | '\r' -> "\\r" + | '\b' -> "\\b" + | ' ' .. '~' as c -> + let s = string_create 1 in + string_unsafe_set s 0 c; + s + | c -> + let n = Char.code c in + let s = string_create 4 in + string_unsafe_set s 0 '\\'; + string_unsafe_set s 1 (unsafe_chr (48 + n / 100)); + string_unsafe_set s 2 (unsafe_chr (48 + (n / 10) mod 10)); + string_unsafe_set s 3 (unsafe_chr (48 + n mod 10)); + s + + +let valid_hex x = + match x with + | '0' .. '9' + | 'a' .. 'f' + | 'A' .. 'F' -> true + | _ -> false +end +module Ast_utf8_string += struct +#1 "ast_utf8_string.ml" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + +let rec check_and_transform loc buf s byte_offset s_len = + if byte_offset = s_len then () + else + let current_char = s.[byte_offset] in + match Ext_utf8.classify current_char with + | Single c -> + if c = 92 (* Char.code '\\' = 92 *)then + begin + (* we share the same escape sequence with js *) + Buffer.add_char buf current_char; + escape_code loc buf s (byte_offset+1) s_len + end + else + begin + (if c = 34 (* Char.code '\"' = 34 *) || c = 39 (* Char.code '\'' = 39 *) then + begin + Buffer.add_char buf '\\'; + Buffer.add_char buf current_char ; + + end + else if c = 10 then begin + (* Char.code '\n' = 10 *) + (* we can not just print new line*) + Buffer.add_string buf "\\n"; + + (* seems we don't need + escape "\b" "\f" + we need escape "\n" "\r" since + ocaml multiple-line allows [\n] + visual input while es5 string + does not + *) + end + else if c = 13 then begin + Buffer.add_string buf "\\r" + end + else begin + Buffer.add_char buf current_char; + + end); + check_and_transform loc buf s (byte_offset + 1) s_len + end + | Invalid + | Cont _ -> Location.raise_errorf ~loc "Not utf8 source string" + | Leading (n,_) -> + let i' = Ext_utf8.next s ~remaining:n byte_offset in + if i' < 0 then + Location.raise_errorf ~loc "Not valid utf8 souce string" + else + begin + for k = byte_offset to i' do + Buffer.add_char buf s.[k]; + done; + check_and_transform loc buf s (i' + 1) s_len + end +and escape_code loc buf s offset s_len = + if offset >= s_len then + Location.raise_errorf ~loc "\\ is the end of string" + else + let cur_char = s.[offset] in + match cur_char with + | '\\' + | 'b' + | 't' + | 'n' + | 'v' + | 'f' + | 'r' + | '0' + | '$' + -> + begin + Buffer.add_char buf cur_char ; + check_and_transform loc buf s (offset + 1) s_len + end + | 'u' -> + begin + Buffer.add_char buf cur_char; + unicode loc buf s (offset + 1) s_len + end + | 'x' -> begin + Buffer.add_char buf cur_char ; + two_hex loc buf s (offset + 1) s_len + end + | _ -> Location.raise_errorf ~loc "invalid escape code" +and two_hex loc buf s offset s_len = + if offset + 1 >= s_len then + Location.raise_errorf ~loc "\\x need at least two chars"; + let a, b = s.[offset], s.[offset + 1] in + if Ext_char.valid_hex a && Ext_char.valid_hex b then + begin + Buffer.add_char buf a ; + Buffer.add_char buf b ; + check_and_transform loc buf s (offset + 2) s_len + end + else Location.raise_errorf ~loc "%c%c is not a valid hex code" a b + +and unicode loc buf s offset s_len = + if offset + 3 >= s_len then + Location.raise_errorf ~loc "\\u need at least four chars"; + let a0,a1,a2,a3 = s.[offset], s.[offset+1], s.[offset+2], s.[offset+3] in + if + Ext_char.valid_hex a0 && + Ext_char.valid_hex a1 && + Ext_char.valid_hex a2 && + Ext_char.valid_hex a3 then + begin + Buffer.add_char buf a0; + Buffer.add_char buf a1; + Buffer.add_char buf a2; + Buffer.add_char buf a3; + check_and_transform loc buf s (offset + 4) s_len + end + else + Location.raise_errorf ~loc "%c%c%c%c is not a valid unicode point" + a0 a1 a2 a3 +(* http://www.2ality.com/2015/01/es6-strings.html + console.log('\uD83D\uDE80'); (* ES6*) + console.log('\u{1F680}'); +*) + +type interpo = Text of string | Delim of string + +type ('a, 'b) either = Left of 'a | Right of 'b + +let consume_text s start_index = + let rec _consume_text s index last_char new_word = + if index = String.length s then new_word, String.length s + else begin + match s.[index] with + | '\\' -> (if index + 1 = String.length s then "", index else + match s.[index+1] with + | '\\' -> _consume_text s (index+2) ' ' (Ext_string.append_char new_word '\\') + | '$' -> _consume_text s (index+2) ' ' (Ext_string.append_char new_word '$') + | c -> _consume_text s (index+1) '\\' (Ext_string.append_char new_word '\\')) + | '$' -> (new_word, index) + | c -> _consume_text s (index + 1) c (Ext_string.append_char new_word c) + end + in _consume_text s start_index ' ' "" + +let consume_delim s start_index = + let with_par = ref false in + let rec _consume_delim s index ident = + if index = String.length s then (if !with_par = true then (None, index) else (Some ident, index)) + else + match s.[index] with + | '(' -> (if !with_par = false then (with_par := true; _consume_delim s (index+1) ident) else (None, index)) + | ')' -> (if !with_par = false then (None, index + 1) else (with_par := false; (Some ident, index+1))) + | '$' -> (_consume_delim s (index+1) ident) + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9'| '_' ->_consume_delim s (index+1) (Ext_string.append_char ident s.[index]) + | _ -> if !with_par = false then (Some ident, index) else (None, index + 1) + in match s with + | "" -> (Some "", start_index) + | _ -> if start_index = String.length s then (Some "", start_index) + else (if s.[start_index] <> '$' then (None, start_index) + else _consume_delim s start_index "") + + +let compute_new_loc (loc:Location.t) s = let length = String.length s in + let new_loc = + {loc with loc_start = {loc.loc_start with pos_cnum = loc.loc_end.pos_cnum}; + loc_end = {loc.loc_start with pos_cnum = loc.loc_end.pos_cnum + length}} + in new_loc + +let error_reporting_loc (loc:Location.t) start_index end_index = + let new_loc = + {loc with loc_start = {loc.loc_start with pos_cnum = loc.loc_start.pos_cnum + start_index}; + loc_end = {loc.loc_end with pos_cnum = loc.loc_start.pos_cnum + end_index }} in new_loc + +let split_es6_string s = + let rec _split s index nl = + if index >= String.length s then Right (List.rev nl) + else begin + match consume_text s index, consume_delim s index with + | ("" , str_index) , (None , err_index) -> Left (index, err_index) + | (str, str_index) , (None , _) -> _split s (str_index) (Text str::nl) + | ("" , _), (Some "" , par_index) -> Left (index, par_index) + | ("" , _), (Some par, par_index) -> _split s (par_index) (Delim par::nl) + | _, _ -> Left (0, String.length s) + end in _split s 0 [] + +let make_string_constant_exp s loc = let new_loc = compute_new_loc loc s in + let new_exp:Parsetree.expression = { + pexp_loc = new_loc; + pexp_desc = Pexp_constant (Const_string (s, Some Literals.escaped_j_delimiter)); + pexp_attributes = []; + } in new_exp, new_loc + +let make_variable_exp p loc = let new_loc = compute_new_loc loc p in + let ident = Parsetree.Pexp_ident { txt = (Longident.Lident p); loc = loc } in + let js_to_string = Parsetree.Pexp_ident { txt = + Longident.Ldot (Longident.Ldot ((Longident.Lident "Js"), "String"), "make"); loc = loc } in + let apply_exp:Parsetree.expression_desc = Parsetree.Pexp_apply ({pexp_desc = js_to_string; pexp_loc = new_loc; pexp_attributes = []}, + [("", {pexp_desc = ident; pexp_loc = new_loc; pexp_attributes = []} )]) in + let new_exp:Parsetree.expression = { + pexp_loc = new_loc; + pexp_desc = apply_exp; + pexp_attributes = []; + } in new_exp, new_loc + +let rec _transform_individual_expression exp_list loc nl = match exp_list with + | [] -> List.rev nl + | exp::rexp -> match exp with + | Text s -> let new_exp, new_loc = make_string_constant_exp s loc in _transform_individual_expression rexp new_loc (new_exp::nl) + | Delim p -> let new_exp, new_loc = make_variable_exp p loc in _transform_individual_expression rexp new_loc (new_exp::nl) + +let transform_es6_style_template_string s loc = + let s_len = String.length s in + let buf = Buffer.create (s_len * 2) in + check_and_transform loc buf s 0 s_len; + let sub_strs = split_es6_string (Buffer.contents buf) + in match sub_strs with + | Left (starti, endi) -> let new_loc = error_reporting_loc loc starti endi in Location.raise_errorf ~loc:new_loc "Not a valid es6 style string" + | Right subs -> _transform_individual_expression subs loc [] + +let rec fold_expression_list_with_string_concat prev (exp_list:Parsetree.expression list) = match exp_list with + | [] -> prev + | (e::re) -> + let string_concat_exp:Parsetree.expression = {e with pexp_desc = Parsetree.Pexp_ident + {txt = Longident.Ldot (Longident.Lident ("Pervasives"), "^"); loc = e.pexp_loc}} in + let new_string_exp = {e with pexp_desc = Parsetree.Pexp_apply (string_concat_exp, [("", prev); ("", e)])} in + fold_expression_list_with_string_concat new_string_exp re + +end module Ounit_utf8_test = struct #1 "ounit_utf8_test.ml" @@ -14342,23 +14696,123 @@ module Ounit_utf8_test *) let ((>::), - (>:::)) = OUnit.((>::),(>:::)) + (>:::)) = OUnit.((>::),(>:::)) + + +let loc = + { + Location.loc_start = { + pos_fname = "dummy"; + pos_lnum = 0; + pos_bol = 0; + pos_cnum = 0; + }; + loc_end = { + pos_fname = "dummy"; + pos_lnum = 0; + pos_bol = 0; + pos_cnum = 0; + + }; + loc_ghost = false; + };; + +let rec print_es6_string_list = function + | [] -> () + | (Ast_utf8_string.Text s::nl) -> print_string "Text "; print_endline (s^";"); print_es6_string_list nl + | (Delim s::nl) -> print_string "Delim "; print_endline (s^";"); print_es6_string_list nl + + +let print_es6_string_list_either e = match e with + | Ast_utf8_string.Left _ -> () + | Right nl -> print_es6_string_list nl let (=~) = OUnit.assert_equal let suites = - __FILE__ - >::: - [ - __LOC__ >:: begin fun _ -> - Ext_utf8.decode_utf8_string - "hello 你好，中华民族 hei" =~ - [104; 101; 108; 108; 111; 32; 20320; 22909; 65292; 20013; 21326; 27665; 26063; 32; 104; 101; 105] - end ; - __LOC__ >:: begin fun _ -> - Ext_utf8.decode_utf8_string - "" =~ [] - end - ] + __FILE__ + >::: + [ + __LOC__ >:: begin fun _ -> + Ext_utf8.decode_utf8_string + "hello 你好，中华民族 hei" =~ + [104; 101; 108; 108; 111; 32; 20320; 22909; 65292; 20013; 21326; 27665; 26063; 32; 104; 101; 105] + end ; + __LOC__ >:: begin fun _ -> + Ext_utf8.decode_utf8_string + "" =~ [] + end; + __LOC__ >:: begin fun _ -> + Ext_string.append_char "Hell" 'o' =~ "Hello" + end; + __LOC__ >:: begin fun _ -> + let s, i = Ast_utf8_string.consume_text "Hello $world" 0 in + (s, i) =~ ("Hello ", 6) + end; + __LOC__ >:: begin fun _ -> + let s, new_index = Ast_utf8_string.consume_text "Hello \\$world" 0 in + let _ = s =~ "Hello $world" in + let _ = new_index =~ String.length "Hello \\$world" in () + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.consume_text "" 0 =~ ("", 0) + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.consume_delim "" 0 =~ (Some "", 0) + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.consume_delim "$x" 0 =~ (Some "x", 2) + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.consume_delim "$(x)" 0 =~ (Some "x", 4) + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.consume_delim "hello world" 0 =~ (None, 0) + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.consume_delim "$(hello" 0 =~ (None, 7) + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.consume_delim "$x)" 0 =~ (None, 3) + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.consume_delim "$(hello world)" 0 =~ (None, 8) + end; + __LOC__ >:: begin fun _ -> + let l = Ast_utf8_string.split_es6_string "Hello World" in + l =~ Right [Text "Hello World"] + end; + __LOC__ >:: begin fun _ -> + let l = Ast_utf8_string.split_es6_string "Hello $name" in + l =~ Right [Text "Hello "; Delim "name"] + end; + __LOC__ >:: begin fun _ -> + let l = Ast_utf8_string.split_es6_string "$x is my name" in + l =~ Right [Delim "x"; Text " is my name"] + end; + __LOC__ >:: begin fun _ -> + let l = Ast_utf8_string.split_es6_string "$(country) is beautiful" in + l =~ Right [Delim "country"; Text " is beautiful"] + end; + __LOC__ >:: begin fun _ -> + let l = Ast_utf8_string.split_es6_string "hello $x_1, welcome to $(x_2)" in + l =~ Right [Text "hello "; Delim "x_1"; Text ", welcome to "; Delim "x_2"] + end; + __LOC__ >:: begin fun _ -> + (* Testing {j|\\$x|j}*) + let l = Ast_utf8_string.split_es6_string {|\\$x|} in + l =~ Right [Text "\\"; Delim "x"] + end; + __LOC__ >:: begin fun _ -> + (*{j| \$ |j}*) + let l = Ast_utf8_string.split_es6_string {|\$|} in + l =~ Right [Text "$"] + end; + __LOC__ >:: begin fun _ -> + (*{j| \\\$x |j}*) + let l = Ast_utf8_string.split_es6_string {|\\\$x|} in + l =~ Right [Text "\$x"] + end; + ] end module Ounit_vec_test = struct diff --git a/jscomp/bin/bsb.ml b/jscomp/bin/bsb.ml index a78f16c829..f24ecefc6b 100644 --- a/jscomp/bin/bsb.ml +++ b/jscomp/bin/bsb.ml @@ -536,6 +536,8 @@ val single_colon : string val parent_dir_lit : string val current_dir_lit : string +val append_char : string -> char -> string + end = struct #1 "ext_string.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -567,6 +569,7 @@ end = struct +let append_char s c = s ^ String.make 1 c (* {[ split " test_unsafe_obj_ffi_ppx.cmi" ~keep_empty:false ' ']} diff --git a/jscomp/bin/bsb_helper.ml b/jscomp/bin/bsb_helper.ml index daf35021f6..36bffc66ee 100644 --- a/jscomp/bin/bsb_helper.ml +++ b/jscomp/bin/bsb_helper.ml @@ -485,6 +485,8 @@ val single_colon : string val parent_dir_lit : string val current_dir_lit : string +val append_char : string -> char -> string + end = struct #1 "ext_string.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -516,6 +518,7 @@ end = struct +let append_char s c = s ^ String.make 1 c (* {[ split " test_unsafe_obj_ffi_ppx.cmi" ~keep_empty:false ' ']} diff --git a/jscomp/bin/bsdep.ml b/jscomp/bin/bsdep.ml index 1c31188827..c4524c2997 100644 --- a/jscomp/bin/bsdep.ml +++ b/jscomp/bin/bsdep.ml @@ -1996,6 +1996,11 @@ val error: ?loc:t -> ?sub:error list -> ?if_highlight:string -> string -> error val errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string -> ('a, Format.formatter, unit, error) format4 -> 'a +val errorf_prefixed : ?loc:t -> ?sub:error list -> ?if_highlight:string + -> ('a, Format.formatter, unit, error) format4 -> 'a + (* same as {!errorf}, but prints the error prefix "Error:" before yielding + * to the format string *) + val raise_errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string -> ('a, Format.formatter, unit, 'b) format4 -> 'a @@ -2374,14 +2379,14 @@ let pp_ksprintf ?before k fmt = k msg) ppf fmt -(* Shift the formatter's offset by the length of the error prefix, which - is always added by the compiler after the message has been formatted *) -let print_phanton_error_prefix ppf = - Format.pp_print_as ppf (String.length error_prefix + 2 (* ": " *)) "" - let errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") fmt = pp_ksprintf - ~before:print_phanton_error_prefix + (fun msg -> {loc; msg; sub; if_highlight}) + fmt + +let errorf_prefixed ?(loc=none) ?(sub=[]) ?(if_highlight="") fmt = + pp_ksprintf + ~before:(fun ppf -> fprintf ppf "%a " print_error_prefix ()) (fun msg -> {loc; msg; sub; if_highlight}) fmt @@ -2416,8 +2421,10 @@ let rec default_error_reporter ppf ({loc; msg; sub; if_highlight} as err) = if highlighted then Format.pp_print_string ppf if_highlight else begin - fprintf ppf "%a%a %s" print loc print_error_prefix () msg; - List.iter (Format.fprintf ppf "@\n@[<2>%a@]" default_error_reporter) sub + print ppf loc; + Format.pp_print_string ppf msg; + List.iter (fun err -> Format.fprintf ppf "@\n@[<2>%a@]" default_error_reporter err) + sub end let error_reporter = ref default_error_reporter @@ -2427,7 +2434,7 @@ let report_error ppf err = ;; let error_of_printer loc print x = - errorf ~loc "%a@?" print x + errorf_prefixed ~loc "%a@?" print x let error_of_printer_file print x = error_of_printer (in_file !input_name) print x @@ -2436,11 +2443,11 @@ let () = register_error_of_exn (function | Sys_error msg -> - Some (errorf ~loc:(in_file !input_name) + Some (errorf_prefixed ~loc:(in_file !input_name) "I/O error: %s" msg) | Warnings.Errors n -> Some - (errorf ~loc:(in_file !input_name) + (errorf_prefixed ~loc:(in_file !input_name) "Some fatal warnings were triggered (%d occurrences)" n) | _ -> None @@ -2468,9 +2475,7 @@ let () = ) let raise_errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") = - pp_ksprintf - ~before:print_phanton_error_prefix - (fun msg -> raise (Error ({loc; msg; sub; if_highlight}))) + pp_ksprintf (fun msg -> raise (Error ({loc; msg; sub; if_highlight}))) end (** Interface as module *) @@ -4877,9 +4882,9 @@ exception Escape_error let prepare_error = function | Unclosed(opening_loc, opening, closing_loc, closing) -> - Location.errorf ~loc:closing_loc + Location.errorf_prefixed ~loc:closing_loc ~sub:[ - Location.errorf ~loc:opening_loc + Location.errorf_prefixed ~loc:opening_loc "This '%s' might be unmatched" opening ] ~if_highlight: @@ -4889,22 +4894,22 @@ let prepare_error = function "Syntax error: '%s' expected" closing | Expecting (loc, nonterm) -> - Location.errorf ~loc "Syntax error: %s expected." nonterm + Location.errorf_prefixed ~loc "Syntax error: %s expected." nonterm | Not_expecting (loc, nonterm) -> - Location.errorf ~loc "Syntax error: %s not expected." nonterm + Location.errorf_prefixed ~loc "Syntax error: %s not expected." nonterm | Applicative_path loc -> - Location.errorf ~loc + Location.errorf_prefixed ~loc "Syntax error: applicative paths of the form F(X).t \ are not supported when the option -no-app-func is set." | Variable_in_scope (loc, var) -> - Location.errorf ~loc + Location.errorf_prefixed ~loc "In this scoped type, variable '%s \ is reserved for the local type %s." var var | Other loc -> - Location.errorf ~loc "Syntax error" + Location.errorf_prefixed ~loc "Syntax error" | Ill_formed_ast (loc, s) -> - Location.errorf ~loc "broken invariant in parsetree: %s" s + Location.errorf_prefixed ~loc "broken invariant in parsetree: %s" s let () = Location.register_error_of_exn @@ -22884,13 +22889,6 @@ let decode_utf8_string s = in decode_utf8_cont s 0 (String.length s); List.rev !lst - -(** To decode {j||j} we need verify in the ast so that we have better error - location, then we do the decode later -*) - -let verify s loc = - assert false end module Ext_js_regex : sig #1 "ext_js_regex.mli" @@ -23227,6 +23225,8 @@ val single_colon : string val parent_dir_lit : string val current_dir_lit : string +val append_char : string -> char -> string + end = struct #1 "ext_string.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -23258,6 +23258,7 @@ end = struct +let append_char s c = s ^ String.make 1 c (* {[ split " test_unsafe_obj_ffi_ppx.cmi" ~keep_empty:false ' ']} @@ -31953,7 +31954,7 @@ module Ast_utf8_string = struct #1 "ast_utf8_string.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -31971,132 +31972,234 @@ module Ast_utf8_string * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - let rec check_and_transform loc buf s byte_offset s_len = if byte_offset = s_len then () - else - let current_char = s.[byte_offset] in - match Ext_utf8.classify current_char with - | Single c -> - if c = 92 (* Char.code '\\' = 92 *)then - begin + else + let current_char = s.[byte_offset] in + match Ext_utf8.classify current_char with + | Single c -> + if c = 92 (* Char.code '\\' = 92 *)then + begin (* we share the same escape sequence with js *) - Buffer.add_char buf current_char; - escape_code loc buf s (byte_offset+1) s_len - end + Buffer.add_char buf current_char; + escape_code loc buf s (byte_offset+1) s_len + end else - begin - (if c = 34 (* Char.code '\"' = 34 *) || c = 39 (* Char.code '\'' = 39 *) then - begin + begin + (if c = 34 (* Char.code '\"' = 34 *) || c = 39 (* Char.code '\'' = 39 *) then + begin Buffer.add_char buf '\\'; - Buffer.add_char buf current_char ; + Buffer.add_char buf current_char ; end - else if c = 10 then begin + else if c = 10 then begin (* Char.code '\n' = 10 *) (* we can not just print new line*) Buffer.add_string buf "\\n"; - (* seems we don't need - escape "\b" "\f" - we need escape "\n" "\r" since + (* seems we don't need + escape "\b" "\f" + we need escape "\n" "\r" since ocaml multiple-line allows [\n] - visual input while es5 string - does not + visual input while es5 string + does not *) - end - else if c = 13 then begin - Buffer.add_string buf "\\r" - end - else begin + end + else if c = 13 then begin + Buffer.add_string buf "\\r" + end + else begin Buffer.add_char buf current_char; end); - check_and_transform loc buf s (byte_offset + 1) s_len + check_and_transform loc buf s (byte_offset + 1) s_len end - | Invalid + | Invalid | Cont _ -> Location.raise_errorf ~loc "Not utf8 source string" - | Leading (n,_) -> + | Leading (n,_) -> let i' = Ext_utf8.next s ~remaining:n byte_offset in - if i' < 0 then + if i' < 0 then Location.raise_errorf ~loc "Not valid utf8 souce string" - else - begin - for k = byte_offset to i' do - Buffer.add_char buf s.[k]; - done; - check_and_transform loc buf s (i' + 1) s_len + else + begin + for k = byte_offset to i' do + Buffer.add_char buf s.[k]; + done; + check_and_transform loc buf s (i' + 1) s_len end -and escape_code loc buf s offset s_len = - if offset >= s_len then - Location.raise_errorf ~loc "\\ is the end of string" - else - let cur_char = s.[offset] in - match cur_char with +and escape_code loc buf s offset s_len = + if offset >= s_len then + Location.raise_errorf ~loc "\\ is the end of string" + else + let cur_char = s.[offset] in + match cur_char with | '\\' - | 'b' - | 't' - | 'n' + | 'b' + | 't' + | 'n' | 'v' | 'f' - | 'r' - | '0' + | 'r' + | '0' | '$' - -> - begin + -> + begin Buffer.add_char buf cur_char ; - check_and_transform loc buf s (offset + 1) s_len - end - | 'u' -> - begin + check_and_transform loc buf s (offset + 1) s_len + end + | 'u' -> + begin Buffer.add_char buf cur_char; - unicode loc buf s (offset + 1) s_len - end - | 'x' -> begin - Buffer.add_char buf cur_char ; - two_hex loc buf s (offset + 1) s_len - end + unicode loc buf s (offset + 1) s_len + end + | 'x' -> begin + Buffer.add_char buf cur_char ; + two_hex loc buf s (offset + 1) s_len + end | _ -> Location.raise_errorf ~loc "invalid escape code" -and two_hex loc buf s offset s_len = - if offset + 1 >= s_len then +and two_hex loc buf s offset s_len = + if offset + 1 >= s_len then Location.raise_errorf ~loc "\\x need at least two chars"; - let a, b = s.[offset], s.[offset + 1] in - if Ext_char.valid_hex a && Ext_char.valid_hex b then - begin - Buffer.add_char buf a ; - Buffer.add_char buf b ; - check_and_transform loc buf s (offset + 2) s_len + let a, b = s.[offset], s.[offset + 1] in + if Ext_char.valid_hex a && Ext_char.valid_hex b then + begin + Buffer.add_char buf a ; + Buffer.add_char buf b ; + check_and_transform loc buf s (offset + 2) s_len end else Location.raise_errorf ~loc "%c%c is not a valid hex code" a b -and unicode loc buf s offset s_len = - if offset + 3 >= s_len then +and unicode loc buf s offset s_len = + if offset + 3 >= s_len then Location.raise_errorf ~loc "\\u need at least four chars"; let a0,a1,a2,a3 = s.[offset], s.[offset+1], s.[offset+2], s.[offset+3] in - if + if Ext_char.valid_hex a0 && Ext_char.valid_hex a1 && Ext_char.valid_hex a2 && - Ext_char.valid_hex a3 then - begin + Ext_char.valid_hex a3 then + begin Buffer.add_char buf a0; Buffer.add_char buf a1; Buffer.add_char buf a2; - Buffer.add_char buf a3; - check_and_transform loc buf s (offset + 4) s_len - end - else + Buffer.add_char buf a3; + check_and_transform loc buf s (offset + 4) s_len + end + else Location.raise_errorf ~loc "%c%c%c%c is not a valid unicode point" - a0 a1 a2 a3 + a0 a1 a2 a3 (* http://www.2ality.com/2015/01/es6-strings.html console.log('\uD83D\uDE80'); (* ES6*) console.log('\u{1F680}'); -*) +*) + +type interpo = Text of string | Delim of string + +type ('a, 'b) either = Left of 'a | Right of 'b + +let consume_text s start_index = + let rec _consume_text s index last_char new_word = + if index = String.length s then new_word, String.length s + else begin + match s.[index] with + | '\\' -> (if index + 1 = String.length s then "", index else + match s.[index+1] with + | '\\' -> _consume_text s (index+2) ' ' (Ext_string.append_char new_word '\\') + | '$' -> _consume_text s (index+2) ' ' (Ext_string.append_char new_word '$') + | c -> _consume_text s (index+1) '\\' (Ext_string.append_char new_word '\\')) + | '$' -> (new_word, index) + | c -> _consume_text s (index + 1) c (Ext_string.append_char new_word c) + end + in _consume_text s start_index ' ' "" + +let consume_delim s start_index = + let with_par = ref false in + let rec _consume_delim s index ident = + if index = String.length s then (if !with_par = true then (None, index) else (Some ident, index)) + else + match s.[index] with + | '(' -> (if !with_par = false then (with_par := true; _consume_delim s (index+1) ident) else (None, index)) + | ')' -> (if !with_par = false then (None, index + 1) else (with_par := false; (Some ident, index+1))) + | '$' -> (_consume_delim s (index+1) ident) + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9'| '_' ->_consume_delim s (index+1) (Ext_string.append_char ident s.[index]) + | _ -> if !with_par = false then (Some ident, index) else (None, index + 1) + in match s with + | "" -> (Some "", start_index) + | _ -> if start_index = String.length s then (Some "", start_index) + else (if s.[start_index] <> '$' then (None, start_index) + else _consume_delim s start_index "") + + +let compute_new_loc (loc:Location.t) s = let length = String.length s in + let new_loc = + {loc with loc_start = {loc.loc_start with pos_cnum = loc.loc_end.pos_cnum}; + loc_end = {loc.loc_start with pos_cnum = loc.loc_end.pos_cnum + length}} + in new_loc + +let error_reporting_loc (loc:Location.t) start_index end_index = + let new_loc = + {loc with loc_start = {loc.loc_start with pos_cnum = loc.loc_start.pos_cnum + start_index}; + loc_end = {loc.loc_end with pos_cnum = loc.loc_start.pos_cnum + end_index }} in new_loc + +let split_es6_string s = + let rec _split s index nl = + if index >= String.length s then Right (List.rev nl) + else begin + match consume_text s index, consume_delim s index with + | ("" , str_index) , (None , err_index) -> Left (index, err_index) + | (str, str_index) , (None , _) -> _split s (str_index) (Text str::nl) + | ("" , _), (Some "" , par_index) -> Left (index, par_index) + | ("" , _), (Some par, par_index) -> _split s (par_index) (Delim par::nl) + | _, _ -> Left (0, String.length s) + end in _split s 0 [] + +let make_string_constant_exp s loc = let new_loc = compute_new_loc loc s in + let new_exp:Parsetree.expression = { + pexp_loc = new_loc; + pexp_desc = Pexp_constant (Const_string (s, Some Literals.escaped_j_delimiter)); + pexp_attributes = []; + } in new_exp, new_loc + +let make_variable_exp p loc = let new_loc = compute_new_loc loc p in + let ident = Parsetree.Pexp_ident { txt = (Longident.Lident p); loc = loc } in + let js_to_string = Parsetree.Pexp_ident { txt = + Longident.Ldot (Longident.Ldot ((Longident.Lident "Js"), "String"), "make"); loc = loc } in + let apply_exp:Parsetree.expression_desc = Parsetree.Pexp_apply ({pexp_desc = js_to_string; pexp_loc = new_loc; pexp_attributes = []}, + [("", {pexp_desc = ident; pexp_loc = new_loc; pexp_attributes = []} )]) in + let new_exp:Parsetree.expression = { + pexp_loc = new_loc; + pexp_desc = apply_exp; + pexp_attributes = []; + } in new_exp, new_loc + +let rec _transform_individual_expression exp_list loc nl = match exp_list with + | [] -> List.rev nl + | exp::rexp -> match exp with + | Text s -> let new_exp, new_loc = make_string_constant_exp s loc in _transform_individual_expression rexp new_loc (new_exp::nl) + | Delim p -> let new_exp, new_loc = make_variable_exp p loc in _transform_individual_expression rexp new_loc (new_exp::nl) + +let transform_es6_style_template_string s loc = + let s_len = String.length s in + let buf = Buffer.create (s_len * 2) in + check_and_transform loc buf s 0 s_len; + let sub_strs = split_es6_string (Buffer.contents buf) + in match sub_strs with + | Left (starti, endi) -> let new_loc = error_reporting_loc loc starti endi in Location.raise_errorf ~loc:new_loc "Not a valid es6 style string" + | Right subs -> _transform_individual_expression subs loc [] + +let rec fold_expression_list_with_string_concat prev (exp_list:Parsetree.expression list) = match exp_list with + | [] -> prev + | (e::re) -> + let string_concat_exp:Parsetree.expression = {e with pexp_desc = Parsetree.Pexp_ident + {txt = Longident.Ldot (Longident.Lident ("Pervasives"), "^"); loc = e.pexp_loc}} in + let new_string_exp = {e with pexp_desc = Parsetree.Pexp_apply (string_concat_exp, [("", prev); ("", e)])} in + fold_expression_list_with_string_concat new_string_exp re + end module Ast_exp : sig #1 "ast_exp.mli" @@ -33605,16 +33708,16 @@ let rec unsafe_mapper : Ast_mapper.mapper = (Ast_comb.to_js_re_type loc) | Pexp_extension ({txt = "bs.external" | "external" ; loc }, payload) -> begin match Ast_payload.as_ident payload with - | Some {txt = Lident x} - -> Ast_util.handle_external loc x + | Some {txt = Lident x} + -> Ast_util.handle_external loc x (* do we need support [%external gg.xx ] - + {[ Js.Undefined.to_opt (if Js.typeof x == "undefined" then x else Js.Undefined.empty ) ]} *) - | None | Some _ -> - Location.raise_errorf ~loc - "external expects a single identifier" + | None | Some _ -> + Location.raise_errorf ~loc + "external expects a single identifier" end | Pexp_extension ({txt = ("bs.node" | "node"); loc}, @@ -33635,7 +33738,7 @@ let rec unsafe_mapper : Ast_mapper.mapper = Ast_util.handle_external loc (strip name) in let typ = Ast_core_type.lift_option_type - @@ + @@ if name = "_module" then Typ.constr ~loc { txt = Ldot (Lident "Node", "node_module") ; @@ -33663,13 +33766,16 @@ let rec unsafe_mapper : Ast_mapper.mapper = end |Pexp_constant (Const_string (s, (Some delim))) -> - if Ext_string.equal delim Literals.unescaped_js_delimiter then + if Ext_string.equal delim Literals.unescaped_js_delimiter then let s_len = String.length s in let buf = Buffer.create (s_len * 2) in Ast_utf8_string.check_and_transform loc buf s 0 s_len ; { e with pexp_desc = Pexp_constant (Const_string (Buffer.contents buf, Some Literals.escaped_j_delimiter))} - else if Ext_string.equal delim Literals.unescaped_j_delimiter then - Location.raise_errorf ~loc "{j||j} is reserved for future use" + else if Ext_string.equal delim Literals.unescaped_j_delimiter then + let starting_loc = {loc with loc_end = loc.loc_start} in + let empty_string_concat_exp = {e with pexp_desc = Pexp_constant (Const_string ("", None)); pexp_loc = starting_loc} in + let exps_list = Ast_utf8_string.transform_es6_style_template_string s starting_loc in + Ast_utf8_string.fold_expression_list_with_string_concat empty_string_concat_exp exps_list else e (** [bs.debugger], its output should not be rewritten any more*) @@ -34063,7 +34169,6 @@ let rewrite_implementation : (Parsetree.structure -> Parsetree.structure) ref = unsafe_mapper.structure unsafe_mapper x in reset (); result ) - end module Ocamldep = struct diff --git a/jscomp/bin/bspp.ml b/jscomp/bin/bspp.ml index 3d09648673..32cbc0df88 100644 --- a/jscomp/bin/bspp.ml +++ b/jscomp/bin/bspp.ml @@ -1933,6 +1933,11 @@ val error: ?loc:t -> ?sub:error list -> ?if_highlight:string -> string -> error val errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string -> ('a, Format.formatter, unit, error) format4 -> 'a +val errorf_prefixed : ?loc:t -> ?sub:error list -> ?if_highlight:string + -> ('a, Format.formatter, unit, error) format4 -> 'a + (* same as {!errorf}, but prints the error prefix "Error:" before yielding + * to the format string *) + val raise_errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string -> ('a, Format.formatter, unit, 'b) format4 -> 'a @@ -2311,14 +2316,14 @@ let pp_ksprintf ?before k fmt = k msg) ppf fmt -(* Shift the formatter's offset by the length of the error prefix, which - is always added by the compiler after the message has been formatted *) -let print_phanton_error_prefix ppf = - Format.pp_print_as ppf (String.length error_prefix + 2 (* ": " *)) "" - let errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") fmt = pp_ksprintf - ~before:print_phanton_error_prefix + (fun msg -> {loc; msg; sub; if_highlight}) + fmt + +let errorf_prefixed ?(loc=none) ?(sub=[]) ?(if_highlight="") fmt = + pp_ksprintf + ~before:(fun ppf -> fprintf ppf "%a " print_error_prefix ()) (fun msg -> {loc; msg; sub; if_highlight}) fmt @@ -2353,8 +2358,10 @@ let rec default_error_reporter ppf ({loc; msg; sub; if_highlight} as err) = if highlighted then Format.pp_print_string ppf if_highlight else begin - fprintf ppf "%a%a %s" print loc print_error_prefix () msg; - List.iter (Format.fprintf ppf "@\n@[<2>%a@]" default_error_reporter) sub + print ppf loc; + Format.pp_print_string ppf msg; + List.iter (fun err -> Format.fprintf ppf "@\n@[<2>%a@]" default_error_reporter err) + sub end let error_reporter = ref default_error_reporter @@ -2364,7 +2371,7 @@ let report_error ppf err = ;; let error_of_printer loc print x = - errorf ~loc "%a@?" print x + errorf_prefixed ~loc "%a@?" print x let error_of_printer_file print x = error_of_printer (in_file !input_name) print x @@ -2373,11 +2380,11 @@ let () = register_error_of_exn (function | Sys_error msg -> - Some (errorf ~loc:(in_file !input_name) + Some (errorf_prefixed ~loc:(in_file !input_name) "I/O error: %s" msg) | Warnings.Errors n -> Some - (errorf ~loc:(in_file !input_name) + (errorf_prefixed ~loc:(in_file !input_name) "Some fatal warnings were triggered (%d occurrences)" n) | _ -> None @@ -2405,9 +2412,7 @@ let () = ) let raise_errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") = - pp_ksprintf - ~before:print_phanton_error_prefix - (fun msg -> raise (Error ({loc; msg; sub; if_highlight}))) + pp_ksprintf (fun msg -> raise (Error ({loc; msg; sub; if_highlight}))) end module Parser diff --git a/jscomp/bin/bsppx.ml b/jscomp/bin/bsppx.ml index 5a0110966f..b28146b32d 100644 --- a/jscomp/bin/bsppx.ml +++ b/jscomp/bin/bsppx.ml @@ -1933,6 +1933,11 @@ val error: ?loc:t -> ?sub:error list -> ?if_highlight:string -> string -> error val errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string -> ('a, Format.formatter, unit, error) format4 -> 'a +val errorf_prefixed : ?loc:t -> ?sub:error list -> ?if_highlight:string + -> ('a, Format.formatter, unit, error) format4 -> 'a + (* same as {!errorf}, but prints the error prefix "Error:" before yielding + * to the format string *) + val raise_errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string -> ('a, Format.formatter, unit, 'b) format4 -> 'a @@ -2311,14 +2316,14 @@ let pp_ksprintf ?before k fmt = k msg) ppf fmt -(* Shift the formatter's offset by the length of the error prefix, which - is always added by the compiler after the message has been formatted *) -let print_phanton_error_prefix ppf = - Format.pp_print_as ppf (String.length error_prefix + 2 (* ": " *)) "" - let errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") fmt = pp_ksprintf - ~before:print_phanton_error_prefix + (fun msg -> {loc; msg; sub; if_highlight}) + fmt + +let errorf_prefixed ?(loc=none) ?(sub=[]) ?(if_highlight="") fmt = + pp_ksprintf + ~before:(fun ppf -> fprintf ppf "%a " print_error_prefix ()) (fun msg -> {loc; msg; sub; if_highlight}) fmt @@ -2353,8 +2358,10 @@ let rec default_error_reporter ppf ({loc; msg; sub; if_highlight} as err) = if highlighted then Format.pp_print_string ppf if_highlight else begin - fprintf ppf "%a%a %s" print loc print_error_prefix () msg; - List.iter (Format.fprintf ppf "@\n@[<2>%a@]" default_error_reporter) sub + print ppf loc; + Format.pp_print_string ppf msg; + List.iter (fun err -> Format.fprintf ppf "@\n@[<2>%a@]" default_error_reporter err) + sub end let error_reporter = ref default_error_reporter @@ -2364,7 +2371,7 @@ let report_error ppf err = ;; let error_of_printer loc print x = - errorf ~loc "%a@?" print x + errorf_prefixed ~loc "%a@?" print x let error_of_printer_file print x = error_of_printer (in_file !input_name) print x @@ -2373,11 +2380,11 @@ let () = register_error_of_exn (function | Sys_error msg -> - Some (errorf ~loc:(in_file !input_name) + Some (errorf_prefixed ~loc:(in_file !input_name) "I/O error: %s" msg) | Warnings.Errors n -> Some - (errorf ~loc:(in_file !input_name) + (errorf_prefixed ~loc:(in_file !input_name) "Some fatal warnings were triggered (%d occurrences)" n) | _ -> None @@ -2405,9 +2412,7 @@ let () = ) let raise_errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") = - pp_ksprintf - ~before:print_phanton_error_prefix - (fun msg -> raise (Error ({loc; msg; sub; if_highlight}))) + pp_ksprintf (fun msg -> raise (Error ({loc; msg; sub; if_highlight}))) end (** Interface as module *) @@ -4899,13 +4904,6 @@ let decode_utf8_string s = in decode_utf8_cont s 0 (String.length s); List.rev !lst - -(** To decode {j||j} we need verify in the ast so that we have better error - location, then we do the decode later -*) - -let verify s loc = - assert false end module Ext_js_regex : sig #1 "ext_js_regex.mli" @@ -5242,6 +5240,8 @@ val single_colon : string val parent_dir_lit : string val current_dir_lit : string +val append_char : string -> char -> string + end = struct #1 "ext_string.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -5273,6 +5273,7 @@ end = struct +let append_char s c = s ^ String.make 1 c (* {[ split " test_unsafe_obj_ffi_ppx.cmi" ~keep_empty:false ' ']} @@ -15137,7 +15138,7 @@ module Ast_utf8_string = struct #1 "ast_utf8_string.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -15155,132 +15156,234 @@ module Ast_utf8_string * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - let rec check_and_transform loc buf s byte_offset s_len = if byte_offset = s_len then () - else - let current_char = s.[byte_offset] in - match Ext_utf8.classify current_char with - | Single c -> - if c = 92 (* Char.code '\\' = 92 *)then - begin + else + let current_char = s.[byte_offset] in + match Ext_utf8.classify current_char with + | Single c -> + if c = 92 (* Char.code '\\' = 92 *)then + begin (* we share the same escape sequence with js *) - Buffer.add_char buf current_char; - escape_code loc buf s (byte_offset+1) s_len - end + Buffer.add_char buf current_char; + escape_code loc buf s (byte_offset+1) s_len + end else - begin - (if c = 34 (* Char.code '\"' = 34 *) || c = 39 (* Char.code '\'' = 39 *) then - begin + begin + (if c = 34 (* Char.code '\"' = 34 *) || c = 39 (* Char.code '\'' = 39 *) then + begin Buffer.add_char buf '\\'; - Buffer.add_char buf current_char ; + Buffer.add_char buf current_char ; end - else if c = 10 then begin + else if c = 10 then begin (* Char.code '\n' = 10 *) (* we can not just print new line*) Buffer.add_string buf "\\n"; - (* seems we don't need - escape "\b" "\f" - we need escape "\n" "\r" since + (* seems we don't need + escape "\b" "\f" + we need escape "\n" "\r" since ocaml multiple-line allows [\n] - visual input while es5 string - does not + visual input while es5 string + does not *) - end - else if c = 13 then begin - Buffer.add_string buf "\\r" - end - else begin + end + else if c = 13 then begin + Buffer.add_string buf "\\r" + end + else begin Buffer.add_char buf current_char; end); - check_and_transform loc buf s (byte_offset + 1) s_len + check_and_transform loc buf s (byte_offset + 1) s_len end - | Invalid + | Invalid | Cont _ -> Location.raise_errorf ~loc "Not utf8 source string" - | Leading (n,_) -> + | Leading (n,_) -> let i' = Ext_utf8.next s ~remaining:n byte_offset in - if i' < 0 then + if i' < 0 then Location.raise_errorf ~loc "Not valid utf8 souce string" - else - begin - for k = byte_offset to i' do - Buffer.add_char buf s.[k]; - done; - check_and_transform loc buf s (i' + 1) s_len + else + begin + for k = byte_offset to i' do + Buffer.add_char buf s.[k]; + done; + check_and_transform loc buf s (i' + 1) s_len end -and escape_code loc buf s offset s_len = - if offset >= s_len then - Location.raise_errorf ~loc "\\ is the end of string" - else - let cur_char = s.[offset] in - match cur_char with +and escape_code loc buf s offset s_len = + if offset >= s_len then + Location.raise_errorf ~loc "\\ is the end of string" + else + let cur_char = s.[offset] in + match cur_char with | '\\' - | 'b' - | 't' - | 'n' + | 'b' + | 't' + | 'n' | 'v' | 'f' - | 'r' - | '0' + | 'r' + | '0' | '$' - -> - begin + -> + begin Buffer.add_char buf cur_char ; - check_and_transform loc buf s (offset + 1) s_len - end - | 'u' -> - begin + check_and_transform loc buf s (offset + 1) s_len + end + | 'u' -> + begin Buffer.add_char buf cur_char; - unicode loc buf s (offset + 1) s_len - end - | 'x' -> begin - Buffer.add_char buf cur_char ; - two_hex loc buf s (offset + 1) s_len - end + unicode loc buf s (offset + 1) s_len + end + | 'x' -> begin + Buffer.add_char buf cur_char ; + two_hex loc buf s (offset + 1) s_len + end | _ -> Location.raise_errorf ~loc "invalid escape code" -and two_hex loc buf s offset s_len = - if offset + 1 >= s_len then +and two_hex loc buf s offset s_len = + if offset + 1 >= s_len then Location.raise_errorf ~loc "\\x need at least two chars"; - let a, b = s.[offset], s.[offset + 1] in - if Ext_char.valid_hex a && Ext_char.valid_hex b then - begin - Buffer.add_char buf a ; - Buffer.add_char buf b ; - check_and_transform loc buf s (offset + 2) s_len + let a, b = s.[offset], s.[offset + 1] in + if Ext_char.valid_hex a && Ext_char.valid_hex b then + begin + Buffer.add_char buf a ; + Buffer.add_char buf b ; + check_and_transform loc buf s (offset + 2) s_len end else Location.raise_errorf ~loc "%c%c is not a valid hex code" a b -and unicode loc buf s offset s_len = - if offset + 3 >= s_len then +and unicode loc buf s offset s_len = + if offset + 3 >= s_len then Location.raise_errorf ~loc "\\u need at least four chars"; let a0,a1,a2,a3 = s.[offset], s.[offset+1], s.[offset+2], s.[offset+3] in - if + if Ext_char.valid_hex a0 && Ext_char.valid_hex a1 && Ext_char.valid_hex a2 && - Ext_char.valid_hex a3 then - begin + Ext_char.valid_hex a3 then + begin Buffer.add_char buf a0; Buffer.add_char buf a1; Buffer.add_char buf a2; - Buffer.add_char buf a3; - check_and_transform loc buf s (offset + 4) s_len - end - else + Buffer.add_char buf a3; + check_and_transform loc buf s (offset + 4) s_len + end + else Location.raise_errorf ~loc "%c%c%c%c is not a valid unicode point" - a0 a1 a2 a3 + a0 a1 a2 a3 (* http://www.2ality.com/2015/01/es6-strings.html console.log('\uD83D\uDE80'); (* ES6*) console.log('\u{1F680}'); -*) +*) + +type interpo = Text of string | Delim of string + +type ('a, 'b) either = Left of 'a | Right of 'b + +let consume_text s start_index = + let rec _consume_text s index last_char new_word = + if index = String.length s then new_word, String.length s + else begin + match s.[index] with + | '\\' -> (if index + 1 = String.length s then "", index else + match s.[index+1] with + | '\\' -> _consume_text s (index+2) ' ' (Ext_string.append_char new_word '\\') + | '$' -> _consume_text s (index+2) ' ' (Ext_string.append_char new_word '$') + | c -> _consume_text s (index+1) '\\' (Ext_string.append_char new_word '\\')) + | '$' -> (new_word, index) + | c -> _consume_text s (index + 1) c (Ext_string.append_char new_word c) + end + in _consume_text s start_index ' ' "" + +let consume_delim s start_index = + let with_par = ref false in + let rec _consume_delim s index ident = + if index = String.length s then (if !with_par = true then (None, index) else (Some ident, index)) + else + match s.[index] with + | '(' -> (if !with_par = false then (with_par := true; _consume_delim s (index+1) ident) else (None, index)) + | ')' -> (if !with_par = false then (None, index + 1) else (with_par := false; (Some ident, index+1))) + | '$' -> (_consume_delim s (index+1) ident) + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9'| '_' ->_consume_delim s (index+1) (Ext_string.append_char ident s.[index]) + | _ -> if !with_par = false then (Some ident, index) else (None, index + 1) + in match s with + | "" -> (Some "", start_index) + | _ -> if start_index = String.length s then (Some "", start_index) + else (if s.[start_index] <> '$' then (None, start_index) + else _consume_delim s start_index "") + + +let compute_new_loc (loc:Location.t) s = let length = String.length s in + let new_loc = + {loc with loc_start = {loc.loc_start with pos_cnum = loc.loc_end.pos_cnum}; + loc_end = {loc.loc_start with pos_cnum = loc.loc_end.pos_cnum + length}} + in new_loc + +let error_reporting_loc (loc:Location.t) start_index end_index = + let new_loc = + {loc with loc_start = {loc.loc_start with pos_cnum = loc.loc_start.pos_cnum + start_index}; + loc_end = {loc.loc_end with pos_cnum = loc.loc_start.pos_cnum + end_index }} in new_loc + +let split_es6_string s = + let rec _split s index nl = + if index >= String.length s then Right (List.rev nl) + else begin + match consume_text s index, consume_delim s index with + | ("" , str_index) , (None , err_index) -> Left (index, err_index) + | (str, str_index) , (None , _) -> _split s (str_index) (Text str::nl) + | ("" , _), (Some "" , par_index) -> Left (index, par_index) + | ("" , _), (Some par, par_index) -> _split s (par_index) (Delim par::nl) + | _, _ -> Left (0, String.length s) + end in _split s 0 [] + +let make_string_constant_exp s loc = let new_loc = compute_new_loc loc s in + let new_exp:Parsetree.expression = { + pexp_loc = new_loc; + pexp_desc = Pexp_constant (Const_string (s, Some Literals.escaped_j_delimiter)); + pexp_attributes = []; + } in new_exp, new_loc + +let make_variable_exp p loc = let new_loc = compute_new_loc loc p in + let ident = Parsetree.Pexp_ident { txt = (Longident.Lident p); loc = loc } in + let js_to_string = Parsetree.Pexp_ident { txt = + Longident.Ldot (Longident.Ldot ((Longident.Lident "Js"), "String"), "make"); loc = loc } in + let apply_exp:Parsetree.expression_desc = Parsetree.Pexp_apply ({pexp_desc = js_to_string; pexp_loc = new_loc; pexp_attributes = []}, + [("", {pexp_desc = ident; pexp_loc = new_loc; pexp_attributes = []} )]) in + let new_exp:Parsetree.expression = { + pexp_loc = new_loc; + pexp_desc = apply_exp; + pexp_attributes = []; + } in new_exp, new_loc + +let rec _transform_individual_expression exp_list loc nl = match exp_list with + | [] -> List.rev nl + | exp::rexp -> match exp with + | Text s -> let new_exp, new_loc = make_string_constant_exp s loc in _transform_individual_expression rexp new_loc (new_exp::nl) + | Delim p -> let new_exp, new_loc = make_variable_exp p loc in _transform_individual_expression rexp new_loc (new_exp::nl) + +let transform_es6_style_template_string s loc = + let s_len = String.length s in + let buf = Buffer.create (s_len * 2) in + check_and_transform loc buf s 0 s_len; + let sub_strs = split_es6_string (Buffer.contents buf) + in match sub_strs with + | Left (starti, endi) -> let new_loc = error_reporting_loc loc starti endi in Location.raise_errorf ~loc:new_loc "Not a valid es6 style string" + | Right subs -> _transform_individual_expression subs loc [] + +let rec fold_expression_list_with_string_concat prev (exp_list:Parsetree.expression list) = match exp_list with + | [] -> prev + | (e::re) -> + let string_concat_exp:Parsetree.expression = {e with pexp_desc = Parsetree.Pexp_ident + {txt = Longident.Ldot (Longident.Lident ("Pervasives"), "^"); loc = e.pexp_loc}} in + let new_string_exp = {e with pexp_desc = Parsetree.Pexp_apply (string_concat_exp, [("", prev); ("", e)])} in + fold_expression_list_with_string_concat new_string_exp re + end module Ast_exp : sig #1 "ast_exp.mli" @@ -16789,16 +16892,16 @@ let rec unsafe_mapper : Ast_mapper.mapper = (Ast_comb.to_js_re_type loc) | Pexp_extension ({txt = "bs.external" | "external" ; loc }, payload) -> begin match Ast_payload.as_ident payload with - | Some {txt = Lident x} - -> Ast_util.handle_external loc x + | Some {txt = Lident x} + -> Ast_util.handle_external loc x (* do we need support [%external gg.xx ] - + {[ Js.Undefined.to_opt (if Js.typeof x == "undefined" then x else Js.Undefined.empty ) ]} *) - | None | Some _ -> - Location.raise_errorf ~loc - "external expects a single identifier" + | None | Some _ -> + Location.raise_errorf ~loc + "external expects a single identifier" end | Pexp_extension ({txt = ("bs.node" | "node"); loc}, @@ -16819,7 +16922,7 @@ let rec unsafe_mapper : Ast_mapper.mapper = Ast_util.handle_external loc (strip name) in let typ = Ast_core_type.lift_option_type - @@ + @@ if name = "_module" then Typ.constr ~loc { txt = Ldot (Lident "Node", "node_module") ; @@ -16847,13 +16950,16 @@ let rec unsafe_mapper : Ast_mapper.mapper = end |Pexp_constant (Const_string (s, (Some delim))) -> - if Ext_string.equal delim Literals.unescaped_js_delimiter then + if Ext_string.equal delim Literals.unescaped_js_delimiter then let s_len = String.length s in let buf = Buffer.create (s_len * 2) in Ast_utf8_string.check_and_transform loc buf s 0 s_len ; { e with pexp_desc = Pexp_constant (Const_string (Buffer.contents buf, Some Literals.escaped_j_delimiter))} - else if Ext_string.equal delim Literals.unescaped_j_delimiter then - Location.raise_errorf ~loc "{j||j} is reserved for future use" + else if Ext_string.equal delim Literals.unescaped_j_delimiter then + let starting_loc = {loc with loc_end = loc.loc_start} in + let empty_string_concat_exp = {e with pexp_desc = Pexp_constant (Const_string ("", None)); pexp_loc = starting_loc} in + let exps_list = Ast_utf8_string.transform_es6_style_template_string s starting_loc in + Ast_utf8_string.fold_expression_list_with_string_concat empty_string_concat_exp exps_list else e (** [bs.debugger], its output should not be rewritten any more*) @@ -17247,7 +17353,6 @@ let rewrite_implementation : (Parsetree.structure -> Parsetree.structure) ref = unsafe_mapper.structure unsafe_mapper x in reset (); result ) - end module Bsppx_main = struct diff --git a/jscomp/bin/whole_compiler.ml b/jscomp/bin/whole_compiler.ml index 8d2b5a7a39..fafe91cc68 100644 --- a/jscomp/bin/whole_compiler.ml +++ b/jscomp/bin/whole_compiler.ml @@ -1765,6 +1765,11 @@ val error: ?loc:t -> ?sub:error list -> ?if_highlight:string -> string -> error val errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string -> ('a, Format.formatter, unit, error) format4 -> 'a +val errorf_prefixed : ?loc:t -> ?sub:error list -> ?if_highlight:string + -> ('a, Format.formatter, unit, error) format4 -> 'a + (* same as {!errorf}, but prints the error prefix "Error:" before yielding + * to the format string *) + val raise_errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string -> ('a, Format.formatter, unit, 'b) format4 -> 'a @@ -2143,14 +2148,14 @@ let pp_ksprintf ?before k fmt = k msg) ppf fmt -(* Shift the formatter's offset by the length of the error prefix, which - is always added by the compiler after the message has been formatted *) -let print_phanton_error_prefix ppf = - Format.pp_print_as ppf (String.length error_prefix + 2 (* ": " *)) "" - let errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") fmt = pp_ksprintf - ~before:print_phanton_error_prefix + (fun msg -> {loc; msg; sub; if_highlight}) + fmt + +let errorf_prefixed ?(loc=none) ?(sub=[]) ?(if_highlight="") fmt = + pp_ksprintf + ~before:(fun ppf -> fprintf ppf "%a " print_error_prefix ()) (fun msg -> {loc; msg; sub; if_highlight}) fmt @@ -2185,8 +2190,10 @@ let rec default_error_reporter ppf ({loc; msg; sub; if_highlight} as err) = if highlighted then Format.pp_print_string ppf if_highlight else begin - fprintf ppf "%a%a %s" print loc print_error_prefix () msg; - List.iter (Format.fprintf ppf "@\n@[<2>%a@]" default_error_reporter) sub + print ppf loc; + Format.pp_print_string ppf msg; + List.iter (fun err -> Format.fprintf ppf "@\n@[<2>%a@]" default_error_reporter err) + sub end let error_reporter = ref default_error_reporter @@ -2196,7 +2203,7 @@ let report_error ppf err = ;; let error_of_printer loc print x = - errorf ~loc "%a@?" print x + errorf_prefixed ~loc "%a@?" print x let error_of_printer_file print x = error_of_printer (in_file !input_name) print x @@ -2205,11 +2212,11 @@ let () = register_error_of_exn (function | Sys_error msg -> - Some (errorf ~loc:(in_file !input_name) + Some (errorf_prefixed ~loc:(in_file !input_name) "I/O error: %s" msg) | Warnings.Errors n -> Some - (errorf ~loc:(in_file !input_name) + (errorf_prefixed ~loc:(in_file !input_name) "Some fatal warnings were triggered (%d occurrences)" n) | _ -> None @@ -2237,9 +2244,7 @@ let () = ) let raise_errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") = - pp_ksprintf - ~before:print_phanton_error_prefix - (fun msg -> raise (Error ({loc; msg; sub; if_highlight}))) + pp_ksprintf (fun msg -> raise (Error ({loc; msg; sub; if_highlight}))) end (** Interface as module *) @@ -4646,9 +4651,9 @@ exception Escape_error let prepare_error = function | Unclosed(opening_loc, opening, closing_loc, closing) -> - Location.errorf ~loc:closing_loc + Location.errorf_prefixed ~loc:closing_loc ~sub:[ - Location.errorf ~loc:opening_loc + Location.errorf_prefixed ~loc:opening_loc "This '%s' might be unmatched" opening ] ~if_highlight: @@ -4658,22 +4663,22 @@ let prepare_error = function "Syntax error: '%s' expected" closing | Expecting (loc, nonterm) -> - Location.errorf ~loc "Syntax error: %s expected." nonterm + Location.errorf_prefixed ~loc "Syntax error: %s expected." nonterm | Not_expecting (loc, nonterm) -> - Location.errorf ~loc "Syntax error: %s not expected." nonterm + Location.errorf_prefixed ~loc "Syntax error: %s not expected." nonterm | Applicative_path loc -> - Location.errorf ~loc + Location.errorf_prefixed ~loc "Syntax error: applicative paths of the form F(X).t \ are not supported when the option -no-app-func is set." | Variable_in_scope (loc, var) -> - Location.errorf ~loc + Location.errorf_prefixed ~loc "In this scoped type, variable '%s \ is reserved for the local type %s." var var | Other loc -> - Location.errorf ~loc "Syntax error" + Location.errorf_prefixed ~loc "Syntax error" | Ill_formed_ast (loc, s) -> - Location.errorf ~loc "broken invariant in parsetree: %s" s + Location.errorf_prefixed ~loc "broken invariant in parsetree: %s" s let () = Location.register_error_of_exn @@ -20733,6 +20738,8 @@ val single_colon : string val parent_dir_lit : string val current_dir_lit : string +val append_char : string -> char -> string + end = struct #1 "ext_string.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. @@ -20764,6 +20771,7 @@ end = struct +let append_char s c = s ^ String.make 1 c (* {[ split " test_unsafe_obj_ffi_ppx.cmi" ~keep_empty:false ' ']} @@ -100009,13 +100017,6 @@ let decode_utf8_string s = in decode_utf8_cont s 0 (String.length s); List.rev !lst - -(** To decode {j||j} we need verify in the ast so that we have better error - location, then we do the decode later -*) - -let verify s loc = - assert false end module Ext_js_regex : sig #1 "ext_js_regex.mli" @@ -103427,7 +103428,7 @@ module Ast_utf8_string = struct #1 "ast_utf8_string.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -103445,132 +103446,234 @@ module Ast_utf8_string * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - let rec check_and_transform loc buf s byte_offset s_len = if byte_offset = s_len then () - else - let current_char = s.[byte_offset] in - match Ext_utf8.classify current_char with - | Single c -> - if c = 92 (* Char.code '\\' = 92 *)then - begin + else + let current_char = s.[byte_offset] in + match Ext_utf8.classify current_char with + | Single c -> + if c = 92 (* Char.code '\\' = 92 *)then + begin (* we share the same escape sequence with js *) - Buffer.add_char buf current_char; - escape_code loc buf s (byte_offset+1) s_len - end + Buffer.add_char buf current_char; + escape_code loc buf s (byte_offset+1) s_len + end else - begin - (if c = 34 (* Char.code '\"' = 34 *) || c = 39 (* Char.code '\'' = 39 *) then - begin + begin + (if c = 34 (* Char.code '\"' = 34 *) || c = 39 (* Char.code '\'' = 39 *) then + begin Buffer.add_char buf '\\'; - Buffer.add_char buf current_char ; + Buffer.add_char buf current_char ; end - else if c = 10 then begin + else if c = 10 then begin (* Char.code '\n' = 10 *) (* we can not just print new line*) Buffer.add_string buf "\\n"; - (* seems we don't need - escape "\b" "\f" - we need escape "\n" "\r" since + (* seems we don't need + escape "\b" "\f" + we need escape "\n" "\r" since ocaml multiple-line allows [\n] - visual input while es5 string - does not + visual input while es5 string + does not *) - end - else if c = 13 then begin - Buffer.add_string buf "\\r" - end - else begin + end + else if c = 13 then begin + Buffer.add_string buf "\\r" + end + else begin Buffer.add_char buf current_char; end); - check_and_transform loc buf s (byte_offset + 1) s_len + check_and_transform loc buf s (byte_offset + 1) s_len end - | Invalid + | Invalid | Cont _ -> Location.raise_errorf ~loc "Not utf8 source string" - | Leading (n,_) -> + | Leading (n,_) -> let i' = Ext_utf8.next s ~remaining:n byte_offset in - if i' < 0 then + if i' < 0 then Location.raise_errorf ~loc "Not valid utf8 souce string" - else - begin - for k = byte_offset to i' do - Buffer.add_char buf s.[k]; - done; - check_and_transform loc buf s (i' + 1) s_len + else + begin + for k = byte_offset to i' do + Buffer.add_char buf s.[k]; + done; + check_and_transform loc buf s (i' + 1) s_len end -and escape_code loc buf s offset s_len = - if offset >= s_len then - Location.raise_errorf ~loc "\\ is the end of string" - else - let cur_char = s.[offset] in - match cur_char with +and escape_code loc buf s offset s_len = + if offset >= s_len then + Location.raise_errorf ~loc "\\ is the end of string" + else + let cur_char = s.[offset] in + match cur_char with | '\\' - | 'b' - | 't' - | 'n' + | 'b' + | 't' + | 'n' | 'v' | 'f' - | 'r' - | '0' + | 'r' + | '0' | '$' - -> - begin + -> + begin Buffer.add_char buf cur_char ; - check_and_transform loc buf s (offset + 1) s_len - end - | 'u' -> - begin + check_and_transform loc buf s (offset + 1) s_len + end + | 'u' -> + begin Buffer.add_char buf cur_char; - unicode loc buf s (offset + 1) s_len - end - | 'x' -> begin - Buffer.add_char buf cur_char ; - two_hex loc buf s (offset + 1) s_len - end + unicode loc buf s (offset + 1) s_len + end + | 'x' -> begin + Buffer.add_char buf cur_char ; + two_hex loc buf s (offset + 1) s_len + end | _ -> Location.raise_errorf ~loc "invalid escape code" -and two_hex loc buf s offset s_len = - if offset + 1 >= s_len then +and two_hex loc buf s offset s_len = + if offset + 1 >= s_len then Location.raise_errorf ~loc "\\x need at least two chars"; - let a, b = s.[offset], s.[offset + 1] in - if Ext_char.valid_hex a && Ext_char.valid_hex b then - begin - Buffer.add_char buf a ; - Buffer.add_char buf b ; - check_and_transform loc buf s (offset + 2) s_len + let a, b = s.[offset], s.[offset + 1] in + if Ext_char.valid_hex a && Ext_char.valid_hex b then + begin + Buffer.add_char buf a ; + Buffer.add_char buf b ; + check_and_transform loc buf s (offset + 2) s_len end else Location.raise_errorf ~loc "%c%c is not a valid hex code" a b -and unicode loc buf s offset s_len = - if offset + 3 >= s_len then +and unicode loc buf s offset s_len = + if offset + 3 >= s_len then Location.raise_errorf ~loc "\\u need at least four chars"; let a0,a1,a2,a3 = s.[offset], s.[offset+1], s.[offset+2], s.[offset+3] in - if + if Ext_char.valid_hex a0 && Ext_char.valid_hex a1 && Ext_char.valid_hex a2 && - Ext_char.valid_hex a3 then - begin + Ext_char.valid_hex a3 then + begin Buffer.add_char buf a0; Buffer.add_char buf a1; Buffer.add_char buf a2; - Buffer.add_char buf a3; - check_and_transform loc buf s (offset + 4) s_len - end - else + Buffer.add_char buf a3; + check_and_transform loc buf s (offset + 4) s_len + end + else Location.raise_errorf ~loc "%c%c%c%c is not a valid unicode point" - a0 a1 a2 a3 + a0 a1 a2 a3 (* http://www.2ality.com/2015/01/es6-strings.html console.log('\uD83D\uDE80'); (* ES6*) console.log('\u{1F680}'); -*) +*) + +type interpo = Text of string | Delim of string + +type ('a, 'b) either = Left of 'a | Right of 'b + +let consume_text s start_index = + let rec _consume_text s index last_char new_word = + if index = String.length s then new_word, String.length s + else begin + match s.[index] with + | '\\' -> (if index + 1 = String.length s then "", index else + match s.[index+1] with + | '\\' -> _consume_text s (index+2) ' ' (Ext_string.append_char new_word '\\') + | '$' -> _consume_text s (index+2) ' ' (Ext_string.append_char new_word '$') + | c -> _consume_text s (index+1) '\\' (Ext_string.append_char new_word '\\')) + | '$' -> (new_word, index) + | c -> _consume_text s (index + 1) c (Ext_string.append_char new_word c) + end + in _consume_text s start_index ' ' "" + +let consume_delim s start_index = + let with_par = ref false in + let rec _consume_delim s index ident = + if index = String.length s then (if !with_par = true then (None, index) else (Some ident, index)) + else + match s.[index] with + | '(' -> (if !with_par = false then (with_par := true; _consume_delim s (index+1) ident) else (None, index)) + | ')' -> (if !with_par = false then (None, index + 1) else (with_par := false; (Some ident, index+1))) + | '$' -> (_consume_delim s (index+1) ident) + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9'| '_' ->_consume_delim s (index+1) (Ext_string.append_char ident s.[index]) + | _ -> if !with_par = false then (Some ident, index) else (None, index + 1) + in match s with + | "" -> (Some "", start_index) + | _ -> if start_index = String.length s then (Some "", start_index) + else (if s.[start_index] <> '$' then (None, start_index) + else _consume_delim s start_index "") + + +let compute_new_loc (loc:Location.t) s = let length = String.length s in + let new_loc = + {loc with loc_start = {loc.loc_start with pos_cnum = loc.loc_end.pos_cnum}; + loc_end = {loc.loc_start with pos_cnum = loc.loc_end.pos_cnum + length}} + in new_loc + +let error_reporting_loc (loc:Location.t) start_index end_index = + let new_loc = + {loc with loc_start = {loc.loc_start with pos_cnum = loc.loc_start.pos_cnum + start_index}; + loc_end = {loc.loc_end with pos_cnum = loc.loc_start.pos_cnum + end_index }} in new_loc + +let split_es6_string s = + let rec _split s index nl = + if index >= String.length s then Right (List.rev nl) + else begin + match consume_text s index, consume_delim s index with + | ("" , str_index) , (None , err_index) -> Left (index, err_index) + | (str, str_index) , (None , _) -> _split s (str_index) (Text str::nl) + | ("" , _), (Some "" , par_index) -> Left (index, par_index) + | ("" , _), (Some par, par_index) -> _split s (par_index) (Delim par::nl) + | _, _ -> Left (0, String.length s) + end in _split s 0 [] + +let make_string_constant_exp s loc = let new_loc = compute_new_loc loc s in + let new_exp:Parsetree.expression = { + pexp_loc = new_loc; + pexp_desc = Pexp_constant (Const_string (s, Some Literals.escaped_j_delimiter)); + pexp_attributes = []; + } in new_exp, new_loc + +let make_variable_exp p loc = let new_loc = compute_new_loc loc p in + let ident = Parsetree.Pexp_ident { txt = (Longident.Lident p); loc = loc } in + let js_to_string = Parsetree.Pexp_ident { txt = + Longident.Ldot (Longident.Ldot ((Longident.Lident "Js"), "String"), "make"); loc = loc } in + let apply_exp:Parsetree.expression_desc = Parsetree.Pexp_apply ({pexp_desc = js_to_string; pexp_loc = new_loc; pexp_attributes = []}, + [("", {pexp_desc = ident; pexp_loc = new_loc; pexp_attributes = []} )]) in + let new_exp:Parsetree.expression = { + pexp_loc = new_loc; + pexp_desc = apply_exp; + pexp_attributes = []; + } in new_exp, new_loc + +let rec _transform_individual_expression exp_list loc nl = match exp_list with + | [] -> List.rev nl + | exp::rexp -> match exp with + | Text s -> let new_exp, new_loc = make_string_constant_exp s loc in _transform_individual_expression rexp new_loc (new_exp::nl) + | Delim p -> let new_exp, new_loc = make_variable_exp p loc in _transform_individual_expression rexp new_loc (new_exp::nl) + +let transform_es6_style_template_string s loc = + let s_len = String.length s in + let buf = Buffer.create (s_len * 2) in + check_and_transform loc buf s 0 s_len; + let sub_strs = split_es6_string (Buffer.contents buf) + in match sub_strs with + | Left (starti, endi) -> let new_loc = error_reporting_loc loc starti endi in Location.raise_errorf ~loc:new_loc "Not a valid es6 style string" + | Right subs -> _transform_individual_expression subs loc [] + +let rec fold_expression_list_with_string_concat prev (exp_list:Parsetree.expression list) = match exp_list with + | [] -> prev + | (e::re) -> + let string_concat_exp:Parsetree.expression = {e with pexp_desc = Parsetree.Pexp_ident + {txt = Longident.Ldot (Longident.Lident ("Pervasives"), "^"); loc = e.pexp_loc}} in + let new_string_exp = {e with pexp_desc = Parsetree.Pexp_apply (string_concat_exp, [("", prev); ("", e)])} in + fold_expression_list_with_string_concat new_string_exp re + end module Ast_exp : sig #1 "ast_exp.mli" @@ -105079,16 +105182,16 @@ let rec unsafe_mapper : Ast_mapper.mapper = (Ast_comb.to_js_re_type loc) | Pexp_extension ({txt = "bs.external" | "external" ; loc }, payload) -> begin match Ast_payload.as_ident payload with - | Some {txt = Lident x} - -> Ast_util.handle_external loc x + | Some {txt = Lident x} + -> Ast_util.handle_external loc x (* do we need support [%external gg.xx ] - + {[ Js.Undefined.to_opt (if Js.typeof x == "undefined" then x else Js.Undefined.empty ) ]} *) - | None | Some _ -> - Location.raise_errorf ~loc - "external expects a single identifier" + | None | Some _ -> + Location.raise_errorf ~loc + "external expects a single identifier" end | Pexp_extension ({txt = ("bs.node" | "node"); loc}, @@ -105109,7 +105212,7 @@ let rec unsafe_mapper : Ast_mapper.mapper = Ast_util.handle_external loc (strip name) in let typ = Ast_core_type.lift_option_type - @@ + @@ if name = "_module" then Typ.constr ~loc { txt = Ldot (Lident "Node", "node_module") ; @@ -105137,13 +105240,16 @@ let rec unsafe_mapper : Ast_mapper.mapper = end |Pexp_constant (Const_string (s, (Some delim))) -> - if Ext_string.equal delim Literals.unescaped_js_delimiter then + if Ext_string.equal delim Literals.unescaped_js_delimiter then let s_len = String.length s in let buf = Buffer.create (s_len * 2) in Ast_utf8_string.check_and_transform loc buf s 0 s_len ; { e with pexp_desc = Pexp_constant (Const_string (Buffer.contents buf, Some Literals.escaped_j_delimiter))} - else if Ext_string.equal delim Literals.unescaped_j_delimiter then - Location.raise_errorf ~loc "{j||j} is reserved for future use" + else if Ext_string.equal delim Literals.unescaped_j_delimiter then + let starting_loc = {loc with loc_end = loc.loc_start} in + let empty_string_concat_exp = {e with pexp_desc = Pexp_constant (Const_string ("", None)); pexp_loc = starting_loc} in + let exps_list = Ast_utf8_string.transform_es6_style_template_string s starting_loc in + Ast_utf8_string.fold_expression_list_with_string_concat empty_string_concat_exp exps_list else e (** [bs.debugger], its output should not be rewritten any more*) @@ -105537,7 +105643,6 @@ let rewrite_implementation : (Parsetree.structure -> Parsetree.structure) ref = unsafe_mapper.structure unsafe_mapper x in reset (); result ) - end module Ocaml_parse : sig #1 "ocaml_parse.mli" diff --git a/jscomp/ext/ext_string.ml b/jscomp/ext/ext_string.ml index d5ef55fdf9..80a3b64341 100644 --- a/jscomp/ext/ext_string.ml +++ b/jscomp/ext/ext_string.ml @@ -27,6 +27,7 @@ +let append_char s c = s ^ String.make 1 c (* {[ split " test_unsafe_obj_ffi_ppx.cmi" ~keep_empty:false ' ']} diff --git a/jscomp/ext/ext_string.mli b/jscomp/ext/ext_string.mli index 39f96f37f9..31dfa4e976 100644 --- a/jscomp/ext/ext_string.mli +++ b/jscomp/ext/ext_string.mli @@ -139,3 +139,5 @@ val single_colon : string val parent_dir_lit : string val current_dir_lit : string + +val append_char : string -> char -> string diff --git a/jscomp/ext/ext_utf8.ml b/jscomp/ext/ext_utf8.ml index aa118e31db..d7841ae5b8 100644 --- a/jscomp/ext/ext_utf8.ml +++ b/jscomp/ext/ext_utf8.ml @@ -93,11 +93,3 @@ let decode_utf8_string s = end in decode_utf8_cont s 0 (String.length s); List.rev !lst - - -(** To decode {j||j} we need verify in the ast so that we have better error - location, then we do the decode later -*) - -let verify s loc = - assert false \ No newline at end of file diff --git a/jscomp/ounit_tests/ounit_utf8_test.ml b/jscomp/ounit_tests/ounit_utf8_test.ml index 7eb0a66355..b9565d34af 100644 --- a/jscomp/ounit_tests/ounit_utf8_test.ml +++ b/jscomp/ounit_tests/ounit_utf8_test.ml @@ -4,20 +4,120 @@ *) let ((>::), - (>:::)) = OUnit.((>::),(>:::)) + (>:::)) = OUnit.((>::),(>:::)) + + +let loc = + { + Location.loc_start = { + pos_fname = "dummy"; + pos_lnum = 0; + pos_bol = 0; + pos_cnum = 0; + }; + loc_end = { + pos_fname = "dummy"; + pos_lnum = 0; + pos_bol = 0; + pos_cnum = 0; + + }; + loc_ghost = false; + };; + +let rec print_es6_string_list = function + | [] -> () + | (Ast_utf8_string.Text s::nl) -> print_string "Text "; print_endline (s^";"); print_es6_string_list nl + | (Delim s::nl) -> print_string "Delim "; print_endline (s^";"); print_es6_string_list nl + + +let print_es6_string_list_either e = match e with + | Ast_utf8_string.Left _ -> () + | Right nl -> print_es6_string_list nl let (=~) = OUnit.assert_equal let suites = - __FILE__ - >::: - [ - __LOC__ >:: begin fun _ -> - Ext_utf8.decode_utf8_string - "hello 你好，中华民族 hei" =~ - [104; 101; 108; 108; 111; 32; 20320; 22909; 65292; 20013; 21326; 27665; 26063; 32; 104; 101; 105] - end ; - __LOC__ >:: begin fun _ -> - Ext_utf8.decode_utf8_string - "" =~ [] - end - ] \ No newline at end of file + __FILE__ + >::: + [ + __LOC__ >:: begin fun _ -> + Ext_utf8.decode_utf8_string + "hello 你好，中华民族 hei" =~ + [104; 101; 108; 108; 111; 32; 20320; 22909; 65292; 20013; 21326; 27665; 26063; 32; 104; 101; 105] + end ; + __LOC__ >:: begin fun _ -> + Ext_utf8.decode_utf8_string + "" =~ [] + end; + __LOC__ >:: begin fun _ -> + Ext_string.append_char "Hell" 'o' =~ "Hello" + end; + __LOC__ >:: begin fun _ -> + let s, i = Ast_utf8_string.consume_text "Hello $world" 0 in + (s, i) =~ ("Hello ", 6) + end; + __LOC__ >:: begin fun _ -> + let s, new_index = Ast_utf8_string.consume_text "Hello \\$world" 0 in + let _ = s =~ "Hello $world" in + let _ = new_index =~ String.length "Hello \\$world" in () + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.consume_text "" 0 =~ ("", 0) + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.consume_delim "" 0 =~ (Some "", 0) + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.consume_delim "$x" 0 =~ (Some "x", 2) + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.consume_delim "$(x)" 0 =~ (Some "x", 4) + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.consume_delim "hello world" 0 =~ (None, 0) + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.consume_delim "$(hello" 0 =~ (None, 7) + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.consume_delim "$x)" 0 =~ (None, 3) + end; + __LOC__ >:: begin fun _ -> + Ast_utf8_string.consume_delim "$(hello world)" 0 =~ (None, 8) + end; + __LOC__ >:: begin fun _ -> + let l = Ast_utf8_string.split_es6_string "Hello World" in + l =~ Right [Text "Hello World"] + end; + __LOC__ >:: begin fun _ -> + let l = Ast_utf8_string.split_es6_string "Hello $name" in + l =~ Right [Text "Hello "; Delim "name"] + end; + __LOC__ >:: begin fun _ -> + let l = Ast_utf8_string.split_es6_string "$x is my name" in + l =~ Right [Delim "x"; Text " is my name"] + end; + __LOC__ >:: begin fun _ -> + let l = Ast_utf8_string.split_es6_string "$(country) is beautiful" in + l =~ Right [Delim "country"; Text " is beautiful"] + end; + __LOC__ >:: begin fun _ -> + let l = Ast_utf8_string.split_es6_string "hello $x_1, welcome to $(x_2)" in + l =~ Right [Text "hello "; Delim "x_1"; Text ", welcome to "; Delim "x_2"] + end; + __LOC__ >:: begin fun _ -> + (* Testing {j|\\$x|j}*) + let l = Ast_utf8_string.split_es6_string {|\\$x|} in + l =~ Right [Text "\\"; Delim "x"] + end; + __LOC__ >:: begin fun _ -> + (*{j| \$ |j}*) + let l = Ast_utf8_string.split_es6_string {|\$|} in + l =~ Right [Text "$"] + end; + __LOC__ >:: begin fun _ -> + (*{j| \\\$x |j}*) + let l = Ast_utf8_string.split_es6_string {|\\\$x|} in + l =~ Right [Text "\$x"] + end; + ] \ No newline at end of file diff --git a/jscomp/syntax/ast_utf8_string.ml b/jscomp/syntax/ast_utf8_string.ml index 1196ab4094..add2b7c587 100644 --- a/jscomp/syntax/ast_utf8_string.ml +++ b/jscomp/syntax/ast_utf8_string.ml @@ -1,5 +1,5 @@ (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,129 +17,230 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - let rec check_and_transform loc buf s byte_offset s_len = if byte_offset = s_len then () - else - let current_char = s.[byte_offset] in - match Ext_utf8.classify current_char with - | Single c -> - if c = 92 (* Char.code '\\' = 92 *)then - begin + else + let current_char = s.[byte_offset] in + match Ext_utf8.classify current_char with + | Single c -> + if c = 92 (* Char.code '\\' = 92 *)then + begin (* we share the same escape sequence with js *) - Buffer.add_char buf current_char; - escape_code loc buf s (byte_offset+1) s_len - end + Buffer.add_char buf current_char; + escape_code loc buf s (byte_offset+1) s_len + end else - begin - (if c = 34 (* Char.code '\"' = 34 *) || c = 39 (* Char.code '\'' = 39 *) then - begin + begin + (if c = 34 (* Char.code '\"' = 34 *) || c = 39 (* Char.code '\'' = 39 *) then + begin Buffer.add_char buf '\\'; - Buffer.add_char buf current_char ; + Buffer.add_char buf current_char ; end - else if c = 10 then begin + else if c = 10 then begin (* Char.code '\n' = 10 *) (* we can not just print new line*) Buffer.add_string buf "\\n"; - (* seems we don't need - escape "\b" "\f" - we need escape "\n" "\r" since + (* seems we don't need + escape "\b" "\f" + we need escape "\n" "\r" since ocaml multiple-line allows [\n] - visual input while es5 string - does not + visual input while es5 string + does not *) - end - else if c = 13 then begin - Buffer.add_string buf "\\r" - end - else begin + end + else if c = 13 then begin + Buffer.add_string buf "\\r" + end + else begin Buffer.add_char buf current_char; end); - check_and_transform loc buf s (byte_offset + 1) s_len + check_and_transform loc buf s (byte_offset + 1) s_len end - | Invalid + | Invalid | Cont _ -> Location.raise_errorf ~loc "Not utf8 source string" - | Leading (n,_) -> + | Leading (n,_) -> let i' = Ext_utf8.next s ~remaining:n byte_offset in - if i' < 0 then + if i' < 0 then Location.raise_errorf ~loc "Not valid utf8 souce string" - else - begin - for k = byte_offset to i' do - Buffer.add_char buf s.[k]; - done; - check_and_transform loc buf s (i' + 1) s_len + else + begin + for k = byte_offset to i' do + Buffer.add_char buf s.[k]; + done; + check_and_transform loc buf s (i' + 1) s_len end -and escape_code loc buf s offset s_len = - if offset >= s_len then - Location.raise_errorf ~loc "\\ is the end of string" - else - let cur_char = s.[offset] in - match cur_char with +and escape_code loc buf s offset s_len = + if offset >= s_len then + Location.raise_errorf ~loc "\\ is the end of string" + else + let cur_char = s.[offset] in + match cur_char with | '\\' - | 'b' - | 't' - | 'n' + | 'b' + | 't' + | 'n' | 'v' | 'f' - | 'r' - | '0' + | 'r' + | '0' | '$' - -> - begin + -> + begin Buffer.add_char buf cur_char ; - check_and_transform loc buf s (offset + 1) s_len - end - | 'u' -> - begin + check_and_transform loc buf s (offset + 1) s_len + end + | 'u' -> + begin Buffer.add_char buf cur_char; - unicode loc buf s (offset + 1) s_len - end - | 'x' -> begin - Buffer.add_char buf cur_char ; - two_hex loc buf s (offset + 1) s_len - end + unicode loc buf s (offset + 1) s_len + end + | 'x' -> begin + Buffer.add_char buf cur_char ; + two_hex loc buf s (offset + 1) s_len + end | _ -> Location.raise_errorf ~loc "invalid escape code" -and two_hex loc buf s offset s_len = - if offset + 1 >= s_len then +and two_hex loc buf s offset s_len = + if offset + 1 >= s_len then Location.raise_errorf ~loc "\\x need at least two chars"; - let a, b = s.[offset], s.[offset + 1] in - if Ext_char.valid_hex a && Ext_char.valid_hex b then - begin - Buffer.add_char buf a ; - Buffer.add_char buf b ; - check_and_transform loc buf s (offset + 2) s_len + let a, b = s.[offset], s.[offset + 1] in + if Ext_char.valid_hex a && Ext_char.valid_hex b then + begin + Buffer.add_char buf a ; + Buffer.add_char buf b ; + check_and_transform loc buf s (offset + 2) s_len end else Location.raise_errorf ~loc "%c%c is not a valid hex code" a b -and unicode loc buf s offset s_len = - if offset + 3 >= s_len then +and unicode loc buf s offset s_len = + if offset + 3 >= s_len then Location.raise_errorf ~loc "\\u need at least four chars"; let a0,a1,a2,a3 = s.[offset], s.[offset+1], s.[offset+2], s.[offset+3] in - if + if Ext_char.valid_hex a0 && Ext_char.valid_hex a1 && Ext_char.valid_hex a2 && - Ext_char.valid_hex a3 then - begin + Ext_char.valid_hex a3 then + begin Buffer.add_char buf a0; Buffer.add_char buf a1; Buffer.add_char buf a2; - Buffer.add_char buf a3; - check_and_transform loc buf s (offset + 4) s_len - end - else + Buffer.add_char buf a3; + check_and_transform loc buf s (offset + 4) s_len + end + else Location.raise_errorf ~loc "%c%c%c%c is not a valid unicode point" - a0 a1 a2 a3 + a0 a1 a2 a3 (* http://www.2ality.com/2015/01/es6-strings.html console.log('\uD83D\uDE80'); (* ES6*) console.log('\u{1F680}'); -*) \ No newline at end of file +*) + +type interpo = Text of string | Delim of string + +type ('a, 'b) either = Left of 'a | Right of 'b + +let consume_text s start_index = + let rec _consume_text s index last_char new_word = + if index = String.length s then new_word, String.length s + else begin + match s.[index] with + | '\\' -> (if index + 1 = String.length s then "", index else + match s.[index+1] with + | '\\' -> _consume_text s (index+2) ' ' (Ext_string.append_char new_word '\\') + | '$' -> _consume_text s (index+2) ' ' (Ext_string.append_char new_word '$') + | c -> _consume_text s (index+1) '\\' (Ext_string.append_char new_word '\\')) + | '$' -> (new_word, index) + | c -> _consume_text s (index + 1) c (Ext_string.append_char new_word c) + end + in _consume_text s start_index ' ' "" + +let consume_delim s start_index = + let with_par = ref false in + let rec _consume_delim s index ident = + if index = String.length s then (if !with_par = true then (None, index) else (Some ident, index)) + else + match s.[index] with + | '(' -> (if !with_par = false then (with_par := true; _consume_delim s (index+1) ident) else (None, index)) + | ')' -> (if !with_par = false then (None, index + 1) else (with_par := false; (Some ident, index+1))) + | '$' -> (_consume_delim s (index+1) ident) + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9'| '_' ->_consume_delim s (index+1) (Ext_string.append_char ident s.[index]) + | _ -> if !with_par = false then (Some ident, index) else (None, index + 1) + in match s with + | "" -> (Some "", start_index) + | _ -> if start_index = String.length s then (Some "", start_index) + else (if s.[start_index] <> '$' then (None, start_index) + else _consume_delim s start_index "") + + +let compute_new_loc (loc:Location.t) s = let length = String.length s in + let new_loc = + {loc with loc_start = {loc.loc_start with pos_cnum = loc.loc_end.pos_cnum}; + loc_end = {loc.loc_start with pos_cnum = loc.loc_end.pos_cnum + length}} + in new_loc + +let error_reporting_loc (loc:Location.t) start_index end_index = + let new_loc = + {loc with loc_start = {loc.loc_start with pos_cnum = loc.loc_start.pos_cnum + start_index}; + loc_end = {loc.loc_end with pos_cnum = loc.loc_start.pos_cnum + end_index }} in new_loc + +let split_es6_string s = + let rec _split s index nl = + if index >= String.length s then Right (List.rev nl) + else begin + match consume_text s index, consume_delim s index with + | ("" , str_index) , (None , err_index) -> Left (index, err_index) + | (str, str_index) , (None , _) -> _split s (str_index) (Text str::nl) + | ("" , _), (Some "" , par_index) -> Left (index, par_index) + | ("" , _), (Some par, par_index) -> _split s (par_index) (Delim par::nl) + | _, _ -> Left (0, String.length s) + end in _split s 0 [] + +let make_string_constant_exp s loc = let new_loc = compute_new_loc loc s in + let new_exp:Parsetree.expression = { + pexp_loc = new_loc; + pexp_desc = Pexp_constant (Const_string (s, Some Literals.escaped_j_delimiter)); + pexp_attributes = []; + } in new_exp, new_loc + +let make_variable_exp p loc = let new_loc = compute_new_loc loc p in + let ident = Parsetree.Pexp_ident { txt = (Longident.Lident p); loc = loc } in + let js_to_string = Parsetree.Pexp_ident { txt = + Longident.Ldot (Longident.Ldot ((Longident.Lident "Js"), "String"), "make"); loc = loc } in + let apply_exp:Parsetree.expression_desc = Parsetree.Pexp_apply ({pexp_desc = js_to_string; pexp_loc = new_loc; pexp_attributes = []}, + [("", {pexp_desc = ident; pexp_loc = new_loc; pexp_attributes = []} )]) in + let new_exp:Parsetree.expression = { + pexp_loc = new_loc; + pexp_desc = apply_exp; + pexp_attributes = []; + } in new_exp, new_loc + +let rec _transform_individual_expression exp_list loc nl = match exp_list with + | [] -> List.rev nl + | exp::rexp -> match exp with + | Text s -> let new_exp, new_loc = make_string_constant_exp s loc in _transform_individual_expression rexp new_loc (new_exp::nl) + | Delim p -> let new_exp, new_loc = make_variable_exp p loc in _transform_individual_expression rexp new_loc (new_exp::nl) + +let transform_es6_style_template_string s loc = + let s_len = String.length s in + let buf = Buffer.create (s_len * 2) in + check_and_transform loc buf s 0 s_len; + let sub_strs = split_es6_string (Buffer.contents buf) + in match sub_strs with + | Left (starti, endi) -> let new_loc = error_reporting_loc loc starti endi in Location.raise_errorf ~loc:new_loc "Not a valid es6 style string" + | Right subs -> _transform_individual_expression subs loc [] + +let rec fold_expression_list_with_string_concat prev (exp_list:Parsetree.expression list) = match exp_list with + | [] -> prev + | (e::re) -> + let string_concat_exp:Parsetree.expression = {e with pexp_desc = Parsetree.Pexp_ident + {txt = Longident.Ldot (Longident.Lident ("Pervasives"), "^"); loc = e.pexp_loc}} in + let new_string_exp = {e with pexp_desc = Parsetree.Pexp_apply (string_concat_exp, [("", prev); ("", e)])} in + fold_expression_list_with_string_concat new_string_exp re diff --git a/jscomp/syntax/ppx_entry.ml b/jscomp/syntax/ppx_entry.ml index d105f80bf4..fa500dbacf 100644 --- a/jscomp/syntax/ppx_entry.ml +++ b/jscomp/syntax/ppx_entry.ml @@ -271,16 +271,16 @@ let rec unsafe_mapper : Ast_mapper.mapper = (Ast_comb.to_js_re_type loc) | Pexp_extension ({txt = "bs.external" | "external" ; loc }, payload) -> begin match Ast_payload.as_ident payload with - | Some {txt = Lident x} - -> Ast_util.handle_external loc x + | Some {txt = Lident x} + -> Ast_util.handle_external loc x (* do we need support [%external gg.xx ] - + {[ Js.Undefined.to_opt (if Js.typeof x == "undefined" then x else Js.Undefined.empty ) ]} *) - | None | Some _ -> - Location.raise_errorf ~loc - "external expects a single identifier" + | None | Some _ -> + Location.raise_errorf ~loc + "external expects a single identifier" end | Pexp_extension ({txt = ("bs.node" | "node"); loc}, @@ -301,7 +301,7 @@ let rec unsafe_mapper : Ast_mapper.mapper = Ast_util.handle_external loc (strip name) in let typ = Ast_core_type.lift_option_type - @@ + @@ if name = "_module" then Typ.constr ~loc { txt = Ldot (Lident "Node", "node_module") ; @@ -329,13 +329,16 @@ let rec unsafe_mapper : Ast_mapper.mapper = end |Pexp_constant (Const_string (s, (Some delim))) -> - if Ext_string.equal delim Literals.unescaped_js_delimiter then + if Ext_string.equal delim Literals.unescaped_js_delimiter then let s_len = String.length s in let buf = Buffer.create (s_len * 2) in Ast_utf8_string.check_and_transform loc buf s 0 s_len ; { e with pexp_desc = Pexp_constant (Const_string (Buffer.contents buf, Some Literals.escaped_j_delimiter))} - else if Ext_string.equal delim Literals.unescaped_j_delimiter then - Location.raise_errorf ~loc "{j||j} is reserved for future use" + else if Ext_string.equal delim Literals.unescaped_j_delimiter then + let starting_loc = {loc with loc_end = loc.loc_start} in + let empty_string_concat_exp = {e with pexp_desc = Pexp_constant (Const_string ("", None)); pexp_loc = starting_loc} in + let exps_list = Ast_utf8_string.transform_es6_style_template_string s starting_loc in + Ast_utf8_string.fold_expression_list_with_string_concat empty_string_concat_exp exps_list else e (** [bs.debugger], its output should not be rewritten any more*) @@ -728,4 +731,3 @@ let rewrite_implementation : (Parsetree.structure -> Parsetree.structure) ref = | _ -> unsafe_mapper.structure unsafe_mapper x in reset (); result ) - diff --git a/jscomp/test/es6_style_string.js b/jscomp/test/es6_style_string.js new file mode 100644 index 0000000000..4e720316d8 --- /dev/null +++ b/jscomp/test/es6_style_string.js @@ -0,0 +1,37 @@ +// Generated by BUCKLESCRIPT VERSION 1.6.1, PLEASE EDIT WITH CARE +'use strict'; + + +var str = "你的名字"; + +var x_1 = "world"; + +var x_2 = " Bucklescript by 彭博 "; + +var es6 = "" + "hello " + String(x_1) + ",欢迎来到 " + String(x_2); + +var es62 = "" + String(str) + ", 君の名は"; + +var a = "" + " blabla $(xx) "; + +var b = "" + " blabla $xxx "; + +var c = "" + " $ "; + +var empty2 = "" + " $ "; + +var escape0 = "" + "\" + String(str); + +console.log(str); + +exports.str = str; +exports.x_1 = x_1; +exports.x_2 = x_2; +exports.es6 = es6; +exports.es62 = es62; +exports.a = a; +exports.b = b; +exports.c = c; +exports.empty2 = empty2; +exports.escape0 = escape0; +/* es6 Not a pure module */ diff --git a/jscomp/test/es6_style_string.ml b/jscomp/test/es6_style_string.ml new file mode 100644 index 0000000000..6235c613cc --- /dev/null +++ b/jscomp/test/es6_style_string.ml @@ -0,0 +1,23 @@ + +let str = {js|你的名字|js};; + +let x_1 = "world";; + +let x_2 = {js| Bucklescript by 彭博 |js};; + +let es6 = {j|hello $x_1,欢迎来到 $(x_2)|j};; + +let es62 = {j|$str, 君の名は|j} + +let a = {j| blabla \$(xx) |j} (* should not be interpolated*) +let b = {j| blabla \$xxx |j} (* should not be interpolated *) +let c = {j| \$ |j} + +let empty2 = {j| \$ |j} + +let escape0 = {j|\\$str|j} + +(*this will trigger an error since we dont allow empty parameter in string template*) +(*let empty3 = {j| $ |j}*) + +let () = Js.log str;; diff --git a/lib/es6/js_global.js b/lib/es6/js_global.js new file mode 100644 index 0000000000..18eb841001 --- /dev/null +++ b/lib/es6/js_global.js @@ -0,0 +1,8 @@ +'use strict'; + + + +export { + +} +/* No side effect */ diff --git a/ocaml b/ocaml index 40a9741f70..ed439359b1 160000 --- a/ocaml +++ b/ocaml @@ -1 +1 @@ -Subproject commit 40a9741f7026afa9586a872940e8fc88a9fd671d +Subproject commit ed439359b1cdf9f743bd1d7d1cf483fd98692e25 diff --git a/site/docsource/Release.1.5.2.adoc b/site/docsource/Release.1.5.2.adoc index 555ce40653..ba7bbd0ba4 100644 --- a/site/docsource/Release.1.5.2.adoc +++ b/site/docsource/Release.1.5.2.adoc @@ -1,5 +1,3 @@ - - # Features 1. FFI: Unicode literal support http://bloomberg.github.io/bucklescript/Manual.html#_unicode_support_since_1_5_1 @@ -8,11 +6,3 @@ 3. FFI: Detect global variable existence http://bloomberg.github.io/bucklescript/Manual.html#_detect_global_varialbe_existence_code_bs_external_code_since_1_5_1 - -# Minor breaking changes - -1. changes NodeJS special variables from `module_` to `_module` to make it more consistent - -2. [%node ] return [_ option] type instead of `undefined` - -