diff --git a/CHANGES.md b/CHANGES.md index 14cb3de2e5..94ed0ee401 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -11,6 +11,7 @@ * Compiler: Cache function arity (the length prop of a function is slow with v8) * Compiler: The js lexer is now utf8 aware, recognize and emit utf8 ident * Compiler: Update the js lexer with new number literal syntax +* Compiler: update js parser to support most es6 feature (#1391) ## Bug fixes - Effects: fix Js.export and Js.export_all to work with functions diff --git a/compiler/bin-jsoo_minify/jsoo_minify.ml b/compiler/bin-jsoo_minify/jsoo_minify.ml index 1c7277854c..80fcc9f74d 100644 --- a/compiler/bin-jsoo_minify/jsoo_minify.ml +++ b/compiler/bin-jsoo_minify/jsoo_minify.ml @@ -70,10 +70,13 @@ let f { Cmd_arg.common; output_file; use_stdin; files } = let free = new Js_traverse.free in let (_ : Javascript.program) = free#program p in let toplevel_def_and_use = - Utf8_string_set.union free#get_def_name free#get_use_name + let state = free#state in + Javascript.IdentSet.union state.def_var state.use in - Utf8_string_set.iter - (fun (Utf8_string.Utf8 x) -> Var_printer.add_reserved x) + Javascript.IdentSet.iter + (function + | V _ -> () + | S { name = Utf8_string.Utf8 x; _ } -> Var_printer.add_reserved x) toplevel_def_and_use; let true_ () = true in let open Config in diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml index 8b8bf8e9f4..bc78dff46f 100644 --- a/compiler/lib/driver.ml +++ b/compiler/lib/driver.ml @@ -208,33 +208,30 @@ let gen_missing js missing = let prim = Utf8_string.of_string_exn prim in let p = ident prim in ( p - , Some - ( ECond - ( EBin - ( NotEqEq - , EDot (EVar (ident Constant.global_object_), prim) - , EVar (ident_s "undefined") ) - , EDot (EVar (ident Constant.global_object_), prim) - , EFun - ( None - , [] - , [ ( Statement - (Expression_statement - (ECall - ( EVar (ident_s "caml_failwith") - , [ ( EBin - ( Plus - , EStr prim - , EStr - (Utf8_string.of_string_exn - " not implemented") ) - , `Not_spread ) - ] - , N ))) + , ( ECond + ( EBin + ( NotEqEq + , dot (EVar (ident Constant.global_object_)) prim + , EVar (ident_s "undefined") ) + , dot (EVar (ident Constant.global_object_)) prim + , EFun + ( None + , fun_ + [] + [ ( Expression_statement + (call + (EVar (ident_s "caml_failwith")) + [ EBin + ( Plus + , EStr prim + , EStr (Utf8_string.of_string_exn " not implemented") + ) + ] + N) , N ) ] - , N ) ) - , N ) ) + N ) ) + , N ) ) :: acc) missing [] @@ -247,11 +244,11 @@ let gen_missing js missing = warn "You can prevent the generation of dummy implementations with "; warn "the commandline option '--disable genprim'@."; report_missing_primitives missing); - (Statement (Variable_statement miss), N) :: js + (variable_declaration miss, N) :: js let mark_start_of_generated_code = Debug.find ~even_if_quiet:true "mark-runtime-gen" -let link ~standalone ~linkall (js : Javascript.source_elements) : Linker.output = +let link ~standalone ~linkall (js : Javascript.statement_list) : Linker.output = if not standalone then { runtime_code = js; always_required_codes = [] } else @@ -263,18 +260,22 @@ let link ~standalone ~linkall (js : Javascript.source_elements) : Linker.output if mark_start_of_generated_code () then let open Javascript in - ( Statement - (Expression_statement - (EStr - (Utf8_string.of_string_exn - ("--MARK--" ^ "start-of-jsoo-gen" ^ "--MARK--")))) + ( Expression_statement + (EStr + (Utf8_string.of_string_exn ("--MARK--" ^ "start-of-jsoo-gen" ^ "--MARK--"))) , N ) :: js else js in - let free = traverse#get_free_name in + let free = traverse#get_free in let free : StringSet.t = - Utf8_string_set.fold (fun (Utf8 x) acc -> StringSet.add x acc) free StringSet.empty + Javascript.IdentSet.fold + (fun x acc -> + match x with + | V _ -> assert false + | S { name = Utf8 x; _ } -> StringSet.add x acc) + free + StringSet.empty in let prim = Primitive.get_external () in let prov = Linker.get_provided () in @@ -302,16 +303,15 @@ let link ~standalone ~linkall (js : Javascript.source_elements) : Linker.output let all = List.map all ~f:(fun name -> let name = Utf8_string.of_string_exn name in - PNI name, EVar (ident name)) + Property (PNI name, EVar (ident name))) in - ( Statement - (Expression_statement - (EBin - ( Eq - , EDot - ( EVar (ident Constant.global_object_) - , Utf8_string.of_string_exn "jsoo_runtime" ) - , EObj all ))) + ( Expression_statement + (EBin + ( Eq + , dot + (EVar (ident Constant.global_object_)) + (Utf8_string.of_string_exn "jsoo_runtime") + , EObj all )) , N ) :: js else js @@ -323,9 +323,15 @@ let check_js js = if times () then Format.eprintf "Start Checks...@."; let traverse = new Js_traverse.free in let js = traverse#program js in - let free = traverse#get_free_name in + let free = traverse#get_free in let free : StringSet.t = - Utf8_string_set.fold (fun (Utf8 x) acc -> StringSet.add x acc) free StringSet.empty + Javascript.IdentSet.fold + (fun x acc -> + match x with + | V _ -> assert false + | S { name = Utf8 x; _ } -> StringSet.add x acc) + free + StringSet.empty in let prim = Primitive.get_external () in let prov = Linker.get_provided () in @@ -354,8 +360,13 @@ let coloring js = if times () then Format.eprintf "Start Coloring...@."; let traverse = new Js_traverse.free in let js = traverse#program js in - let free = traverse#get_free_name in - Utf8_string_set.iter (fun (Utf8 x) -> Var_printer.add_reserved x) free; + let free = traverse#get_free in + Javascript.IdentSet.iter + (fun x -> + match x with + | V _ -> assert false + | S { name = Utf8 x; _ } -> Var_printer.add_reserved x) + free; let js = Js_assign.program js in if times () then Format.eprintf " coloring: %a@." Timer.print t; js @@ -393,17 +404,15 @@ let pack ~wrap_with_fun ~standalone { Linker.runtime_code = js; always_required_ in (* pack *) let wrap_in_iife ~use_strict js = - let var ident e = - J.Statement (J.Variable_statement [ J.ident ident, Some (e, J.N) ]), J.N - in - let expr e = J.Statement (J.Expression_statement e), J.N in + let var ident e = J.variable_declaration [ J.ident ident, (e, J.N) ], J.N in + let expr e = J.Expression_statement e, J.N in let freenames = let o = new Js_traverse.free in let (_ : J.program) = o#program js in - o#get_free_name + o#get_free in let export_shim js = - if Utf8_string_set.mem Constant.exports_ freenames + if J.IdentSet.mem (J.ident Constant.exports_) freenames then if should_export wrap_with_fun then var Constant.exports_ (J.EObj []) :: js @@ -421,14 +430,14 @@ let pack ~wrap_with_fun ~standalone { Linker.runtime_code = js; always_required_ else js in let old_global_object_shim js = - if Utf8_string_set.mem Constant.old_global_object_ freenames + if J.IdentSet.mem (J.ident Constant.old_global_object_) freenames then var Constant.old_global_object_ (J.EVar (J.ident Constant.global_object_)) :: js else js in - let efun args body = J.EFun (None, args, body, J.U) in - let sfun name args body = J.Function_declaration (name, args, body, J.U), J.U in + let efun args body = J.EFun (None, J.fun_ args body J.U) in + let sfun name args body = J.Function_declaration (name, J.fun_ args body J.U), J.U in let mk f = let js = export_shim js in let js = old_global_object_shim js in @@ -444,10 +453,7 @@ let pack ~wrap_with_fun ~standalone { Linker.runtime_code = js; always_required_ | `Named name -> let name = Utf8_string.of_string_exn name in mk (sfun (J.ident name)) - | `Iife -> - expr - (J.ECall - (mk efun, [ J.EVar (J.ident Constant.global_object_), `Not_spread ], J.N)) + | `Iife -> expr (J.call (mk efun) [ J.EVar (J.ident Constant.global_object_) ] J.N) in let always_required_js = (* consider adding a comments in the generated file with original diff --git a/compiler/lib/dune b/compiler/lib/dune index 85dd21bbf8..f4a93837e7 100644 --- a/compiler/lib/dune +++ b/compiler/lib/dune @@ -33,29 +33,7 @@ --unused-token T_ERROR --unused-token - T_AT - --unused-token - T_POUND - --unused-token - T_PLING_PERIOD - --unused-token - T_PLING_PLING - --unused-token - T_OR_ASSIGN - --unused-token - T_AND_ASSIGN - --unused-token - T_NULLISH_ASSIGN - --unused-token - T_EXP - --unused-token - T_EXP_ASSIGN - --unused-token - T_ARROW - --unused-token - T_BIGINT - --unused-token - T_TEMPLATE_PART)) + T_AT)) (menhir (modules annot_parser) diff --git a/compiler/lib/flow_lexer.ml b/compiler/lib/flow_lexer.ml index aad35ec611..cd3257bab0 100644 --- a/compiler/lib/flow_lexer.ml +++ b/compiler/lib/flow_lexer.ml @@ -7,20 +7,20 @@ open Js_token +module Lex_mode = struct + type t = + | NORMAL + | BACKQUOTE + | REGEXP +end + module Loc = struct (* line numbers are 1-indexed; column numbers are 0-indexed *) - type position = - { line : int - ; column : int - } - (* start is inclusive; end is exclusive *) - (* If you are modifying this record, go look at ALoc.ml and make sure you understand the - * representation there. *) type t = { source : string option - ; start : position - ; _end : position + ; start : Lexing.position + ; _end : Lexing.position } [@@ocaml.warning "-69"] end @@ -42,28 +42,18 @@ module Parse_error = struct end module Lex_env = struct - (* bol = Beginning Of Line *) - type bol = - { line : int - ; offset : int - } - type lex_state = { lex_errors_acc : (Loc.t * Parse_error.t) list } [@@ocaml.unboxed] type t = { lex_source : string option ; lex_lb : Sedlexing.lexbuf - ; lex_bol : bol ; lex_state : lex_state + ; lex_mode_stack : Lex_mode.t list } [@@ocaml.warning "-69"] - let line env = env.lex_bol.line - let source env = env.lex_source - let bol_offset env = env.lex_bol.offset - let empty_lex_state = { lex_errors_acc = [] } let create lex_lb = @@ -75,11 +65,22 @@ module Lex_env = struct in { lex_source ; lex_lb - ; lex_bol = { line = 1; offset = 0 } ; lex_state = empty_lex_state + ; lex_mode_stack = [ Lex_mode.NORMAL ] } end +let push_mode env mode = + { env with Lex_env.lex_mode_stack = mode :: env.Lex_env.lex_mode_stack } + +let pop_mode env = + { env with + Lex_env.lex_mode_stack = + (match env.Lex_env.lex_mode_stack with + | [] -> [] + | _ :: xs -> xs) + } + module Lex_result = struct type t = { lex_token : Js_token.t @@ -199,13 +200,13 @@ let codepoint_escape = [%sedlex.regexp? "\\u{", Plus hex_digit, '}'] let js_id_start = [%sedlex.regexp? '$' | '_' | id_start] -let js_id_continue = [%sedlex.regexp? '$' | '_' | id_continue] +let js_id_continue = [%sedlex.regexp? '$' | '_' | id_continue | 0x200C | 0x200D] let js_id_start_with_escape = - [%sedlex.regexp? '$' | '_' | id_start | unicode_escape | codepoint_escape] + [%sedlex.regexp? js_id_start | unicode_escape | codepoint_escape] let js_id_continue_with_escape = - [%sedlex.regexp? '$' | '_' | id_continue | unicode_escape | codepoint_escape] + [%sedlex.regexp? js_id_continue | unicode_escape | codepoint_escape] exception Not_an_ident @@ -238,19 +239,9 @@ let is_valid_identifier_name s = | js_id_start, Star js_id_continue, eof -> true | _ -> false -let pos_at_offset env offset = - { Loc.line = Lex_env.line env; column = offset - Lex_env.bol_offset env } - -let loc_of_offsets env start_offset end_offset = - { Loc.source = Lex_env.source env - ; start = pos_at_offset env start_offset - ; _end = pos_at_offset env end_offset - } - let loc_of_lexbuf env (lexbuf : Sedlexing.lexbuf) = - let start_offset = Sedlexing.lexeme_start lexbuf in - let end_offset = Sedlexing.lexeme_end lexbuf in - loc_of_offsets env start_offset end_offset + let start_offset, stop_offset = Sedlexing.lexing_positions lexbuf in + { Loc.source = Lex_env.source env; start = start_offset; _end = stop_offset } let lex_error (env : Lex_env.t) loc err : Lex_env.t = let lex_errors_acc = (loc, err) :: env.lex_state.lex_errors_acc in @@ -259,11 +250,6 @@ let lex_error (env : Lex_env.t) loc err : Lex_env.t = let illegal (env : Lex_env.t) (loc : Loc.t) = lex_error env loc (Parse_error.Unexpected "token ILLEGAL") -let new_line env lexbuf = - let offset = Sedlexing.lexeme_end lexbuf in - let lex_bol = { Lex_env.line = Lex_env.line env + 1; offset } in - { env with Lex_env.lex_bol } - let decode_identifier = let sub_lexeme lexbuf trim_start trim_end = Sedlexing.Utf8.sub_lexeme @@ -364,7 +350,6 @@ type result = let rec comment env buf lexbuf = match%sedlex lexbuf with | line_terminator_sequence -> - let env = new_line env lexbuf in lexeme_to_buffer lexbuf buf; comment env buf lexbuf | "*/" -> @@ -442,7 +427,6 @@ let string_escape env lexbuf = env, str | line_terminator_sequence -> let str = lexeme lexbuf in - let env = new_line env lexbuf in env, str | any -> let str = lexeme lexbuf in @@ -460,19 +444,17 @@ let rec string_quote env q buf lexbuf = else ( Buffer.add_string buf q'; string_quote env q buf lexbuf) - | '\\', line_terminator_sequence -> - let env = new_line env lexbuf in - string_quote env q buf lexbuf + | '\\', line_terminator_sequence -> string_quote env q buf lexbuf | '\\' -> let env, str = string_escape env lexbuf in - if String.get q 0 <> String.get str 0 then Buffer.add_string buf "\\"; + if String.equal str "" || String.get q 0 <> String.get str 0 + then Buffer.add_string buf "\\"; Buffer.add_string buf str; string_quote env q buf lexbuf | '\n' -> let x = lexeme lexbuf in Buffer.add_string buf x; let env = illegal env (loc_of_lexbuf env lexbuf) in - let env = new_line env lexbuf in string_quote env q buf lexbuf (* env, end_pos_of_lexbuf env lexbuf *) | eof -> @@ -486,54 +468,9 @@ let rec string_quote env q buf lexbuf = string_quote env q buf lexbuf | _ -> failwith "unreachable string_quote" -let rec template_part env cooked raw literal lexbuf = - match%sedlex lexbuf with - | eof -> - let env = illegal env (loc_of_lexbuf env lexbuf) in - env, true - | '`' -> - Buffer.add_char literal '`'; - env, true - | "${" -> - Buffer.add_string literal "${"; - env, false - | '\\' -> - Buffer.add_char raw '\\'; - Buffer.add_char literal '\\'; - let env, str = string_escape env lexbuf in - Buffer.add_string raw str; - Buffer.add_string literal str; - template_part env cooked raw literal lexbuf - (* ECMAScript 6th Syntax, 11.8.6.1 Static Semantics: TV's and TRV's - * Long story short, is 0xA, is 0xA, and is 0xA - * *) - | "\r\n" -> - Buffer.add_string raw "\r\n"; - Buffer.add_string literal "\r\n"; - Buffer.add_string cooked "\n"; - let env = new_line env lexbuf in - template_part env cooked raw literal lexbuf - | "\n" | "\r" -> - let lf = lexeme lexbuf in - Buffer.add_string raw lf; - Buffer.add_string literal lf; - Buffer.add_char cooked '\n'; - let env = new_line env lexbuf in - template_part env cooked raw literal lexbuf - (* match multi-char substrings that don't contain the start chars of the above patterns *) - | Plus (Compl (eof | '`' | '$' | '\\' | '\r' | '\n')) | any -> - let c = lexeme lexbuf in - Buffer.add_string raw c; - Buffer.add_string literal c; - Buffer.add_string cooked c; - template_part env cooked raw literal lexbuf - | _ -> failwith "unreachable template_part" - let token (env : Lex_env.t) lexbuf : result = match%sedlex lexbuf with - | line_terminator_sequence -> - let env = new_line env lexbuf in - Continue env + | line_terminator_sequence -> Continue env | Plus whitespace -> Continue env | "/*" -> let buf = Buffer.create 127 in @@ -565,15 +502,8 @@ let token (env : Lex_env.t) lexbuf : result = , T_STRING (Stdlib.Utf8_string.of_string_exn (Buffer.contents buf), p2 - p1 - 1) ) | '`' -> - let cooked = Buffer.create 127 in - let raw = Buffer.create 127 in - let literal = Buffer.create 127 in - lexeme_to_buffer lexbuf literal; - let env, is_tail = template_part env cooked raw literal lexbuf in - Token - ( env - , T_TEMPLATE_PART (Stdlib.Utf8_string.of_string_exn (Buffer.contents raw), is_tail) - ) + let env = push_mode env BACKQUOTE in + Token (env, T_BACKQUOTE) | binbigint, word -> (* Numbers cannot be immediately followed by words *) recover env lexbuf ~f:(fun env lexbuf -> @@ -678,8 +608,12 @@ let token (env : Lex_env.t) lexbuf : result = | _ -> failwith "unreachable token wholenumber") | wholenumber | floatnumber -> Token (env, T_NUMBER (NORMAL, lexeme lexbuf)) (* Syntax *) - | "{" -> Token (env, T_LCURLY) - | "}" -> Token (env, T_RCURLY) + | "{" -> + let env = push_mode env NORMAL in + Token (env, T_LCURLY) + | "}" -> + let env = pop_mode env in + Token (env, T_RCURLY) | "(" -> Token (env, T_LPAREN) | ")" -> Token (env, T_RPAREN) | "[" -> Token (env, T_LBRACKET) @@ -789,7 +723,6 @@ let rec regexp_class env buf lexbuf = | line_terminator_sequence -> let loc = loc_of_lexbuf env lexbuf in let env = lex_error env loc Parse_error.UnterminatedRegExp in - let env = new_line env lexbuf in env (* match multi-char substrings that don't contain the start chars of the above patterns *) | Plus (Compl (eof | '\\' | ']' | line_terminator_sequence_start)) | any -> @@ -807,7 +740,6 @@ let rec regexp_body env buf lexbuf = | '\\', line_terminator_sequence -> let loc = loc_of_lexbuf env lexbuf in let env = lex_error env loc Parse_error.UnterminatedRegExp in - let env = new_line env lexbuf in env, "" | '\\', any -> let s = lexeme lexbuf in @@ -827,7 +759,6 @@ let rec regexp_body env buf lexbuf = | line_terminator_sequence -> let loc = loc_of_lexbuf env lexbuf in let env = lex_error env loc Parse_error.UnterminatedRegExp in - let env = new_line env lexbuf in env, "" (* match multi-char substrings that don't contain the start chars of the above patterns *) | Plus (Compl (eof | '\\' | '/' | '[' | line_terminator_sequence_start)) | any -> @@ -839,9 +770,7 @@ let rec regexp_body env buf lexbuf = let regexp env lexbuf = match%sedlex lexbuf with | eof -> Token (env, T_EOF) - | line_terminator_sequence -> - let env = new_line env lexbuf in - Continue env + | line_terminator_sequence -> Continue env | Plus whitespace -> Continue env | "//" -> let buf = Buffer.create 127 in @@ -862,6 +791,31 @@ let regexp env lexbuf = Token (env, T_ERROR (lexeme lexbuf)) | _ -> failwith "unreachable regexp" +(*****************************************************************************) +(* Rule backquote *) +(*****************************************************************************) + +let backquote env lexbuf = + match%sedlex lexbuf with + | '`' -> + let env = pop_mode env in + Token (env, T_BACKQUOTE) + | "${" -> + let env = push_mode env NORMAL in + Token (env, T_DOLLARCURLY) + | Plus (Compl ('`' | '$' | '\\')) -> Token (env, T_ENCAPSED_STRING (lexeme lexbuf)) + | '$' -> Token (env, T_ENCAPSED_STRING (lexeme lexbuf)) + | '\\' -> + let buf = Buffer.create 127 in + Buffer.add_char buf '\\'; + let env, str = string_escape env lexbuf in + Buffer.add_string buf str; + Token (env, T_ENCAPSED_STRING (Buffer.contents buf)) + | eof -> Token (env, T_EOF) + | _ -> + let env = illegal env (loc_of_lexbuf env lexbuf) in + Token (env, T_ERROR (lexeme lexbuf)) + let wrap f = let f env = let start, _ = Sedlexing.lexing_positions env.Lex_env.lex_lb in @@ -894,3 +848,11 @@ let wrap f = let regexp = wrap regexp let token = wrap token + +let backquote = wrap backquote + +let lex env = + match env.Lex_env.lex_mode_stack with + | Lex_mode.NORMAL :: _ | [] -> token env + | Lex_mode.BACKQUOTE :: _ -> backquote env + | Lex_mode.REGEXP :: _ -> regexp env diff --git a/compiler/lib/flow_lexer.mli b/compiler/lib/flow_lexer.mli index 223fa804e3..0c1d278aeb 100644 --- a/compiler/lib/flow_lexer.mli +++ b/compiler/lib/flow_lexer.mli @@ -5,6 +5,13 @@ * LICENSE file in the root directory of this source tree. *) +module Lex_mode : sig + type t = + | NORMAL + | BACKQUOTE + | REGEXP +end + module Parse_error : sig type t @@ -12,15 +19,10 @@ module Parse_error : sig end module Loc : sig - type position = - { line : int - ; column : int - } - type t = { source : string option - ; start : position - ; _end : position + ; start : Lexing.position + ; _end : Lexing.position } end @@ -46,4 +48,6 @@ val regexp : Lex_env.t -> Lex_env.t * Lex_result.t val token : Lex_env.t -> Lex_env.t * Lex_result.t +val lex : Lex_env.t -> Lex_env.t * Lex_result.t + val is_valid_identifier_name : string -> bool diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml index a75f6170bd..12d9cf0bde 100644 --- a/compiler/lib/generate.ml +++ b/compiler/lib/generate.ml @@ -375,7 +375,7 @@ let runtime_fun ctx name = | Some (runtime, runtime_needed) -> runtime_needed := true; let name = Utf8_string.of_string_exn name in - J.EDot (J.EVar (J.V runtime), name) + J.dot (J.EVar (J.V runtime)) name | None -> s_var name let str_js_byte s = @@ -397,8 +397,6 @@ let str_js_utf8 s = let s = Buffer.contents b in J.EStr (Utf8_string.of_string_exn s) -let ecall f args loc = J.ECall (f, List.map args ~f:(fun x -> x, `Not_spread), loc) - (****) (* @@ -434,7 +432,7 @@ let ocaml_string ~ctx ~loc s = then s else let p = Share.get_prim (runtime_fun ctx) "caml_string_of_jsbytes" ctx.Ctx.share in - ecall p [ s ] loc + J.call p [ s ] loc let rec constant_rec ~ctx x level instrs = match x with @@ -463,7 +461,7 @@ let rec constant_rec ~ctx x level instrs = let lo = int (Int64.to_int i land 0xffffff) and mi = int (Int64.to_int (Int64.shift_right i 24) land 0xffffff) and hi = int (Int64.to_int (Int64.shift_right i 48) land 0xffff) in - ecall p [ lo; mi; hi ] J.N, instrs + J.call p [ lo; mi; hi ] J.N, instrs | Tuple (tag, a, _) -> ( let constant_max_depth = Config.Param.constant_max_depth () in let rec detect_list n acc = function @@ -473,15 +471,15 @@ let rec constant_rec ~ctx x level instrs = in match detect_list 0 [] x with | Some elts_rev -> - let arr, instrs = + let elements, instrs = List.fold_left elts_rev ~init:([], instrs) ~f:(fun (arr, instrs) elt -> let js, instrs = constant_rec ~ctx elt level instrs in - Some js :: arr, instrs) + js :: arr, instrs) in let p = Share.get_prim (runtime_fun ctx) "caml_list_of_js_array" ctx.Ctx.share in - ecall p [ J.EArr arr ] J.N, instrs + J.call p [ J.array elements ] J.N, instrs | None -> let split = level = constant_max_depth in let level = if split then 0 else level + 1 in @@ -498,7 +496,7 @@ let rec constant_rec ~ctx x level instrs = | J.EArr _ -> let v = Code.Var.fresh_n "partial" in let instrs = - (J.Variable_statement [ J.V v, Some (js, J.N) ], J.N) :: instrs + (J.variable_declaration [ J.V v, (js, J.N) ], J.N) :: instrs in J.EVar (J.V v) :: acc, instrs | _ -> js :: acc, instrs) @@ -550,7 +548,7 @@ let access_queue_may_flush queue v x = if not (Code.Var.Set.disjoint deps elt.deps) then ( Code.Var.Set.add y deps - , (J.Variable_statement [ J.V y, Some (elt.ce, elt.loc) ], elt.loc) :: instrs + , (J.variable_declaration [ J.V y, (elt.ce, elt.loc) ], elt.loc) :: instrs , queue ) else deps, instrs, eq :: queue) in @@ -566,7 +564,7 @@ let flush_queue expr_queue prop (l : J.statement_list) = in let instrs = List.map instrs ~f:(fun (x, elt) -> - J.Variable_statement [ J.V x, Some (elt.ce, elt.loc) ], elt.loc) + J.variable_declaration [ J.V x, (elt.ce, elt.loc) ], elt.loc) in List.rev_append instrs l, expr_queue @@ -959,7 +957,7 @@ let parallel_renaming params args continuation queue = flush_queue queue px - (instrs @ [ J.Variable_statement [ J.V y, Some (cx, J.N) ], J.N ]) + (instrs @ [ J.variable_declaration [ J.V y, (cx, J.N) ], J.N ]) in let never, code = continuation queue in never, st @ code) @@ -970,7 +968,7 @@ let parallel_renaming params args continuation queue = let apply_fun_raw ctx f params exact cps = let n = List.length params in - let apply_directly = ecall f params J.N in + let apply_directly = J.call f params J.N in let apply = (* We skip the arity check when we know that we have the right number of parameters, since this test is expensive. *) @@ -982,17 +980,13 @@ let apply_fun_raw ctx f params exact cps = ( J.EBin ( J.EqEq , J.ECond - ( J.EBin (J.Ge, J.EDot (f, l), int 0) - , J.EDot (f, l) - , J.EBin - (J.Eq, J.EDot (f, l), J.EDot (f, Utf8_string.of_string_exn "length")) + ( J.EBin (J.Ge, J.dot f l, int 0) + , J.dot f l + , J.EBin (J.Eq, J.dot f l, J.dot f (Utf8_string.of_string_exn "length")) ) , int n ) , apply_directly - , ecall - (runtime_fun ctx "caml_call_gen") - [ f; J.EArr (List.map params ~f:(fun x -> Some x)) ] - J.N ) + , J.call (runtime_fun ctx "caml_call_gen") [ f; J.array params ] J.N ) in if cps then ( @@ -1002,12 +996,9 @@ let apply_fun_raw ctx f params exact cps = bounce to a trampoline if needed, to avoid a stack overflow. The trampoline then performs the call in an shorter stack. *) J.ECond - ( ecall (runtime_fun ctx "caml_stack_check_depth") [] J.N + ( J.call (runtime_fun ctx "caml_stack_check_depth") [] J.N , apply - , ecall - (runtime_fun ctx "caml_trampoline_return") - [ f; J.EArr (List.map params ~f:(fun x -> Some x)) ] - J.N )) + , J.call (runtime_fun ctx "caml_trampoline_return") [ f; J.array params ] J.N )) else apply let generate_apply_fun ctx { arity; exact; cps } = @@ -1023,11 +1014,10 @@ let generate_apply_fun ctx { arity; exact; cps } = let params' = List.map params ~f:(fun x -> J.EVar x) in J.EFun ( None - , f :: params - , [ ( J.Statement (J.Return_statement (Some (apply_fun_raw ctx f' params' exact cps))) - , J.N ) - ] - , J.N ) + , J.fun_ + (f :: params) + [ J.Return_statement (Some (apply_fun_raw ctx f' params' exact cps)), J.N ] + J.N ) let apply_fun ctx f params exact cps loc = (* We always go through an intermediate function when doing CPS @@ -1045,7 +1035,7 @@ let apply_fun ctx f params exact cps loc = { arity = List.length params; exact; cps } ctx.Ctx.share in - ecall y (f :: params) loc + J.call y (f :: params) loc (****) @@ -1097,12 +1087,12 @@ let register_tern_prim name f = let register_un_math_prim name prim = let prim = Utf8_string.of_string_exn prim in register_un_prim name `Pure (fun cx loc -> - ecall (J.EDot (s_var "Math", prim)) [ cx ] loc) + J.call (J.dot (s_var "Math") prim) [ cx ] loc) let register_bin_math_prim name prim = let prim = Utf8_string.of_string_exn prim in register_bin_prim name `Pure (fun cx cy loc -> - ecall (J.EDot (s_var "Math", prim)) [ cx; cy ] loc) + J.call (J.dot (s_var "Math") prim) [ cx; cy ] loc) let _ = register_un_prim_ctx "%caml_format_int_special" `Pure (fun ctx cx loc -> @@ -1140,9 +1130,9 @@ let _ = register_bin_prim "caml_fmod_float" `Pure (fun cx cy _ -> J.EBin (J.Mod, cx, cy)); register_tern_prim "caml_array_unsafe_set" (fun cx cy cz _ -> J.EBin (J.Eq, Mlvalue.Array.field cx cy, cz)); - register_un_prim "caml_alloc_dummy" `Pure (fun _ _ -> J.EArr []); + register_un_prim "caml_alloc_dummy" `Pure (fun _ _ -> J.array []); register_un_prim "caml_obj_dup" `Mutable (fun cx loc -> - J.ECall (J.EDot (cx, Utf8_string.of_string_exn "slice"), [], loc)); + J.call (J.dot cx (Utf8_string.of_string_exn "slice")) [] loc); register_un_prim "caml_int_of_float" `Pure (fun cx _loc -> to_int cx); register_un_math_prim "caml_abs_float" "abs"; register_un_math_prim "caml_acos_float" "acos"; @@ -1163,12 +1153,12 @@ let _ = register_un_prim "caml_js_to_bool" `Pure (fun cx _ -> to_int cx); register_tern_prim "caml_js_set" (fun cx cy cz _ -> - J.EBin (J.Eq, J.EAccess (cx, cy), cz)); + J.EBin (J.Eq, J.EAccess (cx, ANormal, cy), cz)); (* [caml_js_get] can have side effect, we declare it as mutator. see https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Functions/get *) - register_bin_prim "caml_js_get" `Mutator (fun cx cy _ -> J.EAccess (cx, cy)); + register_bin_prim "caml_js_get" `Mutator (fun cx cy _ -> J.EAccess (cx, ANormal, cy)); register_bin_prim "caml_js_delete" `Mutator (fun cx cy _ -> - J.EUn (J.Delete, J.EAccess (cx, cy))); + J.EUn (J.Delete, J.EAccess (cx, ANormal, cy))); register_bin_prim "caml_js_equals" `Mutable (fun cx cy _ -> bool (J.EBin (J.EqEq, cx, cy))); register_bin_prim "caml_js_instanceof" `Mutator (fun cx cy _ -> @@ -1199,7 +1189,7 @@ let throw_statement ctx cx k loc = | `Notrace -> [ J.Throw_statement cx, loc ] | `Normal -> [ ( J.Throw_statement - (ecall + (J.call (runtime_fun ctx "caml_exn_with_js_backtrace") [ cx; bool (int 1) ] loc) @@ -1207,7 +1197,7 @@ let throw_statement ctx cx k loc = ] | `Reraise -> [ ( J.Throw_statement - (ecall + (J.call (runtime_fun ctx "caml_exn_with_js_backtrace") [ cx; bool (int 0) ] loc) @@ -1256,7 +1246,7 @@ let rec translate_expr ctx queue loc in_tail_position e level : _ * J.statement_ | (st, J.N) :: rem -> (st, J.U) :: rem | _ -> clo in - let clo = J.EFun (None, List.map args ~f:(fun v -> J.V v), clo, loc) in + let clo = J.EFun (None, J.fun_ (List.map args ~f:(fun v -> J.V v)) clo loc) in (clo, flush_p, queue), [] | Constant c -> let js, instrs = constant ~ctx c level in @@ -1318,7 +1308,7 @@ let rec translate_expr ctx queue loc in_tail_position e level : _ * J.statement_ l ~init:([], const_p, queue) in - J.EArr (List.map args ~f:(fun x -> Some x)), prop, queue + J.array args, prop, queue | Extern "%closure", [ Pc (String name) ] -> let prim = Share.get_prim (runtime_fun ctx) name ctx.Ctx.share in prim, const_p, queue @@ -1334,7 +1324,7 @@ let rec translate_expr ctx queue loc in_tail_position e level : _ * J.statement_ l ~init:([], mutator_p, queue) in - ( ecall (J.EDot (cf, Utf8_string.of_string_exn "call")) (co :: args) loc + ( J.call (J.dot cf (Utf8_string.of_string_exn "call")) (co :: args) loc , or_p (or_p pf po) prop , queue ) | Extern "%caml_js_opt_fun_call", f :: l -> @@ -1347,7 +1337,7 @@ let rec translate_expr ctx queue loc in_tail_position e level : _ * J.statement_ l ~init:([], mutator_p, queue) in - ecall cf args loc, or_p pf prop, queue + J.call cf args loc, or_p pf prop, queue | Extern "%caml_js_opt_meth_call", o :: Pc (NativeString (Utf m)) :: l -> let (po, co), queue = access_queue' ~ctx queue o in let args, prop, queue = @@ -1358,7 +1348,7 @@ let rec translate_expr ctx queue loc in_tail_position e level : _ * J.statement_ l ~init:([], mutator_p, queue) in - ecall (J.EDot (co, m)) args loc, or_p po prop, queue + J.call (J.dot co m) args loc, or_p po prop, queue | Extern "%caml_js_opt_meth_call", _ -> assert false | Extern "%caml_js_opt_new", c :: l -> let (pc, cc), queue = access_queue' ~ctx queue c in @@ -1366,7 +1356,7 @@ let rec translate_expr ctx queue loc in_tail_position e level : _ * J.statement_ List.fold_right ~f:(fun x (args, prop, queue) -> let (prop', cx), queue = access_queue' ~ctx queue x in - (cx, `Not_spread) :: args, or_p prop prop', queue) + J.Arg cx :: args, or_p prop prop', queue) l ~init:([], mutator_p, queue) in @@ -1375,16 +1365,16 @@ let rec translate_expr ctx queue loc in_tail_position e level : _ * J.statement_ , queue ) | Extern "caml_js_get", [ Pv o; Pc (NativeString (Utf f)) ] when J.is_ident' f -> let (po, co), queue = access_queue queue o in - J.EDot (co, f), or_p po mutable_p, queue + J.dot co f, or_p po mutable_p, queue | Extern "caml_js_set", [ Pv o; Pc (NativeString (Utf f)); v ] when J.is_ident' f -> let (po, co), queue = access_queue queue o in let (pv, cv), queue = access_queue' ~ctx queue v in - J.EBin (J.Eq, J.EDot (co, f), cv), or_p (or_p po pv) mutator_p, queue + J.EBin (J.Eq, J.dot co f, cv), or_p (or_p po pv) mutator_p, queue | Extern "caml_js_delete", [ Pv o; Pc (NativeString (Utf f)) ] when J.is_ident' f -> let (po, co), queue = access_queue queue o in - J.EUn (J.Delete, J.EDot (co, f)), or_p po mutator_p, queue + J.EUn (J.Delete, J.dot co f), or_p po mutator_p, queue (* This is only useful for debugging: {[ @@ -1404,7 +1394,7 @@ let rec translate_expr ctx queue loc in_tail_position e level : _ * J.statement_ let (prop, cx), queue = access_queue' ~ctx queue x in let prop', r', queue = build_fields queue r in let p_name = if J.is_ident' nm then J.PNI nm else J.PNS nm in - or_p prop prop', (p_name, cx) :: r', queue + or_p prop prop', J.Property (p_name, cx) :: r', queue | _ -> assert false in let prop, fields, queue = build_fields queue fields in @@ -1419,14 +1409,13 @@ let rec translate_expr ctx queue loc in_tail_position e level : _ * J.statement_ let args = Array.to_list (Array.init i ~f:(fun _ -> J.V (Var.fresh ()))) in let f = J.V (Var.fresh ()) in let call = - ecall - (J.EDot (J.EVar f, Utf8_string.of_string_exn "fun")) + J.call + (J.dot (J.EVar f) (Utf8_string.of_string_exn "fun")) (List.map args ~f:(fun v -> J.EVar v)) loc in let e = - J.EFun - (Some f, args, [ J.Statement (J.Return_statement (Some call)), J.N ], J.N) + J.EFun (Some f, J.fun_ args [ J.Return_statement (Some call), J.N ] J.N) in e, const_p, queue | Extern "caml_alloc_dummy_function", _ -> assert false @@ -1441,7 +1430,7 @@ let rec translate_expr ctx queue loc in_tail_position e level : _ * J.statement_ let name = "jsoo_effect_not_supported" in let prim = Share.get_prim (runtime_fun ctx) name ctx.Ctx.share in let prim_kind = kind (Primitive.kind name) in - ecall prim [] loc, prim_kind, queue + J.call prim [] loc, prim_kind, queue | Extern name, l -> ( let name = Primitive.resolve name in match internal_prim name with @@ -1459,7 +1448,7 @@ let rec translate_expr ctx queue loc in_tail_position e level : _ * J.statement_ l ~init:([], prim_kind, queue) in - ecall prim args loc, prop, queue) + J.call prim args loc, prop, queue) | Not, [ x ] -> let (px, cx), queue = access_queue' ~ctx queue x in J.EBin (J.Minus, one, cx), px, queue @@ -1530,7 +1519,7 @@ and translate_instr ctx expr_queue loc instr in_tail_position = flush_queue expr_queue prop - (instrs @ [ J.Variable_statement [ J.V x, Some (ce, loc) ], loc ])) + (instrs @ [ J.variable_declaration [ J.V x, (ce, loc) ], loc ])) | Set_field (x, n, y) -> let (_px, cx), expr_queue = access_queue expr_queue x in let (_py, cy), expr_queue = access_queue expr_queue y in @@ -1779,7 +1768,7 @@ and colapse_frontier name st (new_frontier' : Addr.Set.t) interm = then Code.Switch (x, cases, [||]) else Code.Cond (x, cases.(1), cases.(0)) in - ( [ J.Variable_statement [ J.V x, Some (int default, J.N) ], J.N ] + ( [ J.variable_declaration [ J.V x, (int default, J.N) ], J.N ] , Addr.Set.singleton idx , interm , Some (a, branch) ) @@ -1841,7 +1830,7 @@ and compile_decision_tree st loop_stack backs frontier interm loc cx dtree = | (J.EVar _ | _) when DTree.nbcomp dtree <= 1 -> cx, [] | _ -> let v = J.V (Code.Var.fresh ()) in - J.EVar v, [ J.Variable_statement [ v, Some (cx, J.N) ], J.N ] + J.EVar v, [ J.variable_declaration [ v, (cx, J.N) ], J.N ] in let never, code = loop cx dtree in never, binds @ code @@ -1881,7 +1870,7 @@ and compile_conditional st queue pc last loop_stack backs frontier interm = let exn_var, handler = assert (not (List.mem x ~set:(snd e1))); let wrap_exn x = - ecall + J.call (Share.get_prim (runtime_fun st.ctx) "caml_wrap_exception" st.ctx.Ctx.share) [ J.EVar (J.V x) ] J.N @@ -1891,13 +1880,14 @@ and compile_conditional st queue pc last loop_stack backs frontier interm = | _ -> let handler_var = Code.Var.fork x in ( handler_var - , (J.Variable_statement [ J.V x, Some (wrap_exn handler_var, J.N) ], J.N) + , (J.variable_declaration [ J.V x, (wrap_exn handler_var, J.N) ], J.N) :: handler ) in + ( never_body && never_handler , flush_all queue - [ ( J.Try_statement (body, Some (J.V exn_var, handler), None) + [ ( J.Try_statement (body, Some (Some (J.param' (J.V exn_var)), handler), None) , source_location st.ctx pc ) ] ) | Poptrap cont -> @@ -2050,32 +2040,30 @@ and compile_closure ctx (pc, args) = Format.eprintf "Some blocks not compiled %s!@." (string_of_set missing); assert false); if debug () then Format.eprintf "}@]@;"; - List.map res ~f:(fun (st, loc) -> J.Statement st, loc) + res let generate_shared_value ctx = let strings = - ( J.Statement - (J.Variable_statement - ((match ctx.Ctx.exported_runtime with - | None -> [] - | Some (_, { contents = false }) -> [] - | Some (v, _) -> - [ ( J.V v - , Some - ( J.EDot - ( s_var Constant.global_object - , Utf8_string.of_string_exn "jsoo_runtime" ) - , J.N ) ) - ]) - @ List.map - (StringMap.bindings ctx.Ctx.share.Share.vars.Share.byte_strings) - ~f:(fun (s, v) -> v, Some (str_js_byte s, J.N)) - @ List.map - (StringMap.bindings ctx.Ctx.share.Share.vars.Share.utf_strings) - ~f:(fun (s, v) -> v, Some (str_js_utf8 s, J.N)) - @ List.map - (StringMap.bindings ctx.Ctx.share.Share.vars.Share.prims) - ~f:(fun (s, v) -> v, Some (runtime_fun ctx s, J.N)))) + ( J.variable_declaration + ((match ctx.Ctx.exported_runtime with + | None -> [] + | Some (_, { contents = false }) -> [] + | Some (v, _) -> + [ ( J.V v + , ( J.dot + (s_var Constant.global_object) + (Utf8_string.of_string_exn "jsoo_runtime") + , J.N ) ) + ]) + @ List.map + (StringMap.bindings ctx.Ctx.share.Share.vars.Share.byte_strings) + ~f:(fun (s, v) -> v, (str_js_byte s, J.N)) + @ List.map + (StringMap.bindings ctx.Ctx.share.Share.vars.Share.utf_strings) + ~f:(fun (s, v) -> v, (str_js_utf8 s, J.N)) + @ List.map + (StringMap.bindings ctx.Ctx.share.Share.vars.Share.prims) + ~f:(fun (s, v) -> v, (runtime_fun ctx s, J.N))) , J.U ) in if not (Config.Flag.inline_callgen ()) @@ -2085,8 +2073,7 @@ let generate_shared_value ctx = (Share.AppMap.bindings ctx.Ctx.share.Share.vars.Share.applies) ~f:(fun (desc, v) -> match generate_apply_fun ctx desc with - | J.EFun (_, param, body, nid) -> - J.Function_declaration (v, param, body, nid), J.U + | J.EFun (_, decl) -> J.Function_declaration (v, decl), J.U | _ -> assert false) in strings :: applies diff --git a/compiler/lib/javascript.ml b/compiler/lib/javascript.ml index 1607b46be2..239d4176be 100644 --- a/compiler/lib/javascript.ml +++ b/compiler/lib/javascript.ml @@ -132,6 +132,11 @@ type ident_string = ; loc : location } +type early_error = + { loc : Parse_info.t + ; reason : string option + } + type ident = | S of ident_string | V of Code.Var.t @@ -139,7 +144,12 @@ type ident = (* A.3 Expressions *) and array_litteral = element_list -and element_list = expression option list +and element_list = element list + +and element = + | ElementHole + | Element of expression + | ElementSpread of expression and binop = | Eq @@ -155,7 +165,9 @@ and binop = | BxorEq | BorEq | Or + | OrEq | And + | AndEq | Bor | Bxor | Band @@ -181,6 +193,10 @@ and binop = | Mul | Div | Mod + | Exp + | ExpEq + | Coalesce + | CoalesceEq and unop = | Not @@ -194,57 +210,95 @@ and unop = | DecrA | IncrB | DecrB + | Await + +and arguments = argument list -and spread = - [ `Spread - | `Not_spread - ] +and argument = + | Arg of expression + | ArgSpread of expression -and arguments = (expression * spread) list +and property_list = property list -and property_name_and_value_list = (property_name * expression) list +and property = + | Property of property_name * expression + | PropertySpread of expression + | PropertyMethod of property_name * method_ + | CoverInitializedName of early_error * ident * initialiser + +and method_ = + | MethodGet of function_declaration + | MethodSet of function_declaration + | Method of function_declaration and property_name = | PNI of identifier | PNS of Utf8_string.t | PNN of Num.t + | PComputed of expression and expression = | ESeq of expression * expression | ECond of expression * expression * expression + | EAssignTarget of binding_pattern | EBin of binop * expression * expression | EUn of unop * expression - | ECall of expression * arguments * location - | EAccess of expression * expression - | EDot of expression * identifier + | ECall of expression * access_kind * arguments * location + | ECallTemplate of expression * template * location + | EAccess of expression * access_kind * expression + | EDot of expression * access_kind * identifier | ENew of expression * arguments option | EVar of ident - | EFun of function_expression + | EFun of ident option * function_declaration + | EClass of ident option * class_declaration + | EArrow of function_declaration | EStr of Utf8_string.t + | ETemplate of template | EArr of array_litteral | EBool of bool | ENum of Num.t - | EObj of property_name_and_value_list + | EObj of property_list | ERegexp of string * string option + | EYield of expression option + | CoverParenthesizedExpressionAndArrowParameterList of early_error + | CoverCallExpressionAndAsyncArrowHead of early_error + +and template = template_part list + +and template_part = + | TStr of Utf8_string.t + | TExp of expression + +and access_kind = + | ANormal + | ANullish (****) (* A.4 Statements *) and statement = | Block of block - | Variable_statement of variable_declaration list + | Variable_statement of variable_declaration_kind * variable_declaration list + | Function_declaration of ident * function_declaration + | Class_declaration of ident * class_declaration | Empty_statement | Expression_statement of expression | If_statement of expression * (statement * location) * (statement * location) option | Do_while_statement of (statement * location) * expression | While_statement of expression * (statement * location) | For_statement of - (expression option, variable_declaration list) either + (expression option, variable_declaration_kind * variable_declaration list) either * expression option * expression option * (statement * location) | ForIn_statement of - (expression, variable_declaration) either * expression * (statement * location) + (expression, variable_declaration_kind * for_binding) either + * expression + * (statement * location) + | ForOf_statement of + (expression, variable_declaration_kind * for_binding) either + * expression + * (statement * location) | Continue_statement of Label.t option | Break_statement of Label.t option | Return_statement of expression option @@ -253,7 +307,7 @@ and statement = | Switch_statement of expression * case_clause list * statement_list option * case_clause list | Throw_statement of expression - | Try_statement of block * (ident * block) option * block option + | Try_statement of block * (formal_parameter option * block) option * block option | Debugger_statement and ('left, 'right) either = @@ -264,33 +318,74 @@ and block = statement_list and statement_list = (statement * location) list -and variable_declaration = ident * initialiser option +and variable_declaration = + | DeclIdent of binding_ident * initialiser option + | DeclPattern of binding_pattern * initialiser + +and variable_declaration_kind = + | Var + | Let + | Const and case_clause = expression * statement_list and initialiser = expression * location (****) +and function_declaration = + function_kind * formal_parameter_list * function_body * location + +and function_kind = + { async : bool + ; generator : bool + } -(* A.5 Functions and programs *) -and function_declaration = ident * formal_parameter_list * function_body * location +and class_declaration = + { extends : expression option + ; body : class_element list + } + +and class_element = + | CEMethod of bool * class_element_name * method_ + | CEField of bool * class_element_name * initialiser option + | CEStaticBLock of statement_list + +and class_element_name = + | PropName of property_name + | PrivName of ident + +and ('a, 'b) list_with_rest = + { list : 'a list + ; rest : 'b option + } + +and formal_parameter_list = (formal_parameter, binding) list_with_rest + +and formal_parameter = binding_element -and function_expression = ident option * formal_parameter_list * function_body * location +and for_binding = binding -and formal_parameter_list = ident list +and binding_element = binding * initialiser option -and function_body = source_elements +and binding = + | BindingIdent of binding_ident + | BindingPattern of binding_pattern -and program = source_elements +and binding_pattern = + | ObjectBinding of (binding_property, binding_ident) list_with_rest + | ArrayBinding of (binding_element option, binding) list_with_rest -and program_with_annots = - ((source_element * location) * (Js_token.Annot.t * Parse_info.t) list) list +and binding_ident = ident -and source_elements = (source_element * location) list +and binding_property = + | Prop_binding of property_name * binding_element + | Prop_ident of binding_ident * initialiser option -and source_element = - | Statement of statement - | Function_declaration of function_declaration +and function_body = statement_list + +and program = statement_list + +and program_with_annots = (statement_list * (Js_token.Annot.t * Parse_info.t) list) list let compare_ident t1 t2 = match t1, t2 with @@ -311,8 +406,49 @@ let ident ?(loc = N) ?var (Utf8_string.Utf8 n as name) = if not (is_ident' name) then failwith (Printf.sprintf "%s not a valid ident" n); S { name; var; loc } +let param' id = BindingIdent id, None + +let param ?loc ?var name = param' (ident ?loc ?var name) + let ident_unsafe ?(loc = N) ?var name = S { name; var; loc } +let rec bound_idents_of_binding p = + match p with + | BindingIdent id -> [ id ] + | BindingPattern p -> bound_idents_of_pattern p + +and bound_idents_of_params { list; rest } = + List.concat_map list ~f:bound_idents_of_element + @ + match rest with + | None -> [] + | Some p -> bound_idents_of_binding p + +and bound_idents_of_pattern p = + match p with + | ObjectBinding { list; rest } -> ( + List.concat_map list ~f:(function + | Prop_ident (i, _) -> [ i ] + | Prop_binding (_, e) -> bound_idents_of_element e) + @ + match rest with + | None -> [] + | Some x -> [ x ]) + | ArrayBinding { list; rest } -> ( + List.concat_map list ~f:(function + | None -> [] + | Some e -> bound_idents_of_element e) + @ + match rest with + | None -> [] + | Some x -> bound_idents_of_binding x) + +and bound_idents_of_variable_declaration = function + | DeclIdent (id, _) -> [ id ] + | DeclPattern (p, _) -> bound_idents_of_pattern p + +and bound_idents_of_element (b, _) = bound_idents_of_binding b + module IdentSet = Set.Make (struct type t = ident @@ -324,3 +460,71 @@ module IdentMap = Map.Make (struct let compare = compare_ident end) + +let dot e l = EDot (e, ANormal, l) + +let variable_declaration l = + Variable_statement (Var, List.map l ~f:(fun (i, e) -> DeclIdent (i, Some e))) + +let array l = EArr (List.map l ~f:(fun x -> Element x)) + +let call f args loc = ECall (f, ANormal, List.map args ~f:(fun x -> Arg x), loc) + +let list list = { list; rest = None } + +let early_error ?reason loc = { loc; reason } + +let fun_ params body loc = + ( { async = false; generator = false } + , list (List.map params ~f:(fun x -> BindingIdent x, None)) + , body + , loc ) + +let rec assignment_pattern_of_expr x = + match x with + | EObj l -> + let rest, l = + match List.rev l with + | PropertySpread (EVar x) :: l -> Some x, List.rev l + | _ -> None, l + in + let list = + List.map l ~f:(function + | Property (PNI (Utf8 i), EVar (S { name = Utf8 i2; loc = N; _ } as ident)) + when String.equal i i2 -> Prop_ident (ident, None) + | Property (n, e) -> Prop_binding (n, binding_element_of_expression e) + | CoverInitializedName (_, i, e) -> Prop_ident (i, Some e) + | _ -> raise Not_found) + in + ObjectBinding { list; rest } + | EArr l -> + let rest, l = + match List.rev l with + | ElementSpread e :: l -> Some (binding_of_expression e), List.rev l + | _ -> None, l + in + let list = + List.map l ~f:(function + | ElementHole -> None + | Element e -> Some (binding_element_of_expression e) + | ElementSpread _ -> raise Not_found) + in + ArrayBinding { list; rest } + | _ -> raise Not_found + +and binding_element_of_expression e = + match e with + | EBin (Eq, e1, e2) -> binding_of_expression e1, Some (e2, N) + | e -> binding_of_expression e, None + +and binding_of_expression e = + match e with + | EVar x -> BindingIdent x + | EObj _ as x -> BindingPattern (assignment_pattern_of_expr x) + | EArr _ as x -> BindingPattern (assignment_pattern_of_expr x) + | _ -> raise Not_found + +let assignment_pattern_of_expr op x = + match op with + | None | Some Eq -> ( try Some (assignment_pattern_of_expr x) with Not_found -> None) + | _ -> None diff --git a/compiler/lib/javascript.mli b/compiler/lib/javascript.mli index 7b67435324..5b32b53022 100644 --- a/compiler/lib/javascript.mli +++ b/compiler/lib/javascript.mli @@ -80,13 +80,23 @@ type ident_string = ; loc : location } +type early_error = + { loc : Parse_info.t + ; reason : string option + } + type ident = | S of ident_string | V of Code.Var.t and array_litteral = element_list -and element_list = expression option list +and element_list = element list + +and element = + | ElementHole + | Element of expression + | ElementSpread of expression and binop = | Eq @@ -102,7 +112,9 @@ and binop = | BxorEq | BorEq | Or + | OrEq | And + | AndEq | Bor | Bxor | Band @@ -128,6 +140,10 @@ and binop = | Mul | Div | Mod + | Exp + | ExpEq + | Coalesce + | CoalesceEq and unop = | Not @@ -141,58 +157,100 @@ and unop = | DecrA | IncrB | DecrB + | Await + +and arguments = argument list + +and argument = + | Arg of expression + | ArgSpread of expression -and spread = - [ `Spread - | `Not_spread - ] +and property_list = property list -and arguments = (expression * spread) list +and property = + | Property of property_name * expression + | PropertySpread of expression + | PropertyMethod of property_name * method_ + | CoverInitializedName of early_error * ident * initialiser -and property_name_and_value_list = (property_name * expression) list +and method_ = + | MethodGet of function_declaration + | MethodSet of function_declaration + | Method of function_declaration and property_name = | PNI of identifier | PNS of Utf8_string.t | PNN of Num.t + | PComputed of expression and expression = | ESeq of expression * expression | ECond of expression * expression * expression + | EAssignTarget of binding_pattern + (* EAssignTarget is used on the LHS of assignment and in for-loops. + for({name} in o); + for([fst] in o); + *) | EBin of binop * expression * expression | EUn of unop * expression - | ECall of expression * arguments * location - | EAccess of expression * expression - | EDot of expression * identifier + | ECall of expression * access_kind * arguments * location + | ECallTemplate of expression * template * location + | EAccess of expression * access_kind * expression + | EDot of expression * access_kind * identifier | ENew of expression * arguments option | EVar of ident - | EFun of function_expression + | EFun of ident option * function_declaration + | EClass of ident option * class_declaration + | EArrow of function_declaration | EStr of Utf8_string.t (* A UTF-8 encoded string that may contain escape sequences. *) + | ETemplate of template | EArr of array_litteral | EBool of bool | ENum of Num.t - | EObj of property_name_and_value_list + | EObj of property_list | ERegexp of string * string option + | EYield of expression option + | CoverParenthesizedExpressionAndArrowParameterList of early_error + | CoverCallExpressionAndAsyncArrowHead of early_error + +and template = template_part list + +and template_part = + | TStr of Utf8_string.t + | TExp of expression + +and access_kind = + | ANormal + | ANullish (****) (* A.4 Statements *) and statement = | Block of block - | Variable_statement of variable_declaration list + | Variable_statement of variable_declaration_kind * variable_declaration list + | Function_declaration of ident * function_declaration + | Class_declaration of ident * class_declaration | Empty_statement | Expression_statement of expression | If_statement of expression * (statement * location) * (statement * location) option | Do_while_statement of (statement * location) * expression | While_statement of expression * (statement * location) | For_statement of - (expression option, variable_declaration list) either + (expression option, variable_declaration_kind * variable_declaration list) either * expression option * expression option * (statement * location) | ForIn_statement of - (expression, variable_declaration) either * expression * (statement * location) + (expression, variable_declaration_kind * for_binding) either + * expression + * (statement * location) + | ForOf_statement of + (expression, variable_declaration_kind * for_binding) either + * expression + * (statement * location) | Continue_statement of Label.t option | Break_statement of Label.t option | Return_statement of expression option @@ -203,7 +261,7 @@ and statement = | Switch_statement of expression * case_clause list * statement_list option * case_clause list | Throw_statement of expression - | Try_statement of block * (ident * block) option * block option + | Try_statement of block * (formal_parameter option * block) option * block option | Debugger_statement and ('left, 'right) either = @@ -214,33 +272,74 @@ and block = statement_list and statement_list = (statement * location) list -and variable_declaration = ident * initialiser option +and variable_declaration = + | DeclIdent of binding_ident * initialiser option + | DeclPattern of binding_pattern * initialiser + +and variable_declaration_kind = + | Var + | Let + | Const and case_clause = expression * statement_list and initialiser = expression * location (****) +and function_declaration = + function_kind * formal_parameter_list * function_body * location + +and function_kind = + { async : bool + ; generator : bool + } + +and class_declaration = + { extends : expression option + ; body : class_element list + } + +and class_element = + | CEMethod of bool (* static *) * class_element_name * method_ + | CEField of bool (* static *) * class_element_name * initialiser option + | CEStaticBLock of statement_list + +and class_element_name = + | PropName of property_name + | PrivName of ident + +and ('a, 'b) list_with_rest = + { list : 'a list + ; rest : 'b option + } + +and formal_parameter_list = (formal_parameter, binding) list_with_rest + +and formal_parameter = binding_element -(* A.5 Functions and programs *) -and function_declaration = ident * formal_parameter_list * function_body * location +and for_binding = binding -and function_expression = ident option * formal_parameter_list * function_body * location +and binding_element = binding * initialiser option -and formal_parameter_list = ident list +and binding = + | BindingIdent of binding_ident + | BindingPattern of binding_pattern -and function_body = source_elements +and binding_pattern = + | ObjectBinding of (binding_property, binding_ident) list_with_rest + | ArrayBinding of (binding_element option, binding) list_with_rest -and program = source_elements +and binding_ident = ident -and source_elements = (source_element * location) list +and binding_property = + | Prop_binding of property_name * binding_element + | Prop_ident of binding_ident * initialiser option -and program_with_annots = - ((source_element * location) * (Js_token.Annot.t * Parse_info.t) list) list +and function_body = statement_list -and source_element = - | Statement of statement - | Function_declaration of function_declaration +and program = statement_list + +and program_with_annots = (statement_list * (Js_token.Annot.t * Parse_info.t) list) list val compare_ident : ident -> ident -> int @@ -250,8 +349,36 @@ val is_ident' : Utf8_string.t -> bool val ident : ?loc:location -> ?var:Code.Var.t -> identifier -> ident +val param : ?loc:location -> ?var:Code.Var.t -> identifier -> formal_parameter + +val param' : ident -> formal_parameter + val ident_unsafe : ?loc:location -> ?var:Code.Var.t -> identifier -> ident +val bound_idents_of_params : formal_parameter_list -> ident list + +val bound_idents_of_variable_declaration : variable_declaration -> ident list + +val bound_idents_of_pattern : binding_pattern -> ident list + +val bound_idents_of_binding : binding -> ident list + module IdentSet : Set.S with type elt = ident module IdentMap : Map.S with type key = ident + +val dot : expression -> identifier -> expression + +val array : expression list -> expression + +val call : expression -> expression list -> location -> expression + +val variable_declaration : (ident * initialiser) list -> statement + +val list : 'a list -> ('a, _) list_with_rest + +val early_error : ?reason:string -> Parse_info.t -> early_error + +val fun_ : ident list -> statement_list -> location -> function_declaration + +val assignment_pattern_of_expr : binop option -> expression -> binding_pattern option diff --git a/compiler/lib/js_assign.ml b/compiler/lib/js_assign.ml index caa992ad02..51e201759d 100644 --- a/compiler/lib/js_assign.ml +++ b/compiler/lib/js_assign.ml @@ -179,7 +179,7 @@ while compiling the OCaml toplevel: Format.eprintf "short variable occurrences: %d/%d@." !n2 !n3); name - let add_constraints global u ~offset params = + let add_constraints global u ~offset (params : ident list) = let constr = global.constr in let c = make_alloc_table () in S.iter @@ -208,15 +208,32 @@ while compiling the OCaml toplevel: global.constraints <- u :: global.constraints let record_block state scope (block : Js_traverse.block) = - let all = S.union scope.Js_traverse.def scope.Js_traverse.use in + let all = + Javascript.IdentSet.union + (Javascript.IdentSet.union scope.Js_traverse.def_var scope.Js_traverse.def_local) + scope.Js_traverse.use + in let all = match block with - | Catch (V v) -> S.add v all - | Catch (S _) | Params _ -> all + | Normal -> all + | Params _ -> all + | Catch (p, _) -> + let ids = bound_idents_of_binding p in + List.fold_left ids ~init:all ~f:(fun all i -> Javascript.IdentSet.add i all) + in + let all = + Javascript.IdentSet.fold + (fun x acc -> + match x with + | V i -> S.add i acc + | S _ -> acc) + all + S.empty in match block with - | Catch v -> add_constraints state all ~offset:5 [ v ] - | Params p -> add_constraints state all ~offset:0 p + | Normal -> add_constraints state all ~offset:0 [] + | Catch (v, _) -> add_constraints state all ~offset:5 (bound_idents_of_binding v) + | Params p -> add_constraints state all ~offset:0 (bound_idents_of_params p) end module Preserve : Strategy = struct @@ -238,29 +255,39 @@ module Preserve : Strategy = struct let record_block t scope (b : Js_traverse.block) = let defs = match b with - | Catch (V x) -> S.singleton x - | Catch (S _) -> S.empty - | Params _ -> scope.Js_traverse.def + | Catch (p, _) -> bound_idents_of_binding p + | Normal -> Javascript.IdentSet.elements scope.Js_traverse.def_local + | Params _ -> + Javascript.IdentSet.elements + (IdentSet.union scope.Js_traverse.def_var scope.Js_traverse.def_local) + in + let defs = + List.fold_left + ~init:S.empty + ~f:(fun acc x -> + match (x : Javascript.ident) with + | V i -> S.add i acc + | S _ -> acc) + defs in + t.scopes <- (defs, scope) :: t.scopes let allocate_variables t ~count:_ = let names = Array.make t.size "" in List.iter t.scopes ~f:(fun (defs, state) -> - let assigned : StringSet.t = - List.fold_left - ~f:(fun acc (set : Utf8_string_set.t) -> - Utf8_string_set.fold (fun (Utf8 x) acc -> StringSet.add x acc) set acc) - ~init:Reserved.keyword - [ state.Js_traverse.def_name; state.Js_traverse.use_name ] - in let assigned = - S.fold + IdentSet.fold (fun var acc -> - let name = names.(Var.idx var) in - if not (String.is_empty name) then StringSet.add name acc else acc) - (S.union state.Js_traverse.use state.Js_traverse.def) - assigned + match var with + | S { name = Utf8 s; _ } -> StringSet.add s acc + | V v -> + let name = names.(Var.idx v) in + if not (String.is_empty name) then StringSet.add name acc else acc) + (IdentSet.union + state.Js_traverse.use + (IdentSet.union state.Js_traverse.def_var state.Js_traverse.def_local)) + Reserved.keyword in let _assigned = S.fold @@ -295,9 +322,9 @@ class traverse record_block = object (m) inherit Js_traverse.free as super - method! block b = + method! record_block b = record_block m#state b; - super#block b + super#record_block b end let program' (module Strategy : Strategy) p = @@ -305,17 +332,28 @@ let program' (module Strategy : Strategy) p = let state = Strategy.create nv in let mapper = new traverse (Strategy.record_block state) in let p = mapper#program p in - mapper#block (Params []); - if S.cardinal mapper#get_free <> 0 + mapper#record_block Normal; + let free = + IdentSet.filter + (function + | V _ -> true + | S _ -> false) + mapper#get_free + in + if IdentSet.cardinal free <> 0 then ( if not (debug ()) - then failwith_ "Some variables escaped (#%d)" (S.cardinal mapper#get_free) + then failwith_ "Some variables escaped (#%d)" (IdentSet.cardinal free) else let (_ : Source_map.t option) = Js_output.program (Pretty_print.to_out_channel stderr) p in Format.eprintf "Some variables escaped:"; - S.iter (fun s -> Format.eprintf " %s" (Var.to_string s)) mapper#get_free; + IdentSet.iter + (function + | S _ -> () + | V v -> Format.eprintf " <%s>" (Var.to_string v)) + free; Format.eprintf "@."); let names = Strategy.allocate_variables state ~count:mapper#get_count in let color = function diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml index 039d63fce5..ce4e6bb946 100644 --- a/compiler/lib/js_output.ml +++ b/compiler/lib/js_output.ml @@ -119,6 +119,7 @@ struct let ident f = function | S { name = Utf8 name; var = Some v; _ } -> output_debug_info_ident f name (Code.Var.get_loc v); + if false then PP.string f (Printf.sprintf "/* %d */" (Code.Var.idx v)); PP.string f name | S { name = Utf8 name; var = None; loc = Pi pi } -> output_debug_info_ident f name (Some pi); @@ -135,39 +136,47 @@ struct PP.space f; ident f i - let rec formal_parameter_list f l = - match l with - | [] -> () - | [ i ] -> ident f i - | i :: r -> - ident f i; - PP.string f ","; - PP.break f; - formal_parameter_list f r - - (* - 0 Expression - 1 AssignementExpression - 2 ConditionalExpression - 3 LogicalORExpression - 4 LogicalANDExpression - 5 BitwiseORExpression - 6 BitwiseXORExpression - 7 BitwiseANDExpression - 8 EqualityExpression - 9 RelationalExpression - 10 ShiftExpression - 11 AdditiveExpression - 12 MultiplicativeExpression - 13 UnaryExpression - 14 PostfixExpression - 15 LeftHandsideExpression - NewExpression - CallExpression - 16 MemberExpression - FunctionExpression - PrimaryExpression -*) + let early_error _ = assert false + + type prec = + | Expression (* 0 *) + | AssignementExpression (* 1 *) + | ConditionalExpression (* 2 *) + | ShortCircuitExpression + | CoalesceExpression + | LogicalORExpression (* 3 *) + | LogicalANDExpression (* 4 *) + | BitwiseORExpression (* 5 *) + | BitwiseXORExpression (* 6 *) + | BitwiseANDExpression (* 7 *) + | EqualityExpression (* 8 *) + | RelationalExpression (* 9 *) + | ShiftExpression (* 10 *) + | AdditiveExpression (* 11 *) + | MultiplicativeExpression (* 12 *) + | ExponentiationExpression + | UnaryExpression (* 13 *) + | UpdateExpression (* 14 *) + | LeftHandSideExpression (* 15 *) + | NewExpression + | CallOrMemberExpression + | MemberExpression (* 16 *) + + module Prec = struct + let compare (a : prec) (b : prec) = Poly.compare a b + + [@@@ocaml.warning "-32"] + + let ( <= ) a b = compare a b <= 0 + + let ( >= ) a b = compare a b >= 0 + + let ( < ) a b = compare a b < 0 + + let ( > ) a b = compare a b > 0 + + let ( = ) a b = compare a b = 0 + end let op_prec op = match op with @@ -182,24 +191,26 @@ struct | LsrEq | BandEq | BxorEq - | BorEq -> 1, 13, 1 - (* - | Or -> 3, 3, 4 - | And -> 4, 4, 5 - | Bor -> 5, 5, 6 - | Bxor -> 6, 6, 7 - | Band -> 7, 7, 8 - *) - | Or -> 3, 3, 3 - | And -> 4, 4, 4 - | Bor -> 5, 5, 5 - | Bxor -> 6, 6, 6 - | Band -> 7, 7, 7 - | EqEq | NotEq | EqEqEq | NotEqEq -> 8, 8, 9 - | Gt | GtInt | Ge | GeInt | Lt | LtInt | Le | LeInt | InstanceOf | In -> 9, 9, 10 - | Lsl | Lsr | Asr -> 10, 10, 11 - | Plus | Minus -> 11, 11, 12 - | Mul | Div | Mod -> 12, 12, 13 + | BorEq + | OrEq + | AndEq + | ExpEq + | CoalesceEq -> AssignementExpression, LeftHandSideExpression, AssignementExpression + | Coalesce -> CoalesceExpression, BitwiseORExpression, BitwiseORExpression + | Or -> LogicalORExpression, LogicalORExpression, LogicalORExpression + | And -> LogicalANDExpression, LogicalANDExpression, LogicalANDExpression + | Bor -> BitwiseORExpression, BitwiseORExpression, BitwiseORExpression + | Bxor -> BitwiseXORExpression, BitwiseXORExpression, BitwiseXORExpression + | Band -> BitwiseANDExpression, BitwiseANDExpression, BitwiseANDExpression + | EqEq | NotEq | EqEqEq | NotEqEq -> + EqualityExpression, EqualityExpression, RelationalExpression + | Gt | GtInt | Ge | GeInt | Lt | LtInt | Le | LeInt | InstanceOf | In -> + RelationalExpression, RelationalExpression, ShiftExpression + | Lsl | Lsr | Asr -> ShiftExpression, ShiftExpression, AdditiveExpression + | Plus | Minus -> AdditiveExpression, AdditiveExpression, MultiplicativeExpression + | Mul | Div | Mod -> + MultiplicativeExpression, MultiplicativeExpression, ExponentiationExpression + | Exp -> ExponentiationExpression, UpdateExpression, ExponentiationExpression let op_str op = match op with @@ -210,7 +221,9 @@ struct | PlusEq -> "+=" | MinusEq -> "-=" | Or -> "||" + | OrEq -> "||=" | And -> "&&" + | AndEq -> "&&=" | Bor -> "|" | Bxor -> "^" | Band -> "&" @@ -236,6 +249,10 @@ struct | Mul -> "*" | Div -> "/" | Mod -> "%" + | Exp -> "**" + | ExpEq -> "**=" + | CoalesceEq -> "??=" + | Coalesce -> "??" | InstanceOf | In -> assert false let unop_str op = @@ -244,7 +261,7 @@ struct | Neg -> "-" | Pl -> "+" | Bnot -> "~" - | IncrA | IncrB | DecrA | DecrB | Typeof | Void | Delete -> assert false + | IncrA | IncrB | DecrA | DecrB | Typeof | Void | Delete | Await -> assert false let rec ends_with_if_without_else st = match fst st with @@ -253,6 +270,7 @@ struct | While_statement (_, st) | For_statement (_, _, _, st) | ForIn_statement (_, _, st) -> ends_with_if_without_else st + | ForOf_statement (_, _, st) -> ends_with_if_without_else st | If_statement (_, _, None) -> true | Block _ | Variable_statement _ @@ -265,18 +283,45 @@ struct | Do_while_statement _ | Switch_statement _ | Try_statement _ + | Function_declaration _ + | Class_declaration _ | Debugger_statement -> false - let rec need_paren l e = - match e with - | ESeq (e, _) -> l <= 0 && need_paren 0 e - | ECond (e, _, _) -> l <= 2 && need_paren 3 e - | EBin (op, e, _) -> - let out, lft, _rght = op_prec op in - l <= out && need_paren lft e - | ECall (e, _, _) | EAccess (e, _) | EDot (e, _) -> l <= 15 && need_paren 15 e - | EVar _ | EStr _ | EArr _ | EBool _ | ENum _ | ERegexp _ | EUn _ | ENew _ -> false - | EFun _ | EObj _ -> true + let starts_with ~obj ~funct ~let_identifier ~async_identifier l e = + let rec traverse l e = + match e with + | EObj _ -> obj + | EFun _ -> funct + | EVar (S { name = Utf8 "let"; _ }) -> let_identifier + | EVar (S { name = Utf8 "async"; _ }) -> async_identifier + | ESeq (e, _) -> Prec.(l <= Expression) && traverse Expression e + | ECond (e, _, _) -> + Prec.(l <= ConditionalExpression) && traverse ShortCircuitExpression e + | EAssignTarget (ObjectBinding _) -> obj + | EAssignTarget (ArrayBinding _) -> false + | EBin (op, e, _) -> + let out, lft, _rght = op_prec op in + Prec.(l <= out) && traverse lft e + | EUn ((IncrA | DecrA), e) -> + Prec.(l <= UpdateExpression) && traverse LeftHandSideExpression e + | ECallTemplate (e, _, _) | ECall (e, _, _, _) | EAccess (e, _, _) | EDot (e, _, _) + -> traverse CallOrMemberExpression e + | EArrow _ + | EVar _ + | EStr _ + | ETemplate _ + | EArr _ + | EBool _ + | ENum _ + | ERegexp _ + | EUn _ + | ENew _ + | EClass _ + | EYield _ -> false + | CoverCallExpressionAndAsyncArrowHead e + | CoverParenthesizedExpressionAndArrowParameterList e -> early_error e + in + traverse l e let best_string_quote s = let simple = ref 0 and double = ref 0 in @@ -319,74 +364,174 @@ struct Buffer.add_char b quote; PP.string f (Buffer.contents b) - let rec expression l f e = + let rec comma_list f f_elt l = + match l with + | [] -> () + | [ x ] -> + PP.start_group f 0; + f_elt f x; + PP.end_group f + | x :: r -> + PP.start_group f 0; + f_elt f x; + PP.end_group f; + PP.string f ","; + PP.break f; + comma_list f f_elt r + + let comma_list_rest f f_elt l f_rest rest = + match l, rest with + | [], None -> () + | [], Some rest -> + PP.start_group f 0; + PP.string f "..."; + f_rest f rest; + PP.end_group f + | l, None -> comma_list f f_elt l + | l, Some r -> + comma_list f f_elt l; + PP.string f ","; + PP.break f; + PP.start_group f 0; + PP.string f "..."; + f_rest f r; + PP.end_group f + + let rec expression (l : prec) f e = match e with | EVar v -> ident f v | ESeq (e1, e2) -> - if l > 0 + if Prec.(l > Expression) then ( PP.start_group f 1; PP.string f "("); - expression 0 f e1; + expression Expression f e1; PP.string f ","; PP.break f; - expression 0 f e2; - if l > 0 + expression Expression f e2; + if Prec.(l > Expression) then ( PP.string f ")"; PP.end_group f) - | EFun (i, l, b, pc) -> + | EFun (i, (k, l, b, pc)) -> + let prefix = + match k with + | { async = false; generator = false } -> "function" + | { async = true; generator = false } -> "async function" + | { async = true; generator = true } -> "async function*" + | { async = false; generator = true } -> "function*" + in + function_declaration f prefix ident i l b pc + | EClass (i, cl_decl) -> + PP.string f "class"; + (match i with + | None -> () + | Some i -> + PP.space f; + ident f i); + class_declaration f cl_decl + | EArrow (k, p, b, pc) -> + if Prec.(l > AssignementExpression) + then ( + PP.start_group f 1; + PP.string f "("); PP.start_group f 1; PP.start_group f 0; - PP.start_group f 0; - PP.string f "function"; - opt_identifier f i; + (match k with + | { async = true; generator = false } -> + PP.string f "async"; + PP.space f + | { async = false; generator = false } -> () + | { async = true | false; generator = true } -> assert false); + PP.break f; + (match p with + | { list = [ ((BindingIdent _, None) as x) ]; rest = None } -> + formal_parameter f x + | _ -> + PP.start_group f 1; + PP.string f "("; + formal_parameter_list f p; + PP.string f ")"; + PP.end_group f); PP.end_group f; PP.break f; PP.start_group f 1; - PP.string f "("; - formal_parameter_list f l; - PP.string f ")"; + PP.break1 f; + PP.string f "=>"; + PP.break1 f; + (match b with + | [ (Return_statement (Some e), loc) ] -> + (* Should not starts with '{' *) + output_debug_info f loc; + parenthesized_expression ~obj:true AssignementExpression f e + | [ (Block _, _) ] -> function_body f b + | _ -> + PP.start_group f 1; + PP.string f "{"; + function_body f b; + output_debug_info f pc; + PP.string f "}"; + PP.end_group f); PP.end_group f; PP.end_group f; + if Prec.(l > AssignementExpression) + then ( + PP.string f ")"; + PP.end_group f) + | ECall (e, access_kind, el, loc) -> + (* Need parentheses also if within an expression [new e] *) + if Prec.(l = NewExpression || l > CallOrMemberExpression) + then ( + PP.start_group f 1; + PP.string f "("); + output_debug_info f loc; + PP.start_group f 1; + expression CallOrMemberExpression f e; PP.break f; PP.start_group f 1; - PP.string f "{"; - function_body f b; - output_debug_info f pc; - PP.string f "}"; + (match access_kind with + | ANormal -> PP.string f "(" + | ANullish -> PP.string f "?.("); + arguments f el; + PP.string f ")"; PP.end_group f; - PP.end_group f - | ECall (e, el, loc) -> - if l > 15 + PP.end_group f; + if Prec.(l = NewExpression || l > CallOrMemberExpression) + then ( + PP.string f ")"; + PP.end_group f) + | ECallTemplate (e, t, loc) -> + (* Need parentheses also if within an expression [new e] *) + if Prec.(l = NewExpression || l > CallOrMemberExpression) then ( PP.start_group f 1; PP.string f "("); output_debug_info f loc; PP.start_group f 1; - expression 15 f e; + expression CallOrMemberExpression f e; PP.break f; PP.start_group f 1; - PP.string f "("; - arguments f el; - PP.string f ")"; + template f t; PP.end_group f; PP.end_group f; - if l > 15 + if Prec.(l = NewExpression || l > CallOrMemberExpression) then ( PP.string f ")"; PP.end_group f) | EStr (Utf8 s) -> let quote = best_string_quote s in pp_string f ~quote s + | ETemplate l -> template f l | EBool b -> PP.string f (if b then "true" else "false") | ENum num -> let s = Num.to_string num in let need_parent = if Num.is_neg num - then l > 13 (* Negative numbers may need to be parenthesized. *) + then + Prec.(l > UnaryExpression) + (* Negative numbers may need to be parenthesized. *) else - l = 15 + Prec.(l >= CallOrMemberExpression) (* Parenthesize as well when followed by a dot. *) && (not (Char.equal s.[0] 'I')) (* Infinity *) @@ -396,111 +541,100 @@ struct if need_parent then PP.string f "("; PP.string f s; if need_parent then PP.string f ")" - | EUn (Typeof, e) -> - if l > 13 + | EUn (((Typeof | Void | Delete | Await) as op), e) -> + let p = UnaryExpression in + if Prec.(l > p) then ( PP.start_group f 1; PP.string f "("); PP.start_group f 0; - PP.string f "typeof"; + let name = + match op with + | Typeof -> "typeof" + | Void -> "void" + | Delete -> "delete" + | Await -> "await" + | _ -> assert false + in + PP.string f name; PP.space f; - expression 13 f e; + expression p f e; PP.end_group f; - if l > 13 + if Prec.(l > p) then ( PP.string f ")"; PP.end_group f) - | EUn (Void, e) -> - if l > 13 + | EUn (((IncrB | DecrB) as op), e) -> + let p = UpdateExpression in + if Prec.(l > p) then ( PP.start_group f 1; PP.string f "("); - PP.start_group f 0; - PP.string f "void"; - PP.space f; - expression 13 f e; - PP.end_group f; - if l > 13 + if Poly.(op = IncrB) then PP.string f "++" else PP.string f "--"; + expression UnaryExpression f e; + if Prec.(l > p) then ( PP.string f ")"; PP.end_group f) - | EUn (Delete, e) -> - if l > 13 + | EUn (((IncrA | DecrA) as op), e) -> + let p = UpdateExpression in + if Prec.(l > p) then ( PP.start_group f 1; PP.string f "("); - PP.start_group f 0; - PP.string f "delete"; - PP.space f; - expression 13 f e; - PP.end_group f; - if l > 13 - then ( - PP.string f ")"; - PP.end_group f) - | EUn (((IncrA | DecrA | IncrB | DecrB) as op), e) -> - if l > 13 - then ( - PP.start_group f 1; - PP.string f "("); - if Poly.(op = IncrA) || Poly.(op = DecrA) then expression 13 f e; - if Poly.(op = IncrA) || Poly.(op = IncrB) - then PP.string f "++" - else PP.string f "--"; - if Poly.(op = IncrB) || Poly.(op = DecrB) then expression 13 f e; - if l > 13 + expression LeftHandSideExpression f e; + if Poly.(op = IncrA) then PP.string f "++" else PP.string f "--"; + if Prec.(l > p) then ( PP.string f ")"; PP.end_group f) | EUn (op, e) -> - if l > 13 + let p = UnaryExpression in + let need_parent = Prec.(l > p) in + if need_parent then ( PP.start_group f 1; PP.string f "("); PP.string f (unop_str op); PP.space f; - expression 13 f e; - if l > 13 + expression p f e; + if need_parent then ( PP.string f ")"; PP.end_group f) - | EBin (InstanceOf, e1, e2) -> + | EBin (((InstanceOf | In) as op), e1, e2) -> let out, lft, rght = op_prec InstanceOf in - if l > out + if Prec.(l > out) then ( PP.start_group f 1; PP.string f "("); PP.start_group f 0; expression lft f e1; PP.space f; - PP.string f "instanceof"; - PP.space f; - expression rght f e2; - PP.end_group f; - if l > out - then ( - PP.string f ")"; - PP.end_group f) - | EBin (In, e1, e2) -> - let out, lft, rght = op_prec InstanceOf in - if l > out - then ( - PP.start_group f 1; - PP.string f "("); - PP.start_group f 0; - expression lft f e1; - PP.space f; - PP.string f "in"; + let name = + match op with + | InstanceOf -> "instanceof" + | In -> "in" + | _ -> assert false + in + PP.string f name; PP.space f; expression rght f e2; PP.end_group f; - if l > out + if Prec.(l > out) then ( PP.string f ")"; PP.end_group f) | EBin (op, e1, e2) -> let out, lft, rght = op_prec op in - if l > out + let lft = + (* We can have e sequence of coalesce: e1 ?? e2 ?? e3, + but each expressions should be a BitwiseORExpression *) + match e1, op with + | EBin (Coalesce, _, _), Coalesce -> CoalesceExpression + | _ -> lft + in + if Prec.(l > out) then ( PP.start_group f 1; PP.string f "("); @@ -509,111 +643,103 @@ struct PP.string f (op_str op); PP.space f; expression rght f e2; - if l > out + if Prec.(l > out) then ( PP.string f ")"; PP.end_group f) + | EAssignTarget p -> pattern f p | EArr el -> PP.start_group f 1; PP.string f "["; element_list f el; PP.string f "]"; PP.end_group f - | EAccess (e, e') -> - if l > 15 - then ( - PP.start_group f 1; - PP.string f "("); + | EAccess (e, access_kind, e') -> PP.start_group f 1; - expression 15 f e; + let l' = + match l with + | NewExpression | MemberExpression -> MemberExpression + | _ -> CallOrMemberExpression + in + expression l' f e; PP.break f; PP.start_group f 1; - PP.string f "["; - expression 0 f e'; + (match access_kind with + | ANormal -> PP.string f "[" + | ANullish -> PP.string f "?.["); + expression Expression f e'; PP.string f "]"; PP.end_group f; - PP.end_group f; - if l > 15 - then ( - PP.string f ")"; - PP.end_group f) - | EDot (e, Utf8 nm) -> - if l > 15 - then ( - PP.start_group f 1; - PP.string f "("); - expression 15 f e; - PP.string f "."; - PP.string f nm; - if l > 15 - then ( - PP.string f ")"; - PP.end_group f) + PP.end_group f + | EDot (e, access_kind, Utf8 nm) -> + (* We keep tracks of whether call expression are allowed + without parentheses within this expression *) + let l' = + match l with + | NewExpression | MemberExpression -> MemberExpression + | _ -> CallOrMemberExpression + in + expression l' f e; + (match access_kind with + | ANormal -> PP.string f "." + | ANullish -> PP.string f "?."); + PP.string f nm | ENew (e, None) -> - (*FIX: should omit parentheses when possible*) - if l > 15 + if Prec.(l > NewExpression) then ( PP.start_group f 1; PP.string f "("); PP.start_group f 1; PP.string f "new"; PP.space f; - expression 16 f e; + expression NewExpression f e; PP.break f; PP.string f "()"; PP.end_group f; - if l > 15 + if Prec.(l > NewExpression) then ( PP.string f ")"; PP.end_group f) | ENew (e, Some el) -> - if l > 15 - then ( - PP.start_group f 1; - PP.string f "("); PP.start_group f 1; PP.string f "new"; PP.space f; - expression 16 f e; + expression MemberExpression f e; PP.break f; PP.start_group f 1; PP.string f "("; arguments f el; PP.string f ")"; PP.end_group f; - PP.end_group f; - if l > 15 - then ( - PP.string f ")"; - PP.end_group f) + PP.end_group f | ECond (e, e1, e2) -> - if l > 2 + if Prec.(l > ConditionalExpression) then ( PP.start_group f 1; PP.string f "("); PP.start_group f 1; PP.start_group f 0; - expression 3 f e; + expression ShortCircuitExpression f e; PP.end_group f; PP.break f; PP.start_group f 1; PP.string f "?"; - expression 1 f e1; + expression AssignementExpression f e1; PP.end_group f; PP.break f; PP.start_group f 1; PP.string f ":"; - expression 1 f e2; + expression AssignementExpression f e2; PP.end_group f; PP.end_group f; - if l > 2 + if Prec.(l > ConditionalExpression) then ( PP.string f ")"; PP.end_group f) | EObj lst -> PP.start_group f 1; PP.string f "{"; - property_name_and_value_list f lst; + property_list f lst; PP.string f "}"; PP.end_group f | ERegexp (s, opt) -> ( @@ -623,6 +749,39 @@ struct match opt with | None -> () | Some o -> PP.string f o) + | EYield e -> ( + match e with + | None -> PP.string f "yield" + | Some e -> + if Prec.(l > AssignementExpression) + then ( + PP.start_group f 1; + PP.string f "("); + PP.start_group f 7; + PP.string f "yield"; + PP.non_breaking_space f; + PP.start_group f 0; + expression AssignementExpression f e; + PP.end_group f; + PP.end_group f; + if Prec.(l > AssignementExpression) + then ( + PP.start_group f 1; + PP.string f ")" + (* There MUST be a space between the yield and its + argument. A line return will not work *))) + | CoverCallExpressionAndAsyncArrowHead e + | CoverParenthesizedExpressionAndArrowParameterList e -> early_error e + + and template f l = + PP.string f "`"; + List.iter l ~f:(function + | TStr (Utf8 s) -> PP.string f s + | TExp e -> + PP.string f "${"; + expression AssignementExpression f e; + PP.string f "}"); + PP.string f "`" and property_name f n = match n with @@ -630,83 +789,161 @@ struct | PNS (Utf8 s) -> let quote = best_string_quote s in pp_string f ~quote s - | PNN v -> expression 0 f (ENum v) + | PNN v -> expression Expression f (ENum v) + | PComputed e -> + PP.string f "["; + expression Expression f e; + PP.string f "]" - and property_name_and_value_list f l = - match l with - | [] -> () - | [ (pn, e) ] -> + and property_list f l = comma_list f property l + + and property f p = + match p with + | Property (pn, e) -> PP.start_group f 0; property_name f pn; PP.string f ":"; PP.break f; - expression 1 f e; + expression AssignementExpression f e; PP.end_group f - | (pn, e) :: r -> - PP.start_group f 0; - property_name f pn; - PP.string f ":"; - PP.break f; - expression 1 f e; - PP.end_group f; - PP.string f ","; - PP.break f; - property_name_and_value_list f r + | PropertySpread e -> + PP.string f "..."; + expression AssignementExpression f e + | PropertyMethod (n, m) -> method_ f property_name n m + | CoverInitializedName (e, _, _) -> early_error e - and element_list f el = - match el with - | [] -> () - | [ e ] -> ( - match e with - | None -> PP.string f "," - | Some e -> - PP.start_group f 0; - expression 1 f e; - PP.end_group f) - | e :: r -> - (match e with - | None -> () - | Some e -> - PP.start_group f 0; - expression 1 f e; - PP.end_group f); - PP.string f ","; - PP.break f; - element_list f r + and method_ : 'a. _ -> (PP.t -> 'a -> unit) -> 'a -> method_ -> unit = + fun (type a) f (name : PP.t -> a -> unit) (n : a) (m : method_) -> + match m with + | MethodGet (k, l, b, loc') | MethodSet (k, l, b, loc') -> + (match k with + | { async = false; generator = false } -> () + | _ -> assert false); + let prefix = + match m with + | MethodGet _ -> "get" + | MethodSet _ -> "set" + | _ -> assert false + in + function_declaration f prefix name (Some n) l b loc' + | Method (k, l, b, loc') -> + let fpn f () = + (match k with + | { async = false; generator = false } -> () + | { async = false; generator = true } -> + PP.string f "*"; + PP.space f + | { async = true; generator = false } -> + PP.string f "async"; + PP.space f + | { async = true; generator = true } -> + PP.string f "async*"; + PP.space f); + name f n + in + function_declaration f "" fpn (Some ()) l b loc' - and function_body f b = source_elements f ~skip_last_semi:true b + and element_list f el = comma_list f element el - and arguments f l = - match l with - | [] -> () - | [ (e, s) ] -> + and element f (e : element) = + match e with + | ElementHole -> () + | Element e -> PP.start_group f 0; - (match s with - | `Spread -> PP.string f "..." - | `Not_spread -> ()); - expression 1 f e; + expression AssignementExpression f e; PP.end_group f - | (e, s) :: r -> + | ElementSpread e -> PP.start_group f 0; - (match s with - | `Spread -> PP.string f "..." - | `Not_spread -> ()); - expression 1 f e; - PP.end_group f; - PP.string f ","; - PP.break f; - arguments f r + PP.string f "..."; + expression AssignementExpression f e; + PP.end_group f - and variable_declaration f (i, init) = - match init with - | None -> ident f i - | Some (e, pc) -> + and formal_parameter f e = binding_element f e + + and formal_parameter_list f { list; rest } = + comma_list_rest f formal_parameter list binding rest + + and function_body f b = statement_list f ~skip_last_semi:true b + + and argument f a = + PP.start_group f 0; + (match a with + | Arg e -> expression AssignementExpression f e + | ArgSpread e -> + PP.string f "..."; + expression AssignementExpression f e); + PP.end_group f + + and arguments f l = comma_list f argument l + + and variable_declaration f x = + match x with + | DeclIdent (i, None) -> ident f i + | DeclIdent (i, Some (e, loc)) -> PP.start_group f 1; - output_debug_info f pc; + output_debug_info f loc; ident f i; PP.string f "="; PP.break f; - expression 1 f e; + expression AssignementExpression f e; + PP.end_group f + | DeclPattern (p, (e, loc)) -> + PP.start_group f 1; + output_debug_info f loc; + pattern f p; + PP.string f "="; + PP.break f; + expression AssignementExpression f e; + PP.end_group f + + and binding_property f x = + match x with + | Prop_binding (pn, e) -> + property_name f pn; + PP.string f ":"; + PP.break f; + binding_element f e + | Prop_ident (i, None) -> ident f i + | Prop_ident (i, Some (e, loc)) -> + ident f i; + PP.string f "="; + PP.break f; + output_debug_info f loc; + expression AssignementExpression f e + + and binding_element f (b, (e : initialiser option)) = + match e with + | None -> binding f b + | Some (e, loc) -> + output_debug_info f loc; + binding f b; + PP.string f "="; + PP.break f; + expression AssignementExpression f e + + and binding f x = + match x with + | BindingIdent id -> ident f id + | BindingPattern p -> pattern f p + + and binding_array_elt f x = + match x with + | None -> () + | Some e -> binding_element f e + + and pattern f p = + match p with + | ObjectBinding { list; rest } -> + PP.start_group f 1; + PP.string f "{"; + comma_list_rest f binding_property list ident rest; + PP.string f "}"; + PP.end_group f + | ArrayBinding { list; rest } -> + PP.start_group f 1; + PP.string f "["; + comma_list_rest f binding_array_elt list binding rest; + PP.string f "]"; PP.end_group f and variable_declaration_list_aux f l = @@ -719,31 +956,49 @@ struct PP.break f; variable_declaration_list_aux f r - and variable_declaration_list close f = function + and variable_declaration_kind f kind = + match kind with + | Var -> PP.string f "var" + | Let -> PP.string f "let" + | Const -> PP.string f "const" + + and variable_declaration_list kind close f = function | [] -> () - | [ (i, None) ] -> + | [ DeclIdent (i, None) ] -> PP.start_group f 1; - PP.string f "var"; + variable_declaration_kind f kind; + PP.space f; + ident f i; + if close then PP.string f ";" + | [ DeclIdent (i, Some (e, loc)) ] -> + PP.start_group f 1; + output_debug_info f loc; + variable_declaration_kind f kind; PP.space f; ident f i; + PP.string f "="; + PP.break1 f; + PP.start_group f 0; + expression AssignementExpression f e; if close then PP.string f ";"; + PP.end_group f; PP.end_group f - | [ (i, Some (e, pc)) ] -> + | [ DeclPattern (p, (e, loc)) ] -> PP.start_group f 1; - output_debug_info f pc; - PP.string f "var"; + output_debug_info f loc; + variable_declaration_kind f kind; PP.space f; - ident f i; + pattern f p; PP.string f "="; PP.break1 f; PP.start_group f 0; - expression 1 f e; + expression AssignementExpression f e; if close then PP.string f ";"; PP.end_group f; PP.end_group f | l -> PP.start_group f 1; - PP.string f "var"; + variable_declaration_kind f kind; PP.space f; variable_declaration_list_aux f l; if close then PP.string f ";"; @@ -754,32 +1009,70 @@ struct | None -> () | Some e -> expression l f e + and parenthesized_expression + ?(last_semi = fun () -> ()) + ?(obj = false) + ?(funct = false) + ?(let_identifier = false) + ?(async_identifier = false) + l + f + e = + if starts_with ~obj ~funct ~let_identifier ~async_identifier l e + then ( + PP.start_group f 1; + PP.string f "("; + expression l f e; + PP.string f ")"; + last_semi (); + PP.end_group f) + else ( + PP.start_group f 0; + expression l f e; + last_semi (); + PP.end_group f) + + and for_binding f k v = + variable_declaration_kind f k; + PP.space f; + binding f v + and statement ?(last = false) f (s, loc) = let last_semi () = if last then () else PP.string f ";" in output_debug_info f loc; match s with | Block b -> block f b - | Variable_statement l -> variable_declaration_list (not last) f l + | Variable_statement (k, l) -> variable_declaration_list k (not last) f l + | Function_declaration (i, (k, l, b, loc')) -> + let prefix = + match k with + | { async = false; generator = false } -> "function" + | { async = true; generator = false } -> "async function" + | { async = true; generator = true } -> "async function*" + | { async = false; generator = true } -> "function*" + in + function_declaration f prefix ident (Some i) l b loc' + | Class_declaration (i, cl_decl) -> + PP.string f "class"; + PP.space f; + ident f i; + class_declaration f cl_decl | Empty_statement -> PP.string f ";" | Debugger_statement -> PP.string f "debugger"; last_semi () | Expression_statement e -> (* Parentheses are required when the expression - starts syntactically with "{" or "function" *) - if need_paren 0 e - then ( - PP.start_group f 1; - PP.string f "("; - expression 0 f e; - PP.string f ")"; - last_semi (); - PP.end_group f) - else ( - PP.start_group f 0; - expression 0 f e; - last_semi (); - PP.end_group f) + starts syntactically with "{", "function", "async function" + or "let [" *) + parenthesized_expression + ~last_semi + ~obj:true + ~funct:true + ~let_identifier:true + Expression + f + e | If_statement (e, s1, (Some _ as s2)) when ends_with_if_without_else s1 -> (* Dangling else issue... *) statement ~last f (If_statement (e, (Block [ s1 ], N), s2), N) @@ -790,7 +1083,7 @@ struct PP.break f; PP.start_group f 1; PP.string f "("; - expression 0 f e; + expression Expression f e; PP.string f ")"; PP.end_group f; PP.end_group f; @@ -812,7 +1105,7 @@ struct PP.break f; PP.start_group f 1; PP.string f "("; - expression 0 f e; + expression Expression f e; PP.string f ")"; PP.end_group f; PP.end_group f; @@ -834,7 +1127,7 @@ struct PP.break f; PP.start_group f 1; PP.string f "("; - expression 0 f e; + expression Expression f e; PP.string f ")"; PP.end_group f; PP.end_group f; @@ -850,7 +1143,7 @@ struct PP.break f; PP.start_group f 1; PP.string f "("; - expression 0 f e; + expression Expression f e; PP.string f ")"; PP.end_group f; PP.end_group f; @@ -871,7 +1164,7 @@ struct PP.break1 f; PP.start_group f 1; PP.string f "("; - expression 0 f e; + expression Expression f e; PP.string f ")"; last_semi (); PP.end_group f; @@ -888,7 +1181,7 @@ struct PP.break f; PP.start_group f 1; PP.string f "("; - expression 0 f e; + expression Expression f e; PP.string f ")"; last_semi (); PP.end_group f; @@ -901,14 +1194,17 @@ struct PP.start_group f 1; PP.string f "("; (match e1 with - | Left e -> opt_expression 0 f e - | Right l -> variable_declaration_list false f l); + | Left None -> () + | Left (Some e) -> + (* Should not starts with "let [" *) + parenthesized_expression ~let_identifier:true Expression f e + | Right (k, l) -> variable_declaration_list k false f l); PP.string f ";"; PP.break f; - opt_expression 0 f e2; + opt_expression Expression f e2; PP.string f ";"; PP.break f; - opt_expression 0 f e3; + opt_expression Expression f e3; PP.string f ")"; PP.end_group f; PP.end_group f; @@ -925,13 +1221,45 @@ struct PP.start_group f 1; PP.string f "("; (match e1 with - | Left e -> expression 0 f e - | Right v -> variable_declaration_list false f [ v ]); + | Left e -> + (* Should not starts with "let [" *) + parenthesized_expression ~let_identifier:true Expression f e + | Right (k, v) -> for_binding f k v); PP.space f; PP.string f "in"; PP.break f; PP.space f; - expression 0 f e2; + expression Expression f e2; + PP.string f ")"; + PP.end_group f; + PP.end_group f; + PP.break f; + PP.start_group f 0; + statement ~last f s; + PP.end_group f; + PP.end_group f + | ForOf_statement (e1, e2, s) -> + PP.start_group f 1; + PP.start_group f 0; + PP.string f "for"; + PP.break f; + PP.start_group f 1; + PP.string f "("; + (match e1 with + | Left e -> + (* Should not starts with "let" or "async of" *) + parenthesized_expression + ~let_identifier:true + ~async_identifier:true + Expression + f + e + | Right (k, v) -> for_binding f k v); + PP.space f; + PP.string f "of"; + PP.break f; + PP.space f; + expression Expression f e2; PP.string f ")"; PP.end_group f; PP.end_group f; @@ -961,7 +1289,7 @@ struct | None -> PP.string f "return"; last_semi () - | Some (EFun (i, l, b, pc)) -> + | Some (EFun (i, ({ async = false; generator = false }, l, b, pc))) -> PP.start_group f 1; PP.start_group f 0; PP.start_group f 0; @@ -989,7 +1317,7 @@ struct PP.string f "return"; PP.non_breaking_space f; PP.start_group f 0; - expression 0 f e; + expression Expression f e; last_semi (); PP.end_group f; PP.end_group f @@ -1008,7 +1336,7 @@ struct PP.break f; PP.start_group f 1; PP.string f "("; - expression 0 f e; + expression Expression f e; PP.string f ")"; PP.end_group f; PP.end_group f; @@ -1020,7 +1348,7 @@ struct PP.start_group f 1; PP.string f "case"; PP.space f; - expression 0 f e; + expression Expression f e; PP.string f ":"; PP.end_group f; PP.break f; @@ -1057,7 +1385,7 @@ struct PP.string f "throw"; PP.non_breaking_space f; PP.start_group f 0; - expression 0 f e; + expression Expression f e; last_semi (); PP.end_group f; PP.end_group f @@ -1073,9 +1401,12 @@ struct | Some (i, b) -> PP.break f; PP.start_group f 1; - PP.string f "catch("; - ident f i; - PP.string f ")"; + (match i with + | None -> PP.string f "catch" + | Some i -> + PP.string f "catch("; + formal_parameter f i; + PP.string f ")"); PP.break f; block f b; PP.end_group f); @@ -1106,44 +1437,79 @@ struct PP.string f "}"; PP.end_group f - and source_element f ?skip_last_semi se = - match se with - | Statement s, loc -> statement f ?last:skip_last_semi (s, loc) - | Function_declaration (i, l, b, loc'), loc -> - output_debug_info f loc; - PP.start_group f 1; - PP.start_group f 0; - PP.start_group f 0; - PP.string f "function"; + and function_declaration : + type a. 'pp -> string -> ('pp -> a -> unit) -> a option -> _ -> _ -> _ -> unit = + fun f prefix (pp_name : _ -> a -> unit) (name : a option) l body loc -> + PP.start_group f 1; + PP.start_group f 0; + PP.start_group f 0; + PP.string f prefix; + (match name with + | None -> () + | Some name -> + if not (String.is_empty prefix) then PP.space f; + pp_name f name); + PP.end_group f; + PP.break f; + PP.start_group f 1; + PP.string f "("; + formal_parameter_list f l; + PP.string f ")"; + PP.end_group f; + PP.end_group f; + PP.break f; + PP.start_group f 1; + PP.string f "{"; + function_body f body; + output_debug_info f loc; + PP.string f "}"; + PP.end_group f; + PP.end_group f + + and class_declaration f x = + Option.iter x.extends ~f:(fun e -> PP.space f; - ident f i; - PP.end_group f; - PP.break f; - PP.start_group f 1; - PP.string f "("; - formal_parameter_list f l; - PP.string f ")"; - PP.end_group f; - PP.end_group f; - PP.break f; - PP.start_group f 1; - PP.string f "{"; - function_body f b; - output_debug_info f loc'; - PP.string f "}"; - PP.end_group f; - PP.end_group f + PP.string f "extends"; + PP.space f; + expression Expression f e); + PP.string f "{"; + List.iter x.body ~f:(fun x -> + match x with + | CEMethod (static, n, m) -> + if static + then ( + PP.string f "static"; + PP.space f); + method_ f class_element_name n m; + PP.break f + | CEField (static, n, i) -> + if static + then ( + PP.string f "static"; + PP.space f); + class_element_name f n; + (match i with + | None -> () + | Some (e, loc) -> + PP.string f "="; + PP.space f; + output_debug_info f loc; + expression Expression f e); + PP.break f + | CEStaticBLock l -> + PP.string f "static"; + block f l; + PP.break f); + PP.string f "}" - and source_elements f ?skip_last_semi se = - match se with - | [] -> () - | [ s ] -> source_element f ?skip_last_semi s - | s :: r -> - source_element f s; - PP.break f; - source_elements f ?skip_last_semi r + and class_element_name f x = + match x with + | PropName n -> property_name f n + | PrivName i -> + PP.string f "#"; + ident f i - and program f s = source_elements f s + and program f s = statement_list f s end let part_of_ident = diff --git a/compiler/lib/js_parser.mly b/compiler/lib/js_parser.mly index 90e11b8928..d3cce23903 100644 --- a/compiler/lib/js_parser.mly +++ b/compiler/lib/js_parser.mly @@ -1,34 +1,59 @@ (* Js_of_ocaml compiler *) (* Copyright (C) 2013 Hugo Heuzard *) -(* Yoann Padioleau *) - -(* Copyright (C) 2010 Facebook *) - -(* This library is free software; you can redistribute it and/or *) -(* modify it under the terms of the GNU Lesser General Public License *) -(* version 2.1 as published by the Free Software Foundation, with the *) -(* special exception on linking described in file license.txt. *) +%{ -(* This library 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 file *) -(* license.txt for more details. *) +(* Yoann Padioleau + * + * Copyright (C) 2010-2014 Facebook + * Copyright (C) 2019-2022 r2c + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public License + * version 2.1 as published by the Free Software Foundation, with the + * special exception on linking described in file license.txt. + * + * This library 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 file + * license.txt for more details. + *) -%{ -(* - * src: ocamlyaccified from Marcel Laverdet 'fbjs2' via emacs macros, itself - * extracted from the official ECMAscript specification at: - * http://www.ecma-international.org/publications/standards/ecma-262.htm +(*************************************************************************) +(* Prelude *) +(*************************************************************************) +(* This file contains a grammar for Javascript (ES6 and more), as well + * as partial support for Typescript. + * + * reference: + * - https://en.wikipedia.org/wiki/JavaScript_syntax + * - http://www.ecma-international.org/publications/standards/Ecma-262.htm + * - https://github.com/Microsoft/TypeScript/blob/master/doc/spec.md#A * - * see also http://en.wikipedia.org/wiki/ECMAScript_syntax + * src: originally ocamlyacc-ified from Marcel Laverdet 'fbjs2' via Emacs + * macros, itself extracted from the official ECMAscript specification at: + * http://www.ecma-international.org/publications/standards/ecma-262.htm + * back in the day (probably ES4 or ES3). * - * related work: - * - http://marijnhaverbeke.nl/parse-js/, js parser in common lisp - * (which has been since ported to javascript by nodejs people) - * - jslint + * I have heavily extended the grammar to provide the first parser for Flow. + * I have extended it also to deal with many new Javascript features + * (see cst_js.ml top comment). + * + * The grammar is close to the ECMA grammar but I've simplified a few things + * when I could: + * - less intermediate grammar rules for advanced features + * (they are inlined in the original grammar rule) + * - by using my retagging-tokens technique (see parsing_hacks_js.ml) + * I could also get rid of some of the ugliness in the ECMA grammar + * that has to deal with ambiguous constructs + * (they conflate together expressions and arrow parameters, object + * values and object matching, etc.). + * Instead, in this grammar things are clearly separated. + * - I've used some macros to factorize rules, including some tricky + * macros to factorize expression rules. *) +open Js_token open Javascript let var pi name = ident_unsafe ~loc:(pi) name @@ -37,732 +62,1037 @@ let pi pos = (Parse_info.t_of_pos pos) let p pos = Pi (pi pos) +let vartok pos tok = + EVar (var (p pos) (Stdlib.Utf8_string.of_string_exn (Js_token.to_string tok))) + let utf8_s = Stdlib.Utf8_string.of_string_exn %} (*************************************************************************) -(* 1 Tokens *) +(* Tokens *) (*************************************************************************) +%token T_ERROR +%token T_EOF + (*-----------------------------------------*) -(* 2 the normal tokens *) +(* The space/comment tokens *) (*-----------------------------------------*) -(* Tokens with a value *) +%token TAnnot +%token TComment +%token TCommentLineDirective + +(*-----------------------------------------*) +(* normal tokens *) +(*-----------------------------------------*) + +(* tokens with a value *) %token T_NUMBER %token T_BIGINT %token T_IDENTIFIER %token T_STRING %token T_REGEXP -%token T_TEMPLATE_PART -(* Keywords tokens *) +%token T_ENCAPSED_STRING +(*-----------------------------------------*) +(* Keyword tokens *) +(*-----------------------------------------*) +(* coupling: if you add an element here, expand also ident_keyword_bis + * and also maybe the special hack for regexp in lexer_js.mll *) %token -T_FUNCTION T_IF T_RETURN T_SWITCH T_THIS T_THROW T_TRY -T_VAR T_WHILE T_WITH T_NULL T_FALSE T_TRUE -T_BREAK T_CASE T_CATCH T_CONTINUE T_DEFAULT T_DO T_FINALLY T_FOR -T_DEBUGGER -T_ASYNC -T_AWAIT -T_YIELD -T_LET -T_CONST -T_CLASS -T_SUPER -T_EXPORT -T_PACKAGE -T_INTERFACE -T_IMPLEMENTS -T_DECLARE -T_TYPE -T_PUBLIC -T_PRIVATE -T_OPAQUE -T_PROTECTED -T_EXTENDS -T_STATIC +T_FUNCTION T_CONST T_VAR T_LET +T_IF T_ELSE +T_WHILE T_FOR T_DO T_CONTINUE T_BREAK +T_SWITCH T_CASE T_DEFAULT +T_RETURN +T_THROW T_TRY T_CATCH T_FINALLY +T_YIELD T_ASYNC T_AWAIT +T_NEW T_IN T_OF T_THIS T_SUPER T_WITH +T_NULL T_FALSE T_TRUE +T_CLASS T_INTERFACE T_EXTENDS T_IMPLEMENTS T_STATIC +T_IMPORT T_EXPORT +T_INSTANCEOF T_TYPEOF +T_DELETE T_VOID T_ENUM -T_IMPORT -T_OF - -%token T_ELSE - -%token T_NEW +T_PUBLIC T_PRIVATE T_PROTECTED +T_PACKAGE +T_DEBUGGER +T_GET T_SET +T_FROM +T_TARGET +T_META +(*-----------------------------------------*) +(* Punctuation tokens *) +(*-----------------------------------------*) (* Syntax *) -%token -T_LCURLY T_RCURLY -T_LPAREN T_RPAREN -T_LBRACKET T_RBRACKET -T_SEMICOLON -T_COMMA -T_ELLIPSIS -T_PERIOD +%token +T_LCURLY "{" T_RCURLY "}" +T_LPAREN "(" T_RPAREN ")" +T_LBRACKET "[" T_RBRACKET "]" +T_SEMICOLON ";" T_COMMA "," T_PERIOD "." T_COLON ":" +T_PLING_PERIOD +T_PLING "?" +T_ARROW +T_AT +T_ELLIPSIS "..." +T_POUND +T_PLING_PLING +T_DOLLARCURLY +T_BACKQUOTE (* Operators *) -%token -T_RSHIFT3_ASSIGN T_RSHIFT_ASSIGN T_LSHIFT_ASSIGN -T_BIT_XOR_ASSIGN T_BIT_OR_ASSIGN T_BIT_AND_ASSIGN T_MOD_ASSIGN T_DIV_ASSIGN -T_MULT_ASSIGN T_MINUS_ASSIGN T_PLUS_ASSIGN T_ASSIGN -T_OR_ASSIGN T_AND_ASSIGN T_EXP_ASSIGN -T_EXP T_NULLISH_ASSIGN T_PLING_PERIOD T_PLING_PLING T_AT T_POUND - -%token -T_PLING T_COLON -T_OR -T_AND -T_BIT_OR -T_BIT_XOR -T_BIT_AND -T_EQUAL T_NOT_EQUAL T_STRICT_EQUAL T_STRICT_NOT_EQUAL -T_LESS_THAN_EQUAL T_GREATER_THAN_EQUAL T_LESS_THAN T_GREATER_THAN -T_IN T_INSTANCEOF -T_LSHIFT T_RSHIFT T_RSHIFT3 -T_PLUS T_MINUS -T_DIV T_MULT T_MOD -T_NOT T_BIT_NOT T_INCR T_DECR T_INCR_NB T_DECR_NB T_DELETE T_TYPEOF T_VOID -T_ARROW +%token + T_OR T_AND + T_BIT_OR T_BIT_XOR T_BIT_AND + T_PLUS T_MINUS + T_DIV T_MULT "*" T_MOD + T_NOT T_BIT_NOT + T_RSHIFT3_ASSIGN T_RSHIFT_ASSIGN T_LSHIFT_ASSIGN + T_BIT_XOR_ASSIGN T_BIT_OR_ASSIGN T_BIT_AND_ASSIGN T_MOD_ASSIGN T_DIV_ASSIGN + T_MULT_ASSIGN T_MINUS_ASSIGN T_PLUS_ASSIGN + T_ASSIGN "=" + T_EQUAL T_NOT_EQUAL T_STRICT_EQUAL T_STRICT_NOT_EQUAL + T_LESS_THAN_EQUAL T_GREATER_THAN_EQUAL T_LESS_THAN T_GREATER_THAN + T_LSHIFT T_RSHIFT T_RSHIFT3 + T_INCR T_DECR + T_EXP + T_OR_ASSIGN T_AND_ASSIGN + T_NULLISH_ASSIGN + T_EXP_ASSIGN (*-----------------------------------------*) -(* 2 extra tokens: *) +(* Extra tokens: *) (*-----------------------------------------*) %token T_VIRTUAL_SEMICOLON -%token TAnnot -%token T_ERROR -%token TComment -%token TCommentLineDirective - - -(* classic *) -%token T_EOF +%token T_LPAREN_ARROW +%token T_INCR_NB T_DECR_NB (*-----------------------------------------*) -(* 2 priorities *) +(* Priorities *) (*-----------------------------------------*) +(* must be at the top so that it has the lowest priority *) +(* %nonassoc LOW_PRIORITY_RULE *) + (* Special if / else associativity*) %nonassoc p_IF %nonassoc T_ELSE -%left T_OR +(* unused according to menhir: +%nonassoc p_POSTFIX +%right + T_RSHIFT3_ASSIGN T_RSHIFT_ASSIGN T_LSHIFT_ASSIGN + T_BIT_XOR_ASSIGN T_BIT_OR_ASSIGN T_BIT_AND_ASSIGN T_MOD_ASSIGN T_DIV_ASSIGN + T_MULT_ASSIGN T_MINUS_ASSIGN T_PLUS_ASSIGN "=" +*) + +%left T_OR T_PLING_PLING %left T_AND %left T_BIT_OR %left T_BIT_XOR %left T_BIT_AND %left T_EQUAL T_NOT_EQUAL T_STRICT_EQUAL T_STRICT_NOT_EQUAL -%left -T_LESS_THAN_EQUAL T_GREATER_THAN_EQUAL T_LESS_THAN T_GREATER_THAN -T_IN T_INSTANCEOF +%left T_LESS_THAN_EQUAL T_GREATER_THAN_EQUAL T_LESS_THAN T_GREATER_THAN + T_IN T_INSTANCEOF %left T_LSHIFT T_RSHIFT T_RSHIFT3 %left T_PLUS T_MINUS %left T_DIV T_MULT T_MOD -%right T_NOT T_BIT_NOT T_INCR T_DECR T_INCR_NB T_DECR_NB T_DELETE T_TYPEOF T_VOID + +%right T_EXP + +%right T_NOT T_BIT_NOT T_INCR T_DECR T_INCR_NB T_DECR_NB T_DELETE T_TYPEOF T_VOID T_AWAIT (*************************************************************************) -(* 1 Rules type declaration *) +(* Rules type decl *) (*************************************************************************) -%start program +%start <[ `Annot of Js_token.Annot.t * Parse_info.t | `Item of Javascript.statement * Javascript.location] list > program %start standalone_expression %% (*************************************************************************) -(* 1 Toplevel *) +(* Macros *) (*************************************************************************) -program: - | l=source_element_with_annot* T_EOF { l } +listc(X): + | X { [$1] } + | listc(X) "," X { $1 @ [$3] } + +listc_with_empty_trail(X): + | e=elision { (List.map (fun () -> None) e) } + | x=X e=elision { Some x :: (List.map (fun () -> None) e) } + | listc_with_empty_trail(X) x=X e=elision { $1 @ [Some x] @ (List.map (fun () -> None) e) } + +listc_with_empty(X): + | X { [ Some $1 ] } + | listc_with_empty_trail(X) { $1 } + | listc_with_empty_trail(X) X { $1 @ [Some $2 ] } +optl(X): + | (* empty *) { [] } + | X { $1 } + +(*************************************************************************) +(* Toplevel *) +(*************************************************************************) standalone_expression: - | e=expression T_EOF { e } + | e=expr T_EOF { e } + +program: + | l=module_item* T_EOF { l } annot: | a=TAnnot { a, pi $symbolstartpos } -source_element_with_annot: - | annots=annot* s=source_element {s,annots} +module_item: + | item { `Item $1 } + | annot { `Annot $1 } -source_element: - | statement - { let statement,pos = $1 in Statement statement, pos } - | function_declaration - { let declaration = $1 in Function_declaration declaration, p $symbolstartpos } +(*************************************************************************) +(* statement *) +(*************************************************************************) + +item: + | stmt { $1 } + | decl { $1 } + +decl: + | function_decl + { let i,f = $1 in Function_declaration (i,f), p $symbolstartpos } + | generator_decl + { let i,f = $1 in Function_declaration (i,f), p $symbolstartpos } + | async_decl + { let i,f = $1 in Function_declaration (i,f), p $symbolstartpos } + | lexical_decl { $1, p $symbolstartpos } + | class_decl + { let i,f = $1 in Class_declaration (i,f), p $symbolstartpos } (*************************************************************************) -(* 1 statement *) +(* Variable decl *) (*************************************************************************) -statement_no_semi: - | block=curly_block(statement*) - { let statements,_ = block in - Block statements } - | s=if_statement - | s=while_statement - | s=for_statement - | s=for_in_statement - | s=with_statement - | s=switch_statement - | s=try_statement - | s=labeled_statement - | s=empty_statement { s } - -statement_need_semi: - | s=variable_statement - | s=expression_statement - | s=do_while_statement - | s=continue_statement - | s=break_statement - | s=return_statement - | s=throw_statement - | s=debugger_statement { s } - -statement: - | s=statement_no_semi { (s : statement), p $symbolstartpos } - | s=statement_need_semi either(T_SEMICOLON, T_VIRTUAL_SEMICOLON) { (s : statement), p $symbolstartpos } - -labeled_statement: -| l=label T_COLON s=statement { Labelled_statement (l, s)} - -block: - | block=curly_block(statement*) - { let statements,_ = block in statements } - -variable_statement: - | T_VAR list=separated_nonempty_list(T_COMMA, pair(variable, initializer_?)) - { Variable_statement list } +(* part of 'stmt' *) -initializer_: - | T_ASSIGN e=assignment_expression { e, p $symbolstartpos } +variable_stmt: + | T_VAR l=listc(variable_decl) sc { Variable_statement (Var, l) } -empty_statement: - | T_SEMICOLON { Empty_statement } +(* part of 'decl' *) +lexical_decl: + (* es6: *) + | T_CONST l=listc(variable_decl) sc { Variable_statement (Const, l)} + | T_LET l=listc(variable_decl) sc { Variable_statement (Let, l)} -debugger_statement: - | T_DEBUGGER { Debugger_statement } +variable_decl: + | i=ident e=initializer_? { DeclIdent (i,e) } + | p=binding_pattern e=initializer_ { DeclPattern (p, e) } -expression_statement: - | expression_no_statement { Expression_statement $1 } +initializer_: + | "=" e=assignment_expr { e, p $symbolstartpos } -if_statement: - | T_IF condition=parenthesised(expression) t=statement T_ELSE e=statement - { If_statement (condition, t, Some e) } - | T_IF condition=parenthesised(expression) t=statement %prec p_IF - { If_statement (condition, t, None) } +for_variable_decl: + | T_VAR l=listc(variable_decl_no_in) { Var, l } + (* es6: *) + | T_CONST l=listc(variable_decl_no_in) { Const, l } + | T_LET l=listc(variable_decl_no_in) { Let, l } -do_while_statement: - | T_DO body=statement T_WHILE condition=parenthesised(expression) - { Do_while_statement (body, condition) } +variable_decl_no_in: + | i=ident e=initializer_no_in { DeclIdent (i,Some e) } + | i=ident { DeclIdent (i, None) } + | p=binding_pattern e=initializer_no_in { DeclPattern (p, e) } -while_statement: - | T_WHILE condition=parenthesised(expression) body=statement - { While_statement (condition, body) } +(* 'for ... in' and 'for ... of' declare only one variable *) +for_single_variable_decl: + | T_VAR b=for_binding { Var, b } + (* es6: *) + | T_CONST b=for_binding { Const, b } + | T_LET b=for_binding { Let, b } -for_statement: - | T_FOR T_LPAREN initial=expression_no_in? - T_SEMICOLON condition=expression? T_SEMICOLON increment=expression? - T_RPAREN statement=statement - { For_statement (Left initial, condition, increment, statement) } - | T_FOR T_LPAREN T_VAR - initial=separated_nonempty_list(T_COMMA, pair(variable, initializer_no_in?)) - T_SEMICOLON condition=expression? T_SEMICOLON increment=expression? - T_RPAREN statement=statement - { For_statement (Right initial, condition, increment, statement) } - -for_in_statement: - | T_FOR T_LPAREN left=left_hand_side_expression - T_IN right=expression T_RPAREN body=statement - { ForIn_statement (Left left, right, body) } - | T_FOR T_LPAREN T_VAR left=pair(variable, initializer_no_in?) - T_IN right=expression T_RPAREN body=statement - { ForIn_statement (Right left, right, body) } +for_binding: + | binding { $1 } -initializer_no_in: - | T_ASSIGN e=assignment_expression_no_in { e, p $symbolstartpos } -continue_statement: - | T_CONTINUE l=label? { (Continue_statement (l)) } +(*----------------------------*) +(* pattern *) +(*----------------------------*) -break_statement: - | T_BREAK l=label? { (Break_statement (l)) } +binding_pattern: + | object_binding_pattern { $1 } + | array_binding_pattern { $1 } + +binding: + | binding_pattern { BindingPattern $1 } + | ident { BindingIdent $1 } + +object_binding_pattern: + | "{" "}" { ObjectBinding (list []) } + | "{" r=binding_property_rest "}" { ObjectBinding {list = []; rest = Some r } } + | "{" l=listc(binding_property) ","? "}" { ObjectBinding (list l) } + | "{" l=listc(binding_property) "," r=binding_property_rest "}" + { ObjectBinding {list=l;rest= Some r} } + +binding_property: + | i=ident e=initializer_? { let id = match i with + | S { name; _ } -> name + | _ -> assert false in + Prop_binding (PNI id, (BindingIdent i, e)) } + | pn=property_name ":" e=binding_element { Prop_binding (pn, e) } + +binding_property_rest: + (* can appear only at the end of a binding_property_list in ECMA *) + | "..." id=ident { id } + +(* in theory used also for formal parameter as is *) +binding_element: + | b=binding e=initializer_? { b, e } + +(* array destructuring *) + +(* TODO use elision below. + * invent a new Hole category or maybe an array_argument special + * type like for the (call)argument type. + *) +array_binding_pattern: + | "[" "]" { ArrayBinding (list []) } + | "[" r=binding_element_rest "]" { ArrayBinding {list = []; rest = Some r }} + | "[" l=binding_element_list "]" { ArrayBinding (list l) } + | "[" l=binding_element_list r=binding_element_rest "]" + { ArrayBinding {list=l;rest= Some r} } -return_statement: - | T_RETURN e=expression? { (Return_statement e) } +(* can't use listc() here, it's $1 not [$1] below *) +binding_element_list: + | l=listc_with_empty(binding_element) { l } -with_statement: - | T_WITH parenthesised(expression) statement { assert false } +binding_element_rest: + (* can appear only at the end of a array_binding_pattern in ECMA *) + | "..." binding { $2 } -switch_statement: - | T_SWITCH subject=parenthesised(expression) - T_LCURLY pair=pair(case_clause*, pair(default_clause, case_clause*)?) T_RCURLY - { let switch = match pair with - | cases, None -> - Switch_statement (subject, cases, None, []) - | cases, Some (default, more_cases) -> - Switch_statement (subject, cases, Some default, more_cases) - in switch } +(*************************************************************************) +(* Function declarations (and exprs) *) +(*************************************************************************) -throw_statement: - | T_THROW e=expression { (Throw_statement e) } +function_decl: + | T_FUNCTION name=ident args=call_signature "{" b=function_body "}" + { (name, ({async = false; generator = false}, args, b, p $startpos($6))) } -try_statement: - | T_TRY b=block c=catch f=finally? { (Try_statement (b, Some c, f)) } - | T_TRY b=block f=finally { (Try_statement (b, None, Some f)) } +function_expr: + | T_FUNCTION name=ident? args=call_signature "{" b=function_body "}" + { EFun (name, ({async = false; generator = false}, args, b, p $symbolstartpos)) } -catch: - | T_CATCH pair=pair(parenthesised(variable), block) { pair } +call_signature: "(" args=formal_parameter_list_opt ")" + { args } -finally: - | T_FINALLY b=block { b } +function_body: optl(stmt_list) { $1 } (*----------------------------*) -(* 2 auxiliary statements *) +(* parameters *) (*----------------------------*) -case_clause: - | T_CASE pair=separated_pair(expression, T_COLON, statement*) { pair } +formal_parameter_list_opt: + | (*empty*) { list [] } + | formal_parameter_list_rev ","? { list (List.rev $1) } + | r=function_rest_param { { list = []; rest = Some r } } + | formal_parameter_list_rev "," r=function_rest_param { { list = List.rev $1; rest = Some r } } -default_clause: - | T_DEFAULT T_COLON list=statement* { list } +function_rest_param: + | "..." binding { $2 } + +(* must be written in a left-recursive way (see conflicts.txt) *) +formal_parameter_list_rev: + | formal_parameter_list_rev "," formal_parameter { $3::$1 } + | formal_parameter { [$1] } + +(* The ECMA and Typescript grammars imposes more restrictions + * (some require_parameter, optional_parameter, rest_parameter) + * but I've simplified. + * We could also factorize with binding_element as done by ECMA. + *) +formal_parameter: + | binding initializer_? { $1, $2 } (*************************************************************************) -(* 1 function declaration *) +(* generators *) (*************************************************************************) -function_declaration: - | T_FUNCTION name=variable args=parenthesised(separated_list(T_COMMA, variable)) - block=curly_block(source_element*) - { let elements,(_,loc) = block in - (name, args, elements, p loc) } +generator_decl: + | T_FUNCTION "*" name=ident args=call_signature "{" b=function_body "}" + { (name, ({async = false; generator = true}, args, b, p $symbolstartpos)) } -function_expression: - | T_FUNCTION name=variable? args=parenthesised(separated_list(T_COMMA, variable)) - block=curly_block(source_element*) - { let elements,_ = block in - EFun (name, args, elements, p $symbolstartpos) } +generator_expr: + | T_FUNCTION "*" name=ident? args=call_signature "{" b=function_body "}" + { EFun (name, ({async = false; generator = true}, args, b, p $symbolstartpos)) } (*************************************************************************) -(* 1 expression *) +(* asynchronous functions *) (*************************************************************************) -expression: - | assignment_expression { $1 } - | e1=expression T_COMMA e2=assignment_expression { ESeq (e1, e2) } - -assignment_expression: - | conditional_expression { $1 } - | e1=left_hand_side_expression op=assignment_operator e2=assignment_expression - { EBin (op, e1, e2) } - -left_hand_side_expression: - | new_expression { $1 } - | call_expression { $1 } - -conditional_expression: - | post_in_expression { $1 } - | ternary(post_in_expression, assignment_expression) { $1 } - -ternary(condition, consequence): - | condition=condition T_PLING consequence=consequence - T_COLON alternative=consequence - { ECond (condition, consequence, alternative) } - -post_in_expression: - | pre_in_expression { $1 } - | left=post_in_expression - op=comparison_or_logical_or_bit_operator - right=post_in_expression - { EBin (op, left, right) } - -pre_in_expression: - | left_hand_side_expression - { $1 } - | e=pre_in_expression op=postfix_operator - | op=prefix_operator e=pre_in_expression - { EUn (op, e) } - | left=pre_in_expression - op=arithmetic_or_shift_operator - right=pre_in_expression - { EBin (op, left, right) } - -call_expression: - | e=member_expression a=arguments - { (ECall(e, a, p $symbolstartpos)) } - | e=call_expression a=arguments - { (ECall(e, a, p $symbolstartpos)) } - | e=call_expression T_LBRACKET e2=expression T_RBRACKET - { (EAccess (e, e2)) } - | e=call_expression T_PERIOD i=identifier_or_kw - { (EDot (e, i)) } - -new_expression: - | e=member_expression { e } - | T_NEW e=new_expression { (ENew (e,None)) } - -member_expression: - | e=primary_expression - { e } - | e1=member_expression T_LBRACKET e2=expression T_RBRACKET - { (EAccess (e1,e2)) } - | e1=member_expression T_PERIOD i=identifier_or_kw - { (EDot(e1,i)) } - | T_NEW e1=member_expression a=arguments - { (ENew(e1, Some a)) } +async_decl: + | T_ASYNC T_FUNCTION name=ident args=call_signature "{" b=function_body "}" + { (name, ({async = true; generator = false}, args, b, p $symbolstartpos)) } + +async_function_expr: + | T_ASYNC T_FUNCTION name=ident? args=call_signature "{" b=function_body "}" + { EFun (name, ({async = true; generator = false}, args, b, p $symbolstartpos)) } + +(*************************************************************************) +(* Class declaration *) +(*************************************************************************) + +class_decl: T_CLASS id=binding_id extends=extends_clause? body=class_body + { id, {extends; body} } + +class_body: "{" class_element* "}" { List.flatten $2 } -primary_expression: - | e=primary_expression_no_statement - | e=object_literal - | e=function_expression { e } - -primary_expression_no_statement: - | T_THIS { (EVar (var (p $symbolstartpos) (Stdlib.Utf8_string.of_string_exn "this"))) } - | i=variable_with_loc { (EVar i) } - | n=null_literal { n } - | b=boolean_literal { b } - | n=numeric_literal { (ENum (Num.of_string_unsafe n)) } - | s=T_STRING { (EStr (fst s)) } - | r=regex_literal { r } - | a=array_literal { a } - | T_LPAREN e=expression T_RPAREN { (e) } +extends_clause: T_EXTENDS left_hand_side_expr { $2 } + +binding_id: ident { $1 } + +class_expr: T_CLASS i=binding_id? extends=extends_clause? body=class_body + { EClass (i, {extends; body}) } (*----------------------------*) -(* 2 no in *) +(* Class elements *) (*----------------------------*) -expression_no_in: - | assignment_expression_no_in { $1 } - | e1=expression_no_in T_COMMA e2=assignment_expression_no_in { ESeq (e1, e2) } +(* can't factorize with static_opt, or access_modifier_opt; ambiguities *) +class_element: + | m=method_definition(class_property_name) + { let n,m = m in [ CEMethod (false, n, m) ] } + | T_STATIC m=method_definition(class_property_name) + { let n,m = m in [ CEMethod (true, n, m) ] } + + | n=class_property_name i=initializer_? sc + { [ CEField (false, n, i) ] } + | T_STATIC n=class_property_name i=initializer_? sc + { [ CEField (true, n, i) ] } + | T_STATIC b=block { [CEStaticBLock b] } + | sc { [] } + +class_property_name: + | property_name { PropName $1 } + | T_POUND ident { PrivName $2 } + +method_definition(name): + | T_GET name=name args=call_signature "{" b=function_body "}" { name, MethodGet(({async = false; generator = false}, args, b, p $symbolstartpos)) } + | T_SET name=name args=call_signature "{" b=function_body "}" { name, MethodSet(({async = false; generator = false}, args, b, p $symbolstartpos)) } + | name=name args=call_signature "{" b=function_body "}" { + name, Method(({async = false; generator = false}, args, b, p $symbolstartpos)) } + | T_ASYNC name=name args=call_signature "{" b=function_body "}" { + name, Method(({async = true; generator = false}, args, b, p $symbolstartpos)) } + | "*" name=name args=call_signature "{" b=function_body "}" { + name, Method(({async = false; generator = true}, args, b, p $symbolstartpos)) } + | T_ASYNC "*" name=name args=call_signature "{" b=function_body "}" { + name, Method(({async = true; generator = true}, args, b, p $symbolstartpos)) } + +(*************************************************************************) +(* Stmt *) +(*************************************************************************) +%inline +stmt: s=stmt1 { s, p $symbolstartpos } + +stmt1: + | block { Block $1 } + | variable_stmt { $1 } + | empty_stmt { $1 } + | expr_stmt { $1 } + | if_stmt { $1 } + | iteration_stmt { $1 } + | continue_stmt { $1 } + | break_stmt { $1 } + | return_stmt { $1 } + | labelled_stmt { $1 } + | switch_stmt { $1 } + | throw_stmt { $1 } + | try_stmt { $1 } + | debugger_stmt { $1 } + +label: + | T_IDENTIFIER { + let name, _raw = $1 in + Label.of_string name } + +(* Library definitions *) + +block: "{" l=optl(stmt_list) "}" { l } + +stmt_list: item+ { $1 } + +empty_stmt: + | T_SEMICOLON { Empty_statement } + +expr_stmt: + | expr_no_stmt sc { Expression_statement $1 } + +if_stmt: + | T_IF "(" c=expr ")" t=stmt T_ELSE e=stmt + { If_statement (c, t, Some e) } + | T_IF "(" c=expr ")" t=stmt %prec p_IF + { If_statement (c, t, None) } + +iteration_stmt: + | T_DO body=stmt T_WHILE "(" condition=expr ")" sc + { Do_while_statement (body, condition) } + | T_WHILE "(" condition=expr ")" body=stmt + { While_statement (condition, body) } + + | T_FOR "(" i=expr_no_in? ";" c=expr? ";" incr=expr? ")" st=stmt + { For_statement (Left i, c, incr, st) } + | T_FOR "(" l=for_variable_decl ";" c=expr? ";" incr=expr? ")" st=stmt + { For_statement (Right l, c, incr, st) } + + | T_FOR "(" left=left_hand_side_expr T_IN right=expr ")" body=stmt + { match assignment_pattern_of_expr None left with + | None -> ForIn_statement (Left left, right, body) + | Some b -> ForIn_statement (Left (EAssignTarget b), right, body) } + | T_FOR "(" left=for_single_variable_decl T_IN right=expr ")" body=stmt + { ForIn_statement (Right left, right, body) } + + | T_FOR "(" left=left_hand_side_expr T_OF right=assignment_expr ")" body=stmt + { match assignment_pattern_of_expr None left with + | None -> ForOf_statement (Left left, right, body) + | Some b -> ForOf_statement (Left (EAssignTarget b), right, body) } + | T_FOR "(" left=for_single_variable_decl T_OF right=assignment_expr ")" body=stmt + { ForOf_statement (Right left, right, body) } + +initializer_no_in: + | "=" e=assignment_expr_no_in { e, p $symbolstartpos } + +continue_stmt: + | T_CONTINUE l=label? sc { (Continue_statement (l)) } + +break_stmt: + | T_BREAK l=label? sc { (Break_statement (l)) } + +return_stmt: + | T_RETURN e=expr? sc { (Return_statement e) } + +switch_stmt: + | T_SWITCH "(" subject=expr ")" cb=case_block + { let c1, d, c2 = cb in + Switch_statement (subject, c1, d, c2) + } -assignment_expression_no_in: - | conditional_expression_no_in { $1 } - | e1=left_hand_side_expression op=assignment_operator e2=assignment_expression_no_in - { EBin(op,e1,e2) } +labelled_stmt: + | l=label ":" s=stmt { Labelled_statement (l, s)} -conditional_expression_no_in: - | post_in_expression_no_in { $1 } - | ternary(post_in_expression_no_in, assignment_expression_no_in) { $1 } +throw_stmt: + | T_THROW e=expr sc { (Throw_statement e) } -post_in_expression_no_in: - | pre_in_expression { $1 } - | left=post_in_expression_no_in - op=comparison_or_logical_or_bit_operator_except_in - right=post_in_expression - { EBin (op, left, right) } +try_stmt: + | T_TRY b=block c=catch { (Try_statement (b, Some c, None)) } + | T_TRY b=block f=finally { (Try_statement (b, None, Some f)) } + | T_TRY b=block c=catch f=finally { (Try_statement (b, Some c, Some f)) } + +catch: + | T_CATCH "(" p=formal_parameter ")" b=block { Some p,b } + | T_CATCH b=block { None,b } + +finally: + | T_FINALLY b=block { b } + +debugger_stmt: + | T_DEBUGGER { Debugger_statement } (*----------------------------*) -(* 2 (no statement) *) +(* auxillary stmts *) (*----------------------------*) -expression_no_statement: - | assignment_expression_no_statement { $1 } - | e1=expression_no_statement T_COMMA e2=assignment_expression { ESeq(e1,e2) } - -assignment_expression_no_statement: - | conditional_expression_no_statement { $1 } - | e1=left_hand_side_expression_no_statement op=assignment_operator e2=assignment_expression - { EBin (op,e1,e2) } - -conditional_expression_no_statement: - | post_in_expression_no_statement { $1 } - | ternary(post_in_expression_no_statement, assignment_expression) { $1 } - -post_in_expression_no_statement: - | pre_in_expression_no_statement { $1 } - | left=post_in_expression_no_statement - op=comparison_or_logical_or_bit_operator - right=post_in_expression - { EBin (op, left, right) } - -pre_in_expression_no_statement: - | left_hand_side_expression_no_statement - { $1 } - | e=pre_in_expression_no_statement op=postfix_operator - | op=prefix_operator e=pre_in_expression - { EUn (op, e) } - | left=pre_in_expression_no_statement - op=arithmetic_or_shift_operator - right=pre_in_expression - { EBin (op, left, right) } - -left_hand_side_expression_no_statement: - | new_expression_no_statement { $1 } - | call_expression_no_statement { $1 } - -new_expression_no_statement: - | member_expression_no_statement { $1 } - | T_NEW e=new_expression { (ENew (e,None)) } - -call_expression_no_statement: - | e=member_expression_no_statement e2=arguments - { ( ECall(e, e2, p $symbolstartpos)) } - | e=call_expression_no_statement a=arguments - { ( ECall(e, a, p $symbolstartpos)) } - | e=call_expression_no_statement T_LBRACKET e2=expression T_RBRACKET - { ( EAccess(e, e2)) } - | e=call_expression_no_statement T_PERIOD i=identifier_or_kw - { ( EDot(e,i)) } - -member_expression_no_statement: - | e=primary_expression_no_statement - { e } - | e1=member_expression_no_statement T_LBRACKET e2=expression T_RBRACKET - { ( EAccess(e1, e2)) } - | e1=member_expression_no_statement T_PERIOD i=identifier_or_kw - { ( EDot(e1,i)) } - | T_NEW e=member_expression a=arguments - { (ENew(e,Some a)) } +case_block: + | "{" case_clause* "}" { $2, None, [] } + | "{" case_clause* default_clause case_clause* "}" { $2, Some $3, $4 } + +case_clause: + | T_CASE e=expr ":" s= optl(stmt_list) { e,s } + +default_clause: + | T_DEFAULT ":" list=optl(stmt_list) { list } + +(*************************************************************************) +(* Exprs *) +(*************************************************************************) + +expr: + | assignment_expr { $1 } + | e1=expr "," e2=assignment_expr { ESeq (e1, e2) } + +assignment_expr: + | conditional_expr(d1) { $1 } + | e1=left_hand_side_expr_(d1) op=assignment_operator e2=assignment_expr + { + match assignment_pattern_of_expr (Some op) e1 with + | None -> EBin (op, e1, e2) + | Some pat -> EBin (op, EAssignTarget pat, e2) + } + | arrow_function { $1 } + | async_arrow_function { $1 } + | T_YIELD { EYield None } + | T_YIELD e=assignment_expr { EYield (Some e) } + | T_YIELD "*" e=assignment_expr { EYield (Some e) } + +left_hand_side_expr: left_hand_side_expr_(d1) { $1 } (*----------------------------*) -(* 2 scalar *) +(* Generic part (to factorize rules) *) (*----------------------------*) -null_literal: - | T_NULL { (EVar (var (p $symbolstartpos) (Stdlib.Utf8_string.of_string_exn "null"))) } +conditional_expr(x): + | post_in_expr(x) { $1 } + | c=post_in_expr (x) "?" a=assignment_expr ":" b=assignment_expr { + ECond (c, a, b)} + +left_hand_side_expr_(x): + | new_expr(x) { $1 } + | call_expr(x) { $1 } + +post_in_expr(x): + | pre_in_expr(x) { $1 } + + | post_in_expr(x) T_LESS_THAN post_in_expr(d1) { EBin(Lt, $1, $3) } + | post_in_expr(x) T_GREATER_THAN post_in_expr(d1) { EBin(Gt, $1, $3) } + | post_in_expr(x) T_LESS_THAN_EQUAL post_in_expr(d1) { EBin(Le, $1, $3) } + | post_in_expr(x) T_GREATER_THAN_EQUAL post_in_expr(d1) { EBin(Ge, $1, $3) } + | post_in_expr(x) T_INSTANCEOF post_in_expr(d1) + { EBin (InstanceOf, $1, $3) } + + (* also T_IN! *) + | post_in_expr(x) T_IN post_in_expr(d1) { EBin (In, $1, $3) } + + | post_in_expr(x) T_EQUAL post_in_expr(d1) { EBin(EqEq, $1, $3) } + | post_in_expr(x) T_NOT_EQUAL post_in_expr(d1) { EBin(NotEq, $1, $3) } + | post_in_expr(x) T_STRICT_EQUAL post_in_expr(d1) { EBin(EqEqEq, $1, $3) } + | post_in_expr(x) T_STRICT_NOT_EQUAL post_in_expr(d1) { EBin(NotEqEq, $1, $3) } + | post_in_expr(x) T_BIT_AND post_in_expr(d1) { EBin(Band, $1, $3) } + | post_in_expr(x) T_BIT_XOR post_in_expr(d1) { EBin(Bxor, $1, $3) } + | post_in_expr(x) T_BIT_OR post_in_expr(d1) { EBin(Bor, $1, $3) } + | post_in_expr(x) T_AND post_in_expr(d1) { EBin(And, $1, $3) } + | post_in_expr(x) T_OR post_in_expr(d1) { EBin(Or, $1, $3) } + | post_in_expr(x) T_PLING_PLING post_in_expr(d1) { EBin(Coalesce, $1, $3) } + +(* called unary_expr and update_expr in ECMA *) +pre_in_expr(x): + | left_hand_side_expr_(x) { $1 } + + | pre_in_expr(x) T_INCR_NB (* %prec p_POSTFIX*) + { EUn (IncrA, $1) } + | pre_in_expr(x) T_DECR_NB (* %prec p_POSTFIX*) + { EUn (DecrA, $1) } + | T_INCR pre_in_expr(d1) + { EUn (IncrB, $2) } + | T_DECR pre_in_expr(d1) + { EUn (DecrB, $2) } + | T_INCR_NB pre_in_expr(d1) + { EUn (IncrB, $2) } + | T_DECR_NB pre_in_expr(d1) + { EUn (DecrB, $2) } + + | T_DELETE pre_in_expr(d1) { EUn (Delete, $2) } + | T_VOID pre_in_expr(d1) { EUn (Void, $2) } + | T_TYPEOF pre_in_expr(d1) { EUn (Typeof, $2) } + | T_PLUS pre_in_expr(d1) { EUn (Pl, $2) } + | T_MINUS pre_in_expr(d1) { EUn (Neg, $2)} + | T_BIT_NOT pre_in_expr(d1) { EUn (Bnot, $2) } + | T_NOT pre_in_expr(d1) { EUn (Not, $2) } + (* es7: *) + | T_AWAIT pre_in_expr(d1) { EUn (Await, $2) } + + | pre_in_expr(x) "*" pre_in_expr(d1) { EBin(Mul, $1, $3) } + | pre_in_expr(x) T_DIV pre_in_expr(d1) { EBin(Div, $1, $3) } + | pre_in_expr(x) T_MOD pre_in_expr(d1) { EBin(Mod, $1, $3) } + | pre_in_expr(x) T_PLUS pre_in_expr(d1) { EBin(Plus, $1, $3) } + | pre_in_expr(x) T_MINUS pre_in_expr(d1) { EBin(Minus, $1, $3) } + | pre_in_expr(x) T_LSHIFT pre_in_expr(d1) { EBin(Lsl, $1, $3) } + | pre_in_expr(x) T_RSHIFT pre_in_expr(d1) { EBin(Asr, $1, $3) } + | pre_in_expr(x) T_RSHIFT3 pre_in_expr(d1) { EBin(Lsr, $1, $3) } + + (* es7: *) + | pre_in_expr(x) T_EXP pre_in_expr(d1) { EBin(Exp, $1, $3) } + +call_expr(x): + | T_IMPORT a=arguments + { (ECall(vartok $startpos($1) T_IMPORT, ANormal, a, p $symbolstartpos)) } + | e=member_expr(x) a=arguments + { (ECall(e, ANormal, a, p $symbolstartpos)) } + | e=member_expr(x) T_PLING_PERIOD a=arguments + { (ECall(e, ANullish, a, p $symbolstartpos)) } + | e=call_expr(x) a=arguments + { (ECall(e, ANormal, a, p $symbolstartpos)) } + | e=call_expr(x) T_PLING_PERIOD a=arguments + { (ECall(e, ANullish, a, p $symbolstartpos)) } + | e=call_expr(x) "[" e2=expr "]" + { (EAccess (e, ANormal, e2)) } + | e=call_expr(x) T_PLING_PERIOD "[" e2=expr "]" + { (EAccess (e, ANullish, e2)) } + | e=call_expr(x) t=template_literal + { ECallTemplate(e, t,p $symbolstartpos) } + | T_SUPER a=arguments { ECall(vartok $startpos($1) T_SUPER,ANormal, a, p $symbolstartpos) } + | e=call_expr(x) a=access i=method_name + { EDot (e,a,i) } + +new_expr(x): + | e=member_expr(x) { e } + | T_NEW e=new_expr(d1) { (ENew (e,None)) } + +access: + | "." { ANormal } + | T_PLING_PERIOD { ANullish } + +member_expr(x): + | e=primary_expr(x) + { e } + | e1=member_expr(x) "[" e2=expr "]" + { (EAccess (e1,ANormal, e2)) } + | e1=member_expr(x) T_PLING_PERIOD "[" e2=expr "]" + { (EAccess (e1,ANullish, e2)) } + | e1=member_expr(x) ak=access i=field_name + { (EDot(e1,ak,i)) } + | T_NEW e1=member_expr(d1) a=arguments + { (ENew(e1, Some a)) } + | e=member_expr(x) t=template_literal + { ECallTemplate(e, t, p $symbolstartpos) } + | T_SUPER "[" e=expr "]" + { (EAccess (vartok $startpos($1) T_SUPER,ANormal, e)) } + | T_SUPER ak=access i=field_name + { (EDot(vartok $startpos($1) T_SUPER,ak,i)) } + | T_NEW "." T_TARGET + { (EDot(vartok $startpos($1) T_NEW,ANormal,Stdlib.Utf8_string.of_string_exn "target")) } + +primary_expr(x): + | e=primary_expr_no_braces + | e=x { e } + +d1: primary_with_stmt { $1 } + +primary_with_stmt: + | object_literal { $1 } + | function_expr { $1 } + | class_expr { $1 } + (* es6: *) + | generator_expr { $1 } + (* es7: *) + | async_function_expr { $1 } + + +primary_expr_no_braces: + | T_THIS { EVar (var (p $symbolstartpos) (Stdlib.Utf8_string.of_string_exn "this")) } + | i=ident { EVar i } + | n=null_literal { n } + | b=boolean_literal { b } + | n=numeric_literal { ENum (Num.of_string_unsafe n) } + | n=big_numeric_literal { ENum (Num.of_string_unsafe n) } + | s=string_literal { s } + | t=template_literal { ETemplate t } + | r=regex_literal { r } + | a=array_literal { a } + | e=coverParenthesizedExpressionAndArrowParameterList { e } + +coverParenthesizedExpressionAndArrowParameterList: + | "(" e=expr ","? ")" { e } + | "(" ")" { CoverParenthesizedExpressionAndArrowParameterList (early_error (pi $startpos($2))) } + | "(" "..." binding ")" { CoverParenthesizedExpressionAndArrowParameterList (early_error (pi $startpos($2)) ) } + | "(" expr "," "..." binding ")" { CoverParenthesizedExpressionAndArrowParameterList (early_error (pi $startpos($4)) ) } +(*----------------------------*) +(* scalar *) +(*----------------------------*) boolean_literal: | T_TRUE { (EBool true) } | T_FALSE { (EBool false) } +null_literal: + | T_NULL { (EVar (var (p $symbolstartpos) (Stdlib.Utf8_string.of_string_exn "null"))) } + numeric_literal: | T_NUMBER { let _,f = $1 in (f) } +big_numeric_literal: + | T_BIGINT { let _,f = $1 in (f) } + regex_literal: | r=T_REGEXP { let (Utf8 s, f) = r in (ERegexp (s, if String.equal f "" then None else Some f)) } +string_literal: s=T_STRING { (EStr (fst s)) } + +(*----------------------------*) +(* assign *) +(*----------------------------*) + +assignment_operator: + | T_ASSIGN { Eq } + | T_MULT_ASSIGN { StarEq } + | T_EXP_ASSIGN { ExpEq } + | T_DIV_ASSIGN { SlashEq } + | T_MOD_ASSIGN { ModEq } + | T_PLUS_ASSIGN { PlusEq } + | T_MINUS_ASSIGN { MinusEq } + | T_LSHIFT_ASSIGN { LslEq } + | T_RSHIFT_ASSIGN { AsrEq } + | T_RSHIFT3_ASSIGN { LsrEq } + | T_BIT_AND_ASSIGN { BandEq } + | T_BIT_XOR_ASSIGN { BxorEq } + | T_BIT_OR_ASSIGN { BorEq } + | T_AND_ASSIGN { AndEq } + | T_OR_ASSIGN { OrEq } + | T_NULLISH_ASSIGN { CoalesceEq } + (*----------------------------*) -(* 2 array *) +(* array *) (*----------------------------*) array_literal: - | T_LBRACKET e=elison T_RBRACKET - { (EArr e) } - | T_LBRACKET T_RBRACKET - { (EArr []) } - | T_LBRACKET l=element_list T_RBRACKET - { (EArr l) } - | T_LBRACKET l=element_list_rev last=elison_rev T_RBRACKET - { (EArr (List.rev_append l (List.rev last))) } - -element_list: - | element_list_rev { List.rev $1 } - -element_list_rev: - | empty=elison_rev e=assignment_expression { (Some e)::empty } - | e=assignment_expression { [Some e] } - | fst=element_list_rev empty=elison e=assignment_expression { (Some e) :: (List.rev_append empty fst) } + | "[" "]" { EArr [] } + | "[" l=listc_with_empty (element) "]" + { (EArr (List.map (function None -> ElementHole | Some x -> x) l)) } + +element: + | assignment_expr { Element $1 } + (* es6: spread operator: *) + | "..." assignment_expr { ElementSpread $2 } + +(*----------------------------*) +(* object *) +(*----------------------------*) object_literal: - | block=curly_block(empty) - { let _pairs, _ = block in EObj [] } - | block=curly_block(separated_or_terminated_list(T_COMMA, object_key_value)) - { let pairs, _ = block in EObj pairs } + | "{" "}" { EObj [] } + | "{" listc(property_name_and_value) ","? "}" { EObj $2 } + +property_name_and_value: + | property_name ":" assignment_expr { Property ($1, $3) } + (* es6: *) + | id=id { Property (PNI id, EVar (ident_unsafe id)) } + | ident initializer_ { CoverInitializedName (early_error (pi $startpos($2)), $1, $2) } + (* es6: spread operator: *) + | "..." assignment_expr { PropertySpread($2) } + | method_definition(property_name) + { let n, m = $1 in PropertyMethod(n,m) } +(*----------------------------*) +(* function call *) +(*----------------------------*) + +arguments: "(" argument_list_opt ")" { $2 } -object_key_value: - | pair=separated_pair(property_name, T_COLON, assignment_expression) { pair } +argument_list_opt: + | (*empty*) { [] } + (* argument_list must be written in a left-recursive way(see conflicts.txt) *) + | listc(argument) ","? { $1 } + +(* assignment_expr because expr supports sequence of exprs with ',' *) +argument: + | assignment_expr { Arg $1 } + (* es6: spread operator, allowed not only in last position *) + | "..." assignment_expr { ArgSpread $2 } (*----------------------------*) -(* 2 variable *) +(* interpolated strings *) (*----------------------------*) +(* templated string (a.k.a interpolated strings) *) +template_literal: T_BACKQUOTE encaps* T_BACKQUOTE { $2 } + +encaps: + | T_ENCAPSED_STRING { TStr (Stdlib.Utf8_string.of_string_exn $1) } + | T_DOLLARCURLY expr "}" { TExp $2 } + (*----------------------------*) -(* 2 function call *) +(* arrow (short lambda) *) (*----------------------------*) -arg: - | T_ELLIPSIS arg=assignment_expression { arg, `Spread } - | arg=assignment_expression { arg, `Not_spread } +(* TODO conflict with as then in indent_keyword_bis *) +arrow_function: + | i=ident T_ARROW b=arrow_body { EArrow({async = false; generator = false}, list [param' i],b, p $symbolstartpos) } + | T_LPAREN_ARROW a=formal_parameter_list_opt ")" T_ARROW b=arrow_body + { EArrow ({async = false; generator = false}, a,b, p $symbolstartpos) } + +async_arrow_function: + | T_ASYNC i=ident T_ARROW b=arrow_body { EArrow({async = true; generator = false}, list [param' i],b, p $symbolstartpos) } + | T_ASYNC T_LPAREN_ARROW a=formal_parameter_list_opt ")" T_ARROW b=arrow_body + { EArrow ({async = true; generator = false}, a,b, p $symbolstartpos) } -arguments: - | args=parenthesised(separated_list(T_COMMA, arg)) { args } + +(* was called consise body in spec *) +arrow_body: + | "{" b=function_body "}" { b } + | e=assignment_expr_no_stmt { [(Return_statement (Some e), p $symbolstartpos)] } + (* ugly *) + | e=function_expr { [(Expression_statement e, p $symbolstartpos)] } (*----------------------------*) -(* 2 auxiliary bis *) +(* no in *) (*----------------------------*) +expr_no_in: + | assignment_expr_no_in { $1 } + | e1=expr_no_in "," e2=assignment_expr_no_in { ESeq (e1, e2) } + +assignment_expr_no_in: + | conditional_expr_no_in { $1 } + | e1=left_hand_side_expr_(d1) op=assignment_operator e2=assignment_expr_no_in + { + match assignment_pattern_of_expr (Some op) e1 with + | None -> EBin (op, e1, e2) + | Some pat -> EBin (op, EAssignTarget pat, e2) + } + +conditional_expr_no_in: + | post_in_expr_no_in { $1 } + | c=post_in_expr_no_in "?" a=assignment_expr_no_in ":" b=assignment_expr_no_in + { ECond (c, a, b) } + +post_in_expr_no_in: + | pre_in_expr(d1) { $1 } + | post_in_expr_no_in T_LESS_THAN post_in_expr(d1) { EBin (Lt, $1, $3) } + | post_in_expr_no_in T_GREATER_THAN post_in_expr(d1) { EBin (Gt, $1, $3) } + | post_in_expr_no_in T_LESS_THAN_EQUAL post_in_expr(d1) { EBin (Le, $1, $3) } + | post_in_expr_no_in T_GREATER_THAN_EQUAL post_in_expr(d1) { EBin (Ge, $1, $3) } + | post_in_expr_no_in T_INSTANCEOF post_in_expr(d1) { EBin(InstanceOf, $1, $3) } + + (* no T_IN case *) + + | post_in_expr_no_in T_EQUAL post_in_expr(d1) { EBin (EqEq, $1, $3) } + | post_in_expr_no_in T_NOT_EQUAL post_in_expr(d1) { EBin (NotEq, $1, $3) } + | post_in_expr_no_in T_STRICT_EQUAL post_in_expr(d1) { EBin (EqEqEq, $1, $3)} + | post_in_expr_no_in T_STRICT_NOT_EQUAL post_in_expr(d1) { EBin (NotEqEq, $1, $3) } + | post_in_expr_no_in T_BIT_AND post_in_expr(d1) { EBin (Band, $1, $3)} + | post_in_expr_no_in T_BIT_XOR post_in_expr(d1) { EBin (Bxor, $1, $3)} + | post_in_expr_no_in T_BIT_OR post_in_expr(d1) { EBin (Bor, $1, $3) } + | post_in_expr_no_in T_AND post_in_expr(d1) { EBin (And, $1, $3) } + | post_in_expr_no_in T_OR post_in_expr(d1) { EBin (Or, $1, $3) } + | post_in_expr_no_in T_PLING_PLING post_in_expr(d1) { EBin (Coalesce, $1, $3) } + +(*----------------------------*) +(* (no stmt, and no object literal like { v: 1 }) *) +(*----------------------------*) +expr_no_stmt: + | assignment_expr_no_stmt { $1 } + | expr_no_stmt "," assignment_expr { ESeq ($1, $3) } + +(* coupling: with assignment_expr *) +assignment_expr_no_stmt: + | conditional_expr(primary_no_stmt) { $1 } + | e1=left_hand_side_expr_(primary_no_stmt) op=assignment_operator e2=assignment_expr + { + match assignment_pattern_of_expr (Some op) e1 with + | None -> EBin (op, e1, e2) + | Some pat -> EBin (op, EAssignTarget pat, e2) + } + (* es6: *) + | arrow_function { $1 } + | async_arrow_function { $1 } + (* es6: *) + | T_YIELD { EYield None } + | T_YIELD e=assignment_expr { EYield (Some e) } + | T_YIELD "*" e=assignment_expr { EYield (Some e) } + +(* no object_literal here *) +primary_no_stmt: T_ERROR TComment { assert false } + (*************************************************************************) -(* 1 Entities, names *) +(* Entities, names *) (*************************************************************************) +(* used for entities, parameters, labels, etc. *) +id: + | T_IDENTIFIER { fst $1 } + | ident_semi_keyword { utf8_s (Js_token.to_string $1) } -identifier_or_kw: - | T_IDENTIFIER { - let name, _raw = $1 in - name } - | T_ASYNC { utf8_s "async" } - | T_AWAIT { utf8_s "await" } - | T_BREAK { utf8_s "break" } - | T_CASE { utf8_s "case" } - | T_CATCH { utf8_s "catch" } - | T_CLASS { utf8_s "class" } - | T_CONST { utf8_s "const" } - | T_CONTINUE { utf8_s "continue" } - | T_DEBUGGER { utf8_s "debugger" } - | T_DECLARE { utf8_s "declare" } - | T_DEFAULT { utf8_s "default" } - | T_DELETE { utf8_s "delete" } - | T_DO { utf8_s "do" } - | T_ELSE { utf8_s "else" } - | T_ENUM { utf8_s "enum" } - | T_EXPORT { utf8_s "export" } - | T_EXTENDS { utf8_s "extends" } - | T_FALSE { utf8_s "false" } - | T_FINALLY { utf8_s "finally" } - | T_FOR { utf8_s "for" } - | T_FUNCTION { utf8_s "function" } - | T_IF { utf8_s "if" } - | T_IMPLEMENTS { utf8_s "implements" } - | T_IMPORT { utf8_s "import" } - | T_IN { utf8_s "in" } - | T_INSTANCEOF { utf8_s "instanceof" } - | T_INTERFACE { utf8_s "interface" } - | T_LET { utf8_s "let" } - | T_NEW { utf8_s "new" } - | T_NULL { utf8_s "null" } - | T_OF { utf8_s "of" } - | T_OPAQUE { utf8_s "opaque" } - | T_PACKAGE { utf8_s "package" } - | T_PRIVATE { utf8_s "private" } - | T_PROTECTED { utf8_s "protected" } - | T_PUBLIC { utf8_s "public" } - | T_RETURN { utf8_s "return" } - | T_STATIC { utf8_s "static" } - | T_SUPER { utf8_s "super" } - | T_SWITCH { utf8_s "switch" } - | T_THIS { utf8_s "this" } - | T_THROW { utf8_s "throw" } - | T_TRUE { utf8_s "true" } - | T_TRY { utf8_s "try" } - | T_TYPE { utf8_s "type" } - | T_TYPEOF { utf8_s "typeof" } - | T_VAR { utf8_s "var" } - | T_VOID { utf8_s "void" } - | T_WHILE { utf8_s "while" } - | T_WITH { utf8_s "with" } - | T_YIELD { utf8_s "yield" } - -variable: - | i=variable_with_loc { i } - -variable_with_loc: - | i=T_IDENTIFIER { - let name, _raw = i in - var (p $symbolstartpos) name - } - | ident_semi_keyword { var (p $symbolstartpos) (utf8_s (Js_token.to_string $1)) } +ident: + | id { var (p $symbolstartpos) $1 } (* add here keywords which are not considered reserved by ECMA *) ident_semi_keyword: - | T_OF { T_OF } - | T_TYPE { T_TYPE } - | T_DECLARE { T_DECLARE } - | T_PUBLIC { T_PUBLIC } | T_PRIVATE { T_PRIVATE } | T_PROTECTED { T_PROTECTED } + (* TODO: would like to add T_IMPORT here, but cause conflicts *) (* can have AS and ASYNC here but need to restrict arrow_function then *) | T_ASYNC { T_ASYNC } - (* TODO: would like to add T_IMPORT here, but cause conflicts *) - | T_PACKAGE { T_PACKAGE } - | T_IMPLEMENTS { T_IMPLEMENTS } - | T_OPAQUE { T_OPAQUE } - -label: - | T_IDENTIFIER { - let name, _raw = $1 in - Label.of_string name } + | T_FROM { T_FROM } + | T_GET { T_GET } + | T_META { T_META } + | T_OF { T_OF } + | T_SET { T_SET } + | T_TARGET {T_TARGET } + + (* future reserved words in strict mode code. *) + | T_IMPLEMENTS { T_IMPLEMENTS } + | T_INTERFACE { T_INTERFACE } + | T_PACKAGE { T_PACKAGE } + | T_PRIVATE { T_PRIVATE } + | T_PROTECTED {T_PROTECTED } + | T_PUBLIC { T_PUBLIC } + +(* alt: use the _last_non_whitespace_like_token trick and look if + * previous token was a period to return a T_ID + *) +ident_keyword: + | ident_keyword_bis { utf8_s (Js_token.to_string $1) } + +ident_keyword_bis: + | T_AWAIT { T_AWAIT } + | T_BREAK { T_BREAK } + | T_CASE { T_CASE } + | T_CATCH { T_CATCH } + | T_CLASS { T_CLASS } + | T_CONST { T_CONST } + | T_CONTINUE { T_CONTINUE } + | T_DEBUGGER { T_DEBUGGER } + | T_DEFAULT { T_DEFAULT } + | T_DELETE { T_DELETE } + | T_DO { T_DO } + | T_ELSE { T_ELSE } + | T_ENUM { T_ENUM } + | T_EXPORT { T_EXPORT } + | T_EXTENDS { T_EXTENDS } + | T_FALSE { T_FALSE } + | T_FINALLY { T_FINALLY } + | T_FOR { T_FOR } + | T_FUNCTION { T_FUNCTION } + | T_IF { T_IF } + | T_IMPORT { T_IMPORT } + | T_IN { T_IN } + | T_INSTANCEOF { T_INSTANCEOF } + | T_NEW { T_NEW } + | T_NULL { T_NULL } + | T_RETURN { T_RETURN } + | T_SUPER { T_SUPER } + | T_SWITCH { T_SWITCH } + | T_THIS { T_THIS } + | T_THROW { T_THROW } + | T_TRUE { T_TRUE } + | T_TRY { T_TRY } + | T_TYPEOF { T_TYPEOF } + | T_VAR { T_VAR } + | T_VOID { T_VOID } + | T_WHILE { T_WHILE } + | T_WITH { T_WITH } + | T_YIELD { T_YIELD } + (* reserved words in strict mode code. *) + | T_LET { T_LET } + | T_STATIC { T_STATIC } + +field_name: + | id { $1 } + | ident_keyword { $1 } + +method_name: + | id { $1 } + | ident_keyword { $1 } property_name: - | i=identifier_or_kw { PNI i } + | i=id { PNI i } + | i=ident_keyword { PNI i } | s=T_STRING { let s, _len = s in PNS s } | n=numeric_literal { PNN (Num.of_string_unsafe (n)) } - + | n=big_numeric_literal { PNN (Num.of_string_unsafe (n)) } + | "[" p=assignment_expr "]" { PComputed p } (*************************************************************************) -(* 1 xxx_opt, xxx_list *) +(* Misc *) (*************************************************************************) +sc: + | ";" { $1 } + | T_VIRTUAL_SEMICOLON { $1 } -elison_rev: - | T_COMMA { [] } - | elison T_COMMA { None :: $1 } - -elison: elison_rev {$1} - (* | elison_rev { List.rev $1} *) - -curly_block(X): - | T_LCURLY x=X T_RCURLY { x, ($startpos($1),$startpos($3)) } - -(*----------------------------*) -(* Infix binary operators *) -(*----------------------------*) - -%inline comparison_or_logical_or_bit_operator_except_in: - | T_LESS_THAN { Lt } - | T_GREATER_THAN { Gt } - | T_LESS_THAN_EQUAL { Le } - | T_GREATER_THAN_EQUAL { Ge } - | T_INSTANCEOF { InstanceOf } - | T_EQUAL { EqEq } - | T_NOT_EQUAL { NotEq } - | T_STRICT_EQUAL { EqEqEq } - | T_STRICT_NOT_EQUAL { NotEqEq } - | T_BIT_AND { Band } - | T_BIT_XOR { Bxor } - | T_BIT_OR { Bor } - | T_AND { And } - | T_OR { Or } - -%inline comparison_or_logical_or_bit_operator: - | op=comparison_or_logical_or_bit_operator_except_in { op } - | T_IN { In } - -%inline arithmetic_or_shift_operator: - | T_MULT { Mul } - | T_DIV { Div } - | T_MOD { Mod } - | T_PLUS { Plus } - | T_MINUS { Minus } - | T_LSHIFT { Lsl } - | T_RSHIFT { Asr } - | T_RSHIFT3 { Lsr } - -%inline prefix_operator: - | T_DELETE { Delete } - | T_VOID { Void } - | T_TYPEOF { Typeof } - | T_INCR { IncrB } - | T_INCR_NB { IncrB } - | T_DECR { DecrB } - | T_DECR_NB { DecrB } - | T_PLUS { Pl } - | T_MINUS { Neg } - | T_BIT_NOT { Bnot } - | T_NOT { Not } - -postfix_operator: - | T_INCR_NB { IncrA } - | T_DECR_NB { DecrA } - -assignment_operator: - | T_ASSIGN { Eq } - | T_MULT_ASSIGN { StarEq } - | T_DIV_ASSIGN { SlashEq } - | T_MOD_ASSIGN { ModEq } - | T_PLUS_ASSIGN { PlusEq } - | T_MINUS_ASSIGN { MinusEq } - | T_LSHIFT_ASSIGN { LslEq } - | T_RSHIFT_ASSIGN { AsrEq } - | T_RSHIFT3_ASSIGN { LsrEq } - | T_BIT_AND_ASSIGN { BandEq } - | T_BIT_XOR_ASSIGN { BxorEq } - | T_BIT_OR_ASSIGN { BorEq } - -(* Library definitions *) - -either(a, b): a { $1 } | b { $1 } - -empty: {} - -%inline parenthesised(ITEM): T_LPAREN item=ITEM T_RPAREN { item } - -separated_or_terminated_list(separator, X): - | x=X { [x] } - | x=X separator { [x] } - | x=X separator xs=separated_or_terminated_list(separator, X) { x :: xs } +elision: + | "," { [] } + | elision "," { () :: $1 } diff --git a/compiler/lib/js_simpl.ml b/compiler/lib/js_simpl.ml index 21b3fec941..536dc00bbd 100644 --- a/compiler/lib/js_simpl.ml +++ b/compiler/lib/js_simpl.ml @@ -69,17 +69,26 @@ let rec enot_rec e = J.EUn (J.Not, e), 0 | J.EBool b -> J.EBool (not b), 0 | J.ECall _ + | J.ECallTemplate _ | J.EAccess _ | J.EDot _ | J.ENew _ | J.EVar _ | J.EFun _ + | J.EArrow _ | J.EStr _ | J.EArr _ | J.ENum _ | J.EObj _ | J.ERegexp _ + | J.EYield _ + | J.ETemplate _ + | J.EAssignTarget _ + | J.EClass _ + | J.EUn (J.Await, _) | J.EUn ((J.IncrA | J.IncrB | J.DecrA | J.DecrB), _) -> J.EUn (J.Not, e), 1 + | J.CoverCallExpressionAndAsyncArrowHead _ + | J.CoverParenthesizedExpressionAndArrowParameterList _ -> assert false in if cost <= 1 then res else J.EUn (J.Not, e), 1 @@ -113,15 +122,18 @@ exception Not_assignment let rec assignment_of_statement_list l = match l with - | [ (J.Variable_statement [ (x, Some e) ], _) ] -> x, e - | (J.Expression_statement e, _) :: rem -> - let x, (e', nid) = assignment_of_statement_list rem in - x, (J.ESeq (e, e'), nid) + | [ (J.Variable_statement (Var, [ (DeclIdent _ as vd) ]), _) ] -> vd + | [ (J.Variable_statement (Var, [ (DeclPattern _ as vd) ]), _) ] -> vd + | (J.Expression_statement e, _) :: rem -> ( + match assignment_of_statement_list rem with + | DeclIdent (x, Some (e', nid)) -> DeclIdent (x, Some (J.ESeq (e, e'), nid)) + | DeclIdent (_, None) -> assert false + | DeclPattern (p, (e', nid)) -> DeclPattern (p, (J.ESeq (e, e'), nid))) | _ -> raise Not_assignment let assignment_of_statement st = match fst st with - | J.Variable_statement [ (x, Some e) ] -> x, e + | J.Variable_statement (Var, [ (DeclIdent (_, Some _) as vd) ]) -> vd | J.Block l -> assignment_of_statement_list l | _ -> raise Not_assignment @@ -136,6 +148,8 @@ let simplify_condition = function let rec depth = function | J.Block b -> depth_block b + 1 + | Function_declaration (_, (_, _, b, _)) -> depth_block b + 1 + | Class_declaration (_, cl) -> depth_class_block cl.body + 1 | Variable_statement _ -> 1 | Empty_statement -> 1 | Expression_statement _ -> 1 @@ -145,6 +159,7 @@ let rec depth = function | While_statement (_, (s, _)) -> depth s + 1 | For_statement (_, _, _, (s, _)) -> depth s + 1 | ForIn_statement (_, _, (s, _)) -> depth s + 1 + | ForOf_statement (_, _, (s, _)) -> depth s + 1 | Continue_statement _ -> 1 | Break_statement _ -> 1 | Return_statement _ -> 1 @@ -167,6 +182,13 @@ let rec depth = function and depth_block b = List.fold_left b ~init:0 ~f:(fun acc (s, _) -> max acc (depth s)) +and depth_class_block b = + List.fold_left b ~init:0 ~f:(fun acc s -> + match s with + | J.CEMethod _ -> acc + | J.CEField _ -> acc + | J.CEStaticBLock b -> depth_block b + 2) + let rec if_statement_2 e loc iftrue truestop iffalse falsestop = let e = simplify_condition e in match fst iftrue, fst iffalse with @@ -180,11 +202,21 @@ let rec if_statement_2 e loc iftrue truestop iffalse falsestop = | _ -> ( try (* Generates conditional *) - let x1, (e1, _) = assignment_of_statement iftrue in - let x2, (e2, _) = assignment_of_statement iffalse in - if Poly.(x1 <> x2) then raise Not_assignment; - let exp = if Poly.(e1 = e) then J.EBin (J.Or, e, e2) else J.ECond (e, e1, e2) in - [ J.Variable_statement [ x1, Some (exp, loc) ], loc ] + let vd1 = assignment_of_statement iftrue in + let vd2 = assignment_of_statement iffalse in + match vd1, vd2 with + | DeclIdent (x1, Some (e1, _)), DeclIdent (x2, Some (e2, _)) when Poly.(x1 = x2) + -> + let exp = + if Poly.(e1 = e) then J.EBin (J.Or, e, e2) else J.ECond (e, e1, e2) + in + [ J.Variable_statement (Var, [ DeclIdent (x1, Some (exp, loc)) ]), loc ] + | DeclPattern (p1, (e1, _)), DeclPattern (p2, (e2, _)) when Poly.(p1 = p2) -> + let exp = + if Poly.(e1 = e) then J.EBin (J.Or, e, e2) else J.ECond (e, e1, e2) + in + [ J.Variable_statement (Var, [ DeclPattern (p1, (exp, loc)) ]), loc ] + | _ -> assert false with Not_assignment -> ( try let e1 = expression_of_statement iftrue in diff --git a/compiler/lib/js_token.ml b/compiler/lib/js_token.ml index 714164a82d..4f0e56c0d5 100644 --- a/compiler/lib/js_token.ml +++ b/compiler/lib/js_token.ml @@ -27,7 +27,6 @@ type t = | T_NUMBER of (number_type * string) | T_BIGINT of (bigint_type * string) | T_STRING of (Utf8_string.t * int) - | T_TEMPLATE_PART of (Utf8_string.t * bool) | T_IDENTIFIER of (Utf8_string.t * string) | T_REGEXP of (Utf8_string.t * string) (* /pattern/flags *) @@ -91,12 +90,11 @@ type t = | T_PUBLIC | T_YIELD | T_DEBUGGER - | T_DECLARE - | T_TYPE - | T_OPAQUE | T_OF | T_ASYNC | T_AWAIT + | T_GET + | T_SET (* Operators *) | T_RSHIFT3_ASSIGN | T_RSHIFT_ASSIGN @@ -144,12 +142,19 @@ type t = | T_BIT_NOT | T_INCR | T_DECR + | T_FROM + | T_TARGET + | T_META + | T_BACKQUOTE + | T_DOLLARCURLY + | T_ENCAPSED_STRING of string (* Extra tokens *) | T_ERROR of string | T_EOF | T_VIRTUAL_SEMICOLON | T_DECR_NB | T_INCR_NB + | T_LPAREN_ARROW | TAnnot of Annot.t | TComment of string | TCommentLineDirective of string @@ -277,12 +282,14 @@ let to_string = function | T_PROTECTED -> "protected" | T_PUBLIC -> "public" | T_YIELD -> "yield" - | T_DECLARE -> "declare" - | T_TYPE -> "type" - | T_OPAQUE -> "opaque" | T_OF -> "of" | T_ASYNC -> "async" | T_AWAIT -> "await" + | T_GET -> "get" + | T_SET -> "set" + | T_FROM -> "from" + | T_TARGET -> "target" + | T_META -> "meta" | T_EXP_ASSIGN -> "**=" | T_NULLISH_ASSIGN -> "??=" | T_AND_ASSIGN -> "&&=" @@ -292,7 +299,10 @@ let to_string = function | T_EXP -> "**" | T_EOF -> "" | T_BIGINT (_, raw) -> raw - | T_TEMPLATE_PART (Utf8 s, _) -> s + | T_LPAREN_ARROW -> "(" + | T_BACKQUOTE -> "`" + | T_DOLLARCURLY -> "${" + | T_ENCAPSED_STRING s -> s let to_string_extra x = to_string x @@ -306,6 +316,8 @@ let to_string_extra x = | T_VIRTUAL_SEMICOLON -> " (virtual)" | TAnnot _ -> "(annot)" | T_ERROR _ -> "(error)" + | T_LPAREN_ARROW -> "(arrow)" + | T_ENCAPSED_STRING _ -> "(encaps)" | _ -> "" let is_keyword s = @@ -319,7 +331,6 @@ let is_keyword s = | "const" -> Some T_CONST | "continue" -> Some T_CONTINUE | "debugger" -> Some T_DEBUGGER - | "declare" -> Some T_DECLARE | "default" -> Some T_DEFAULT | "delete" -> Some T_DELETE | "do" -> Some T_DO @@ -341,7 +352,6 @@ let is_keyword s = | "new" -> Some T_NEW | "null" -> Some T_NULL | "of" -> Some T_OF - | "opaque" -> Some T_OPAQUE | "package" -> Some T_PACKAGE | "private" -> Some T_PRIVATE | "protected" -> Some T_PROTECTED @@ -354,11 +364,15 @@ let is_keyword s = | "throw" -> Some T_THROW | "true" -> Some T_TRUE | "try" -> Some T_TRY - | "type" -> Some T_TYPE | "typeof" -> Some T_TYPEOF | "var" -> Some T_VAR | "void" -> Some T_VOID | "while" -> Some T_WHILE | "with" -> Some T_WITH | "yield" -> Some T_YIELD + | "get" -> Some T_GET + | "set" -> Some T_SET + | "from" -> Some T_FROM + | "target" -> Some T_TARGET + | "meta" -> Some T_META | _ -> None diff --git a/compiler/lib/js_token.mli b/compiler/lib/js_token.mli index dd987970d8..6c6a38e62f 100644 --- a/compiler/lib/js_token.mli +++ b/compiler/lib/js_token.mli @@ -26,7 +26,6 @@ type t = | T_NUMBER of (number_type * string) | T_BIGINT of (bigint_type * string) | T_STRING of (Utf8_string.t * int) - | T_TEMPLATE_PART of (Utf8_string.t * bool) | T_IDENTIFIER of (Utf8_string.t * string) | T_REGEXP of (Utf8_string.t * string) (* /pattern/flags *) @@ -90,12 +89,11 @@ type t = | T_PUBLIC | T_YIELD | T_DEBUGGER - | T_DECLARE - | T_TYPE - | T_OPAQUE | T_OF | T_ASYNC | T_AWAIT + | T_GET + | T_SET (* Operators *) | T_RSHIFT3_ASSIGN | T_RSHIFT_ASSIGN @@ -143,12 +141,19 @@ type t = | T_BIT_NOT | T_INCR | T_DECR + | T_FROM + | T_TARGET + | T_META + | T_BACKQUOTE + | T_DOLLARCURLY + | T_ENCAPSED_STRING of string (* Extra tokens *) | T_ERROR of string | T_EOF | T_VIRTUAL_SEMICOLON | T_DECR_NB | T_INCR_NB + | T_LPAREN_ARROW | TAnnot of Annot.t | TComment of string | TCommentLineDirective of string diff --git a/compiler/lib/js_traverse.ml b/compiler/lib/js_traverse.ml index 338b262ae6..bd8d899c96 100644 --- a/compiler/lib/js_traverse.ml +++ b/compiler/lib/js_traverse.ml @@ -22,12 +22,20 @@ open Javascript class type mapper = object + method loc : Javascript.location -> Javascript.location + method expression : Javascript.expression -> Javascript.expression method expression_o : Javascript.expression option -> Javascript.expression option method switch_case : Javascript.expression -> Javascript.expression + method block : Javascript.statement_list -> Javascript.statement_list + + method fun_decl : Javascript.function_declaration -> Javascript.function_declaration + + method class_decl : Javascript.class_declaration -> Javascript.class_declaration + method initialiser : Javascript.expression * Javascript.location -> Javascript.expression * Javascript.location @@ -36,8 +44,15 @@ class type mapper = (Javascript.expression * Javascript.location) option -> (Javascript.expression * Javascript.location) option + method for_binding : + Javascript.variable_declaration_kind + -> Javascript.for_binding + -> Javascript.for_binding + method variable_declaration : - Javascript.variable_declaration -> Javascript.variable_declaration + Javascript.variable_declaration_kind + -> Javascript.variable_declaration + -> Javascript.variable_declaration method statement : Javascript.statement -> Javascript.statement @@ -47,55 +62,112 @@ class type mapper = method statements : Javascript.statement_list -> Javascript.statement_list - method source : Javascript.source_element -> Javascript.source_element - - method sources : Javascript.source_elements -> Javascript.source_elements + method formal_parameter_list : + Javascript.formal_parameter_list -> Javascript.formal_parameter_list method ident : Javascript.ident -> Javascript.ident method program : Javascript.program -> Javascript.program + + method function_body : statement_list -> statement_list end (* generic js ast walk/map *) class map : mapper = object (m) - method ident i = i + method loc i = i + + method ident i = + match i with + | V v -> V v + | S { name; var; loc } -> S { name; var; loc = m#loc loc } + + method private early_error e = e - method statements l = List.map l ~f:(fun (s, pc) -> m#statement s, pc) + method statements l = List.map l ~f:(fun (s, pc) -> m#statement s, m#loc pc) + + method variable_declaration _ x = + match x with + | DeclIdent (id, eo) -> DeclIdent (m#ident id, m#initialiser_o eo) + | DeclPattern (p, i) -> DeclPattern (m#binding_pattern p, m#initialiser i) + + method for_binding _ x = m#binding x + + method formal_parameter_list { list; rest } = + { list = List.map list ~f:m#param; rest = Option.map rest ~f:m#binding } + + method private property_name x = + match x with + | (PNI _ | PNS _ | PNN _) as x -> x + | PComputed e -> PComputed (m#expression e) + + method fun_decl (k, params, body, nid) = + k, m#formal_parameter_list params, m#function_body body, m#loc nid + + method class_decl x = + { extends = Option.map x.extends ~f:m#expression + ; body = List.map x.body ~f:m#class_element + } + + method private class_element x = + match x with + | CEMethod (s, n, meth) -> CEMethod (s, m#class_element_name n, m#method_ meth) + | CEField (s, n, i) -> CEField (s, m#class_element_name n, m#initialiser_o i) + | CEStaticBLock b -> CEStaticBLock (m#block b) + + method private class_element_name x = + match x with + | PropName n -> PropName (m#property_name n) + | PrivName x -> PrivName (m#ident x) - method variable_declaration (id, eo) = m#ident id, m#initialiser_o eo + method block l = m#statements l method statement s = match s with - | Block b -> Block (m#statements b) - | Variable_statement l -> Variable_statement (List.map l ~f:m#variable_declaration) + | Block b -> Block (m#block b) + | Variable_statement (k, l) -> + Variable_statement (k, List.map l ~f:(m#variable_declaration k)) + | Function_declaration (id, fun_decl) -> + Function_declaration (m#ident id, m#fun_decl fun_decl) + | Class_declaration (id, cl_decl) -> + Class_declaration (m#ident id, m#class_decl cl_decl) | Empty_statement -> Empty_statement | Debugger_statement -> Debugger_statement | Expression_statement e -> Expression_statement (m#expression e) | If_statement (e, (s, loc), sopt) -> - If_statement (m#expression e, (m#statement s, loc), m#statement_o sopt) + If_statement (m#expression e, (m#statement s, m#loc loc), m#statement_o sopt) | Do_while_statement ((s, loc), e) -> - Do_while_statement ((m#statement s, loc), m#expression e) + Do_while_statement ((m#statement s, m#loc loc), m#expression e) | While_statement (e, (s, loc)) -> - While_statement (m#expression e, (m#statement s, loc)) + While_statement (m#expression e, (m#statement s, m#loc loc)) | For_statement (e1, e2, e3, (s, loc)) -> let e1 = match e1 with | Left o -> Left (m#expression_o o) - | Right l -> Right (List.map l ~f:(fun d -> m#variable_declaration d)) + | Right (k, l) -> + Right (k, List.map l ~f:(fun d -> m#variable_declaration k d)) in - For_statement (e1, m#expression_o e2, m#expression_o e3, (m#statement s, loc)) + For_statement + (e1, m#expression_o e2, m#expression_o e3, (m#statement s, m#loc loc)) | ForIn_statement (e1, e2, (s, loc)) -> let e1 = match e1 with | Left e -> Left (m#expression e) - | Right d -> Right (m#variable_declaration d) + | Right (k, d) -> Right (k, m#for_binding k d) in - ForIn_statement (e1, m#expression e2, (m#statement s, loc)) + ForIn_statement (e1, m#expression e2, (m#statement s, m#loc loc)) + | ForOf_statement (e1, e2, (s, loc)) -> + let e1 = + match e1 with + | Left e -> Left (m#expression e) + | Right (k, d) -> Right (k, m#for_binding k d) + in + ForOf_statement (e1, m#expression e2, (m#statement s, m#loc loc)) | Continue_statement s -> Continue_statement s | Break_statement s -> Break_statement s | Return_statement e -> Return_statement (m#expression_o e) - | Labelled_statement (l, (s, loc)) -> Labelled_statement (l, (m#statement s, loc)) + | Labelled_statement (l, (s, loc)) -> + Labelled_statement (l, (m#statement s, m#loc loc)) | Throw_statement e -> Throw_statement (m#expression e) | Switch_statement (e, l, def, l') -> Switch_statement @@ -107,77 +179,134 @@ class map : mapper = , List.map l' ~f:(fun (e, s) -> m#switch_case e, m#statements s) ) | Try_statement (b, catch, final) -> Try_statement - ( m#statements b + ( m#block b , (match catch with | None -> None - | Some (id, b) -> Some (m#ident id, m#statements b)) + | Some (id, b) -> Some (Option.map ~f:m#param id, m#block b)) , match final with | None -> None - | Some s -> Some (m#statements s) ) + | Some s -> Some (m#block s) ) method statement_o x = match x with | None -> None - | Some (s, loc) -> Some (m#statement s, loc) + | Some (s, loc) -> Some (m#statement s, m#loc loc) method switch_case e = m#expression e + method private argument a = + match a with + | Arg e -> Arg (m#expression e) + | ArgSpread e -> ArgSpread (m#expression e) + + method private template l = + List.map l ~f:(function + | TStr s -> TStr s + | TExp e -> TExp (m#expression e)) + method expression x = match x with | ESeq (e1, e2) -> ESeq (m#expression e1, m#expression e2) | ECond (e1, e2, e3) -> ECond (m#expression e1, m#expression e2, m#expression e3) | EBin (b, e1, e2) -> EBin (b, m#expression e1, m#expression e2) + | EAssignTarget p -> EAssignTarget (m#binding_pattern p) | EUn (b, e1) -> EUn (b, m#expression e1) - | ECall (e1, e2, loc) -> - ECall - ( m#expression e1 - , List.map e2 ~f:(fun (e, spread) -> m#expression e, spread) - , loc ) - | EAccess (e1, e2) -> EAccess (m#expression e1, m#expression e2) - | EDot (e1, id) -> EDot (m#expression e1, id) - | ENew (e1, Some args) -> - ENew - ( m#expression e1 - , Some (List.map args ~f:(fun (e, spread) -> m#expression e, spread)) ) - | ENew (e1, None) -> ENew (m#expression e1, None) + | ECallTemplate (e1, t, loc) -> + ECallTemplate (m#expression e1, m#template t, m#loc loc) + | ECall (e1, ak, e2, loc) -> + ECall (m#expression e1, ak, List.map e2 ~f:m#argument, m#loc loc) + | EAccess (e1, ak, e2) -> EAccess (m#expression e1, ak, m#expression e2) + | EDot (e1, ak, id) -> EDot (m#expression e1, ak, id) + | ENew (e1, args) -> + ENew (m#expression e1, Option.map ~f:(List.map ~f:m#argument) args) | EVar v -> EVar (m#ident v) - | EFun (idopt, params, body, nid) -> - let idopt = - match idopt with - | None -> None - | Some i -> Some (m#ident i) - in - EFun (idopt, List.map params ~f:m#ident, m#sources body, nid) - | EArr l -> EArr (List.map l ~f:(fun x -> m#expression_o x)) - | EObj l -> EObj (List.map l ~f:(fun (i, e) -> i, m#expression e)) + | EFun (idopt, fun_decl) -> + let idopt = Option.map ~f:m#ident idopt in + EFun (idopt, m#fun_decl fun_decl) + | EClass (id, cl_decl) -> EClass (Option.map ~f:m#ident id, m#class_decl cl_decl) + | EArrow fun_decl -> EArrow (m#fun_decl fun_decl) + | EArr l -> + EArr + (List.map l ~f:(function + | ElementHole -> ElementHole + | Element e -> Element (m#expression e) + | ElementSpread e -> ElementSpread (m#expression e))) + | EObj l -> + EObj + (List.map l ~f:(fun p -> + match p with + | Property (i, e) -> Property (m#property_name i, m#expression e) + | PropertyMethod (n, x) -> PropertyMethod (m#property_name n, m#method_ x) + | PropertySpread e -> PropertySpread (m#expression e) + | CoverInitializedName (e, a, b) -> + CoverInitializedName (m#early_error e, a, b))) | (EStr _ as x) | (EBool _ as x) | (ENum _ as x) | (ERegexp _ as x) -> x + | ETemplate t -> ETemplate (m#template t) + | EYield e -> EYield (m#expression_o e) + | CoverParenthesizedExpressionAndArrowParameterList e -> + CoverParenthesizedExpressionAndArrowParameterList (m#early_error e) + | CoverCallExpressionAndAsyncArrowHead e -> + CoverCallExpressionAndAsyncArrowHead (m#early_error e) + + method private method_ x = + match x with + | MethodSet fun_decl -> MethodSet (m#fun_decl fun_decl) + | MethodGet fun_decl -> MethodGet (m#fun_decl fun_decl) + | Method fun_decl -> Method (m#fun_decl fun_decl) + + method private param p = m#binding_element p + + method private binding_element (b, e) = m#binding b, m#initialiser_o e + + method private binding x = + match x with + | BindingIdent x -> BindingIdent (m#ident x) + | BindingPattern x -> BindingPattern (m#binding_pattern x) + + method private binding_pattern x = + match x with + | ObjectBinding { list; rest } -> + ObjectBinding + { list = List.map list ~f:m#binding_property + ; rest = Option.map rest ~f:m#ident + } + | ArrayBinding { list; rest } -> + ArrayBinding + { list = List.map list ~f:m#binding_array_elt + ; rest = Option.map rest ~f:m#binding + } + + method private binding_array_elt x = + match x with + | None -> None + | Some (b, e) -> Some (m#binding b, m#initialiser_o e) + + method private binding_property x = + match x with + | Prop_binding (i, e) -> Prop_binding (m#property_name i, m#binding_element e) + | Prop_ident (i, e) -> Prop_ident (m#ident i, m#initialiser_o e) method expression_o x = match x with | None -> None | Some s -> Some (m#expression s) - method initialiser (e, pc) = m#expression e, pc + method initialiser (e, loc) = m#expression e, m#loc loc method initialiser_o x = match x with | None -> None | Some i -> Some (m#initialiser i) - method source x = - match x with - | Statement s -> Statement (m#statement s) - | Function_declaration (id, params, body, nid) -> - Function_declaration - (m#ident id, List.map params ~f:m#ident, m#sources body, nid) - - method sources x = List.map x ~f:(fun (s, loc) -> m#source s, loc) + method program x = m#statements x - method program x = m#sources x + method function_body x = m#statements x end class type iterator = object + method early_error : Javascript.early_error -> unit + method expression : Javascript.expression -> unit method expression_o : Javascript.expression option -> unit @@ -188,7 +317,11 @@ class type iterator = method initialiser_o : (Javascript.expression * Javascript.location) option -> unit - method variable_declaration : Javascript.variable_declaration -> unit + method for_binding : + Javascript.variable_declaration_kind -> Javascript.for_binding -> unit + + method variable_declaration : + Javascript.variable_declaration_kind -> Javascript.variable_declaration -> unit method statement : Javascript.statement -> unit @@ -196,13 +329,11 @@ class type iterator = method statements : Javascript.statement_list -> unit - method source : Javascript.source_element -> unit - - method sources : Javascript.source_elements -> unit - method ident : Javascript.ident -> unit method program : Javascript.program -> unit + + method function_body : Javascript.statement_list -> unit end (* generic js ast iterator *) @@ -210,16 +341,63 @@ class iter : iterator = object (m) method ident _ = () + method early_error _ = () + method statements l = List.iter l ~f:(fun (s, _) -> m#statement s) - method variable_declaration (id, eo) = - m#ident id; - m#initialiser_o eo + method variable_declaration _ x = + match x with + | DeclIdent (id, eo) -> + m#ident id; + m#initialiser_o eo + | DeclPattern (p, (e, (_ : location))) -> + m#binding_pattern p; + m#expression e + + method for_binding _ x = m#binding x + + method private formal_parameter_list { list; rest } = + List.iter list ~f:m#param; + Option.iter rest ~f:m#binding + + method private property_name x = + match x with + | PNI _ | PNS _ | PNN _ -> () + | PComputed e -> m#expression e + + method private fun_decl (_k, params, body, _loc) = + m#formal_parameter_list params; + m#function_body body + + method private class_decl x = + Option.iter x.extends ~f:m#expression; + List.iter x.body ~f:m#class_element + + method private class_element x = + match x with + | CEMethod (_static, name, x) -> + m#class_element_name name; + m#method_ x + | CEField (_static, n, i) -> + m#class_element_name n; + m#initialiser_o i + | CEStaticBLock b -> m#statements b + + method private class_element_name x = + match x with + | PropName n -> m#property_name n + | PrivName x -> m#ident x method statement s = match s with | Block b -> m#statements b - | Variable_statement l -> List.iter l ~f:m#variable_declaration + | Variable_statement (k, l) -> List.iter l ~f:(m#variable_declaration k) + | Function_declaration (id, fun_decl) -> + m#ident id; + m#fun_decl fun_decl + | Class_declaration (id, cl_decl) -> + m#ident id; + m#class_decl cl_decl | Empty_statement -> () | Debugger_statement -> () | Expression_statement e -> m#expression e @@ -236,14 +414,21 @@ class iter : iterator = | For_statement (e1, e2, e3, (s, _)) -> (match e1 with | Left o -> m#expression_o o - | Right l -> List.iter l ~f:(fun d -> m#variable_declaration d)); + | Right (k, l) -> List.iter l ~f:(fun d -> m#variable_declaration k d)); m#expression_o e2; m#expression_o e3; m#statement s | ForIn_statement (e1, e2, (s, _)) -> (match e1 with | Left e -> m#expression e - | Right d -> m#variable_declaration d); + | Right (k, d) -> m#for_binding k d); + + m#expression e2; + m#statement s + | ForOf_statement (e1, e2, (s, _)) -> + (match e1 with + | Left e -> m#expression e + | Right (k, d) -> m#for_binding k d); m#expression e2; m#statement s @@ -268,7 +453,7 @@ class iter : iterator = (match catch with | None -> () | Some (id, b) -> - m#ident id; + Option.iter ~f:m#param id; m#statements b); match final with | None -> () @@ -281,6 +466,16 @@ class iter : iterator = method switch_case e = m#expression e + method private argument a = + match a with + | Arg e -> m#expression e + | ArgSpread e -> m#expression e + + method private template l = + List.iter l ~f:(function + | TStr _ -> () + | TExp e -> m#expression e) + method expression x = match x with | ESeq (e1, e2) -> @@ -293,28 +488,93 @@ class iter : iterator = | EBin (_, e1, e2) -> m#expression e1; m#expression e2 + | EAssignTarget p -> m#binding_pattern p | EUn (_, e1) -> m#expression e1 - | ECall (e1, e2, _) -> + | ECall (e1, _ak, e2, _) -> + m#expression e1; + List.iter e2 ~f:m#argument + | ECallTemplate (e1, a, _) -> m#expression e1; - List.iter e2 ~f:(fun (e, _) -> m#expression e) - | EAccess (e1, e2) -> + m#template a + | EAccess (e1, _ak, e2) -> m#expression e1; m#expression e2 - | EDot (e1, _) -> m#expression e1 + | EDot (e1, _ak, _) -> m#expression e1 | ENew (e1, Some args) -> m#expression e1; - List.iter args ~f:(fun (e, _) -> m#expression e) + List.iter args ~f:m#argument | ENew (e1, None) -> m#expression e1 | EVar v -> m#ident v - | EFun (idopt, params, body, _) -> + | EFun (idopt, fun_decl) -> (match idopt with | None -> () | Some i -> m#ident i); - List.iter params ~f:m#ident; - m#sources body - | EArr l -> List.iter l ~f:(fun x -> m#expression_o x) - | EObj l -> List.iter l ~f:(fun (_, e) -> m#expression e) + m#fun_decl fun_decl + | EClass (i, cl_decl) -> + Option.iter ~f:m#ident i; + m#class_decl cl_decl + | EArrow fun_decl -> m#fun_decl fun_decl + | EArr l -> + List.iter l ~f:(function + | ElementHole -> () + | Element e -> m#expression e + | ElementSpread e -> m#expression e) + | EObj l -> + List.iter l ~f:(fun p -> + match p with + | Property (i, e) -> + m#property_name i; + m#expression e + | PropertyMethod (n, x) -> + m#property_name n; + m#method_ x + | PropertySpread e -> m#expression e + | CoverInitializedName (e, _, _) -> m#early_error e) | EStr _ | EBool _ | ENum _ | ERegexp _ -> () + | ETemplate l -> m#template l + | EYield e -> m#expression_o e + | CoverParenthesizedExpressionAndArrowParameterList e -> m#early_error e + | CoverCallExpressionAndAsyncArrowHead e -> m#early_error e + + method private method_ x = + match x with + | MethodSet fun_decl -> m#fun_decl fun_decl + | MethodGet fun_decl -> m#fun_decl fun_decl + | Method fun_decl -> m#fun_decl fun_decl + + method private param p = m#binding_element p + + method private binding_element (b, e) = + m#binding b; + m#initialiser_o e + + method private binding x = + match x with + | BindingIdent x -> m#ident x + | BindingPattern x -> m#binding_pattern x + + method private binding_pattern x = + match x with + | ObjectBinding { list; rest } -> + List.iter list ~f:m#binding_property; + Option.iter rest ~f:m#ident + | ArrayBinding { list; rest } -> + List.iter list ~f:m#binding_array_elt; + Option.iter rest ~f:m#binding + + method private binding_array_elt x = + match x with + | None -> () + | Some (b, e) -> + m#binding b; + m#initialiser_o e + + method private binding_property x = + match x with + | Prop_binding ((_ : property_name), e) -> m#binding_element e + | Prop_ident (i, e) -> + m#ident i; + m#initialiser_o e method expression_o x = match x with @@ -328,17 +588,9 @@ class iter : iterator = | None -> () | Some i -> m#initialiser i - method source x = - match x with - | Statement s -> m#statement s - | Function_declaration (id, params, body, _) -> - m#ident id; - List.iter params ~f:m#ident; - m#sources body + method program x = m#statements x - method sources x = List.iter x ~f:(fun (s, _) -> m#source s) - - method program x = m#sources x + method function_body x = m#statements x end (* var substitution *) @@ -366,7 +618,8 @@ class map_for_share_constant = of 'require' is not a literal *) | ECall ( EVar (S { var = None; name = Utf8 "requires"; _ }) - , [ (EStr _, `Not_spread) ] + , (ANormal | ANullish) + , [ Arg (EStr _) ] , _ ) -> e | _ -> super#expression e @@ -376,12 +629,12 @@ class map_for_share_constant = | ENum _ | EStr _ -> e | _ -> m#expression e - method sources l = + method statements l = match l with | [] -> [] - | ((Statement (Expression_statement (EStr _)), _) as prolog) :: rest -> - prolog :: List.map rest ~f:(fun (x, loc) -> m#source x, loc) - | rest -> List.map rest ~f:(fun (x, loc) -> m#source x, loc) + | ((Expression_statement (EStr _), _) as prolog) :: rest -> + prolog :: List.map rest ~f:(fun (x, loc) -> m#statement x, loc) + | rest -> List.map rest ~f:(fun (x, loc) -> m#statement x, loc) end class replace_expr f = @@ -437,31 +690,26 @@ class share_constant = else let f = Hashtbl.find all in let p = (new replace_expr f)#program p in - let all = Hashtbl.fold (fun e v acc -> (v, Some (e, N)) :: acc) all [] in - (Statement (Variable_statement all), N) :: p + let all = + Hashtbl.fold (fun e v acc -> DeclIdent (v, Some (e, N)) :: acc) all [] + in + (Variable_statement (Var, all), N) :: p end -module S = Code.Var.Set - type t = - { use_name : Utf8_string_set.t - ; def_name : Utf8_string_set.t - ; def : S.t - ; use : S.t + { use : IdentSet.t + ; def_var : IdentSet.t + ; def_local : IdentSet.t } -let empty = - { def = S.empty - ; use = S.empty - ; use_name = Utf8_string_set.empty - ; def_name = Utf8_string_set.empty - } +let empty = { use = IdentSet.empty; def_var = IdentSet.empty; def_local = IdentSet.empty } (* def/used/free variable *) type block = - | Catch of ident - | Params of ident list + | Catch of formal_parameter + | Params of formal_parameter_list + | Normal class type freevar = object ('a) @@ -469,27 +717,25 @@ class type freevar = method merge_info : 'a -> unit - method block : block -> unit + method merge_block_info : 'a -> unit + + method record_block : block -> unit method state : t method def_var : Javascript.ident -> unit + method def_local : Javascript.ident -> unit + method use_var : Javascript.ident -> unit method get_count : int Javascript.IdentMap.t - method get_free_name : Utf8_string_set.t - - method get_free : Code.Var.Set.t - - method get_def_name : Utf8_string_set.t - - method get_def : Code.Var.Set.t + method get_free : IdentSet.t - method get_use_name : Utf8_string_set.t + method get_def : IdentSet.t - method get_use : Code.Var.Set.t + method get_use : IdentSet.t end class free = @@ -506,126 +752,204 @@ class free = method get_count = !count - method get_free = S.diff m#state.use m#state.def + method get_free = + IdentSet.diff m#state.use (IdentSet.union m#state.def_var m#state.def_local) - method get_def = m#state.def - - method get_free_name = Utf8_string_set.diff m#state.use_name m#state.def_name - - method get_def_name = m#state.def_name - - method get_use_name = m#state.use_name + method get_def = IdentSet.union m#state.def_var m#state.def_local method get_use = m#state.use method merge_info from = - let free_name = from#get_free_name in let free = from#get_free in + state_ <- { state_ with use = IdentSet.union state_.use free } + + method merge_block_info from = + let use = + let state = from#state in + IdentSet.diff state.use state.def_local + in + let def_var = from#state.def_var in state_ <- - { state_ with - use_name = Utf8_string_set.union state_.use_name free_name - ; use = S.union state_.use free + { use = IdentSet.union state_.use use + ; def_var = IdentSet.union state_.def_var def_var + ; def_local = state_.def_local } method use_var x = let n = try IdentMap.find x !count with Not_found -> 0 in count := IdentMap.add x (succ n) !count; - match x with - | S { name; _ } -> - state_ <- { state_ with use_name = Utf8_string_set.add name state_.use_name } - | V v -> state_ <- { state_ with use = S.add v state_.use } + state_ <- { state_ with use = IdentSet.add x state_.use } method def_var x = let n = try IdentMap.find x !count with Not_found -> 0 in count := IdentMap.add x (succ n) !count; - match x with - | S { name; _ } -> - state_ <- { state_ with def_name = Utf8_string_set.add name state_.def_name } - | V v -> state_ <- { state_ with def = S.add v state_.def } + state_ <- { state_ with def_var = IdentSet.add x state_.def_var } + + method def_local x = + let n = try IdentMap.find x !count with Not_found -> 0 in + count := IdentMap.add x (succ n) !count; + state_ <- { state_ with def_local = IdentSet.add x state_.def_local } + + method fun_decl (k, params, body, nid) = + let tbody = ({} :> 'test) in + let ids = bound_idents_of_params params in + List.iter ids ~f:tbody#def_var; + let body = tbody#function_body body in + tbody#record_block (Params params); + m#merge_info tbody; + k, params, body, nid method expression x = match x with | EVar v -> m#use_var v; x - | EFun (ident, params, body, nid) -> + | EFun (ident, (k, params, body, nid)) -> let tbody = ({} :> 'test) in - let () = List.iter params ~f:tbody#def_var in - let body = tbody#sources body in + let ids = bound_idents_of_params params in + List.iter ids ~f:tbody#def_var; + let body = tbody#function_body body in let ident = match ident with - | Some (V v) when not (S.mem v tbody#state.use) -> None - | Some (S { name; _ }) - when not (Utf8_string_set.mem name tbody#state.use_name) -> None - | Some id -> - tbody#def_var id; - ident + | Some i -> + if IdentSet.mem i tbody#state.use + then ( + tbody#def_var i; + ident) + else None | None -> None in - tbody#block (Params params); + tbody#record_block (Params params); m#merge_info tbody; - EFun (ident, params, body, nid) + EFun (ident, (k, params, body, nid)) | _ -> super#expression x - method source x = - match x with - | Function_declaration (id, params, body, nid) -> - let tbody = {} in - let () = List.iter params ~f:tbody#def_var in - let body = tbody#sources body in - tbody#block (Params params); - m#def_var id; - m#merge_info tbody; - Function_declaration (id, params, body, nid) - | Statement _ -> super#source x + method record_block _ = () - method block _ = () + method variable_declaration k x = + let ids = bound_idents_of_variable_declaration x in + (match k with + | Let | Const -> List.iter ids ~f:m#def_local + | Var -> List.iter ids ~f:m#def_var); + super#variable_declaration k x - method variable_declaration ((id, _) as d) = - m#def_var id; - super#variable_declaration d + method block b = + let same_level = level in + let tbody = {} in + let b = tbody#statements b in + tbody#record_block Normal; + m#merge_block_info tbody; + b method statement x = match x with + | Function_declaration (id, (k, params, body, nid)) -> + let tbody = {} in + let ids = bound_idents_of_params params in + List.iter ids ~f:tbody#def_var; + let body = tbody#function_body body in + tbody#record_block (Params params); + m#def_var id; + m#merge_info tbody; + Function_declaration (id, (k, params, body, nid)) + | Block b -> Block (m#block b) | Try_statement (b, w, f) -> - let b = m#statements b in let same_level = level in - let tbody = {} in + let b = m#block b in let w = match w with | None -> None - | Some (id, block) -> - let block = tbody#statements block in - tbody#block (Catch id); + | Some (None, b) -> Some (None, m#block b) + | Some (Some id, block) -> + let tw = {} in + let block = tw#statements block in + tw#record_block (Catch id); (* special merge here *) (* we need to propagate both def and use .. *) (* .. except the use of 'id' since its scope is limited to 'block' *) - let clean set sets = - match id with - | S { name; _ } -> set, Utf8_string_set.remove name sets - | V i -> S.remove i set, sets + let ids = bound_idents_of_binding (fst id) in + let clean set = + List.fold_left ids ~init:set ~f:(fun set id -> IdentSet.remove id set) in - let def, def_name = tbody#state.def, tbody#state.def_name in - let use, use_name = clean tbody#state.use tbody#state.use_name in + let def_var = tw#state.def_var in + let use = clean (IdentSet.diff tw#state.use tw#state.def_local) in state_ <- - { use = S.union state_.use use - ; use_name = Utf8_string_set.union state_.use_name use_name - ; def = S.union state_.def def - ; def_name = Utf8_string_set.union state_.def_name def_name + { use = IdentSet.union state_.use use + ; def_var = IdentSet.union state_.def_var def_var + ; def_local = state_.def_local }; - Some (id, block) + Some (Some id, block) in let f = match f with | None -> None - | Some block -> Some (m#statements block) + | Some f -> Some (m#block f) in Try_statement (b, w, f) | _ -> super#statement x + + method for_binding k x = + (match x with + | BindingIdent x -> ( + match k with + | Let | Const -> m#def_local x + | Var -> m#def_var x) + | BindingPattern x -> ( + let ids = bound_idents_of_pattern x in + match k with + | Let | Const -> List.iter ids ~f:m#def_local + | Var -> List.iter ids ~f:m#def_var)); + super#for_binding k x end class rename_variable = + let declared local_only ident params body = + let declared_names = ref StringSet.empty in + let decl_var x = + match x with + | S { name = Utf8 name; _ } -> declared_names := StringSet.add name !declared_names + | _ -> () + in + Option.iter ~f:decl_var ident; + List.iter params ~f:(fun x -> decl_var x); + (object + inherit iter as super + + method expression _ = () + + method statement x = + match x with + | Function_declaration (id, _) -> if not local_only then decl_var id + | _ -> super#statement x + + method variable_declaration k l = + if (not local_only) + || + match k with + | Let | Const -> true + | Var -> false + then + let ids = bound_idents_of_variable_declaration l in + List.iter ids ~f:decl_var + + method for_binding k p = + if (not local_only) + || + match k with + | Let | Const -> true + | Var -> false + then + match p with + | BindingIdent i -> decl_var i + | BindingPattern p -> + let ids = bound_idents_of_pattern p in + List.iter ids ~f:decl_var + end) + #statements + body; + !declared_names + in object (m) inherit map as super @@ -633,35 +957,13 @@ class rename_variable = val decl = StringSet.empty - method private update_state ident params body = - let declared_names = ref StringSet.empty in - let decl_var x = - match x with - | S { name = Utf8 name; _ } -> - declared_names := StringSet.add name !declared_names - | _ -> () - in - Option.iter ~f:decl_var ident; - List.iter ~f:decl_var params; - (object - inherit iter as super - - method expression _ = () - - method source x = - match x with - | Function_declaration (id, _, _, _) -> decl_var id - | Statement _ -> super#source x - - method variable_declaration (id, _) = decl_var id - end) - #sources - body; + method private update_state local_only ident params iter_body = + let declared_names = declared local_only ident params iter_body in { StringMap.add name (Code.Var.fresh_n name) subst) - !declared_names + declared_names subst - ; decl = !declared_names>} + ; decl = declared_names>} method ident x = match x with @@ -669,41 +971,77 @@ class rename_variable = | S { name = Utf8 name; _ } -> ( try V (StringMap.find name subst) with Not_found -> x) + method fun_decl (k, params, body, nid) = + let ids = bound_idents_of_params params in + let m' = m#update_state false None ids body in + k, m'#formal_parameter_list params, m'#function_body body, m#loc nid + + method program p = + let m' = m#update_state true None [] p in + m'#statements p + method expression e = match e with - | EFun (ident, params, body, nid) -> - let m' = m#update_state ident params body in + | EFun (ident, (k, params, body, nid)) -> + let ids = bound_idents_of_params params in + let m' = m#update_state false ident ids body in EFun ( Option.map ident ~f:m'#ident - , List.map params ~f:m'#ident - , m'#sources body - , nid ) + , (k, m'#formal_parameter_list params, m'#function_body body, m#loc nid) ) | _ -> super#expression e method statement s = match s with - | Try_statement (b, Some ((S { name = Utf8 name; _ } as id), block), final) - when not (StringSet.mem name decl) -> - (* If [name] is declared in [block] but not outside, then - we cannot replace [id] by a fresh variable. As a fast - approximation, we only use a fresh variable when [name] - is not declared. *) - Try_statement - ( m#statements b - , (let m' = {} in - Some (m'#ident id, m'#statements block)) - , match final with - | None -> None - | Some s -> Some (m#statements s) ) - | _ -> super#statement s - - method source s = - match s with - | Function_declaration (id, params, body, nid) -> - let m' = m#update_state None params body in + | Function_declaration (id, (k, params, body, nid)) -> + let ids = bound_idents_of_params params in + let m' = m#update_state false None ids body in Function_declaration - (m#ident id, List.map params ~f:m'#ident, m'#sources body, nid) - | _ -> super#source s + ( m#ident id + , (k, m'#formal_parameter_list params, m'#function_body body, m#loc nid) ) + | Block l -> + let m' = m#update_state true None [] l in + Block (m'#statements l) + | Try_statement (block, catch, final) -> + let block = + let m' = m#update_state true None [] block in + m'#statements block + in + let final = + match final with + | None -> None + | Some final -> + let m' = m#update_state true None [] final in + Some (m'#statements final) + in + let catch = + match catch with + | None -> None + | Some (i, catch) -> + let i, l = + match i with + | None -> None, [] + | Some ((pat, _) as p) -> + let ids = bound_idents_of_binding pat in + let l = + List.filter ids ~f:(function + | S { name = Utf8 name; _ } -> not (StringSet.mem name decl) + | V _ -> false) + in + Some p, l + in + let m' = m#update_state true None l catch in + let i = + match i with + | None -> None + | Some i -> ( + match m'#formal_parameter_list (list [ i ]) with + | { list = [ i ]; rest = None } -> Some i + | _ -> assert false) + in + Some (i, m'#statements catch) + in + Try_statement (block, catch, final) + | _ -> super#statement s end class compact_vardecl = @@ -717,10 +1055,12 @@ class compact_vardecl = method exc = exc_ method private translate l = - List.filter_map l ~f:(fun (id, eopt) -> - match eopt with - | None -> None - | Some (e, _) -> Some (EBin (Eq, EVar id, e))) + List.filter_map l ~f:(function + | DeclPattern _ -> None + | DeclIdent (id, eopt) -> ( + match eopt with + | None -> None + | Some (e, _) -> Some (EBin (Eq, EVar id, e)))) method private translate_st l = let l = m#translate l in @@ -735,42 +1075,46 @@ class compact_vardecl = | [] -> None | x :: l -> Some (List.fold_left l ~init:x ~f:(fun acc e -> ESeq (acc, e))) - method private except e = exc_ <- IdentSet.add e exc_ + method private except_ids l = + exc_ <- List.fold_left l ~init:exc_ ~f:(fun acc s -> IdentSet.add s acc) + + method private except_ident e = exc_ <- IdentSet.add e exc_ method statement s = let s = super#statement s in match s with - | Variable_statement l -> m#translate_st l - | For_statement (Right l, e2, e3, s) -> + | Function_declaration (id, fun_decl) -> + let fun_decl = m#fun_decl fun_decl in + m#except_ident id; + Function_declaration (id, fun_decl) + | Variable_statement (_, l) -> m#translate_st l + | For_statement (Right (Var, l), e2, e3, s) -> For_statement (Left (m#translate_ex l), e2, e3, s) - | ForIn_statement (Right (id, op), e2, s) -> - (match op with - | Some _ -> assert false - | None -> ()); - ForIn_statement (Left (EVar id), e2, s) | Try_statement (b, w, f) -> (match w with | None -> () - | Some (id, _) -> m#except id); + | Some (None, _) -> () + | Some (Some (id, _), _) -> + let ids = bound_idents_of_binding id in + m#except_ids ids); Try_statement (b, w, f) | s -> s - method block block = + method record_block block = (match block with - | Catch e -> m#except e - | Params p -> List.iter p ~f:m#except); - super#block block + | Catch (id, _) -> + let ids = bound_idents_of_binding id in + m#except_ids ids + | Params p -> + let s = bound_idents_of_params p in + m#except_ids s + | Normal -> ()); + super#record_block block method merge_info from = super#merge_info from; let all = - S.fold (fun e acc -> IdentSet.add (V e) acc) from#state.def IdentSet.empty - in - let all = - Utf8_string_set.fold - (fun e acc -> IdentSet.add (ident e) acc) - from#state.def_name - all + IdentSet.fold (fun e acc -> IdentSet.add e acc) from#state.def_var IdentSet.empty in insert_ <- IdentSet.diff all from#exc @@ -781,60 +1125,53 @@ class compact_vardecl = in loop x - method private pack all sources = + method private pack (all : IdentSet.t) sources = let may_flush rem vars s instr = if List.is_empty vars then rem, [], s :: instr - else rem, [], s :: (Statement (Variable_statement (List.rev vars)), N) :: instr + else rem, [], s :: (Variable_statement (Var, List.rev vars), N) :: instr in let rem, vars, instr = List.fold_left sources ~init:(all, [], []) ~f:(fun (rem, vars, instr) (s, loc) -> match s with - | Statement (Expression_statement e) -> + | Expression_statement e -> let l = m#split e in List.fold_left l ~init:(rem, vars, instr) ~f:(fun (rem, vars, instr) e -> match e with | EBin (Eq, EVar id, exp) when IdentSet.mem id rem -> - IdentSet.remove id rem, (id, Some (exp, N)) :: vars, instr - | x -> - may_flush rem vars (Statement (Expression_statement x), N) instr) - | Statement _ as s -> may_flush rem vars (s, loc) instr - | Function_declaration _ as x -> rem, vars, (x, loc) :: instr) + ( IdentSet.remove id rem + , DeclIdent (id, Some (exp, N)) :: vars + , instr ) + | x -> may_flush rem vars (Expression_statement x, N) instr) + | Function_declaration _ as x -> rem, vars, (x, loc) :: instr + | _ as s -> may_flush rem vars (s, loc) instr) in let instr = match vars with | [] -> List.rev instr | d -> - let d = Statement (Variable_statement (List.rev d)) in + let d = Variable_statement (Var, List.rev d) in List.rev ((d, N) :: instr) in - let l = IdentSet.fold (fun x acc -> (x, None) :: acc) rem [] in + let l = IdentSet.fold (fun x acc -> DeclIdent (x, None) :: acc) rem [] in match l, instr with | [], _ -> instr - | l, (Statement (Variable_statement l'), loc) :: rest -> - (Statement (Variable_statement (List.rev_append l l')), loc) :: rest - | l, _ -> (Statement (Variable_statement l), N) :: instr + | l, (Variable_statement (Var, l'), loc) :: rest -> + (Variable_statement (Var, List.rev_append l l'), loc) :: rest + | l, _ -> (Variable_statement (Var, l), N) :: instr - method source x = - let x = super#source x in - match x with - | Function_declaration (id, params, body, nid) -> - let all = IdentSet.diff insert_ exc_ in - let body = m#pack all body in - m#except id; - Function_declaration (id, params, body, nid) - | Statement _ -> x + method fun_decl (k, params, body, nid) = + let all = IdentSet.diff insert_ exc_ in + let body = m#pack all body in + k, params, body, nid method expression x = let x = super#expression x in match x with - | EFun (ident, params, body, nid) -> - let all = IdentSet.diff insert_ exc_ in - let body = m#pack all body in - (match ident with - | Some id -> m#except id - | None -> ()); - EFun (ident, params, body, nid) + | EFun (ident, fun_decl) -> + let fun_decl = m#fun_decl fun_decl in + Option.iter ~f:m#except_ident ident; + EFun (ident, fun_decl) | _ -> x method statements l = @@ -861,47 +1198,42 @@ class compact_vardecl = body end +(* - Group variable_statement together *) +(* - Remove unnecessary block *) class clean = - object (m) + object (_m) inherit map as super method statements l = - let rev_append_st x l = - match x with - | Block b, _ -> List.rev_append b l - | x -> x :: l - in let l = super#statements l in - let vars_rev, vars_loc, instr_rev = - List.fold_left - l - ~init:([], N, []) - ~f:(fun (vars_rev, vars_loc, instr_rev) (x, loc) -> - match x with - | Variable_statement l when Config.Flag.compact () -> - let vars_loc = - match vars_loc with - | Pi _ as x -> x - | _ -> loc - in - List.rev_append l vars_rev, vars_loc, instr_rev - | Empty_statement | Expression_statement (EVar _) -> - vars_rev, vars_loc, instr_rev - | _ when List.is_empty vars_rev -> - [], vars_loc, rev_append_st (x, loc) instr_rev - | _ -> - ( [] - , vars_loc - , rev_append_st - (x, loc) - ((Variable_statement (List.rev vars_rev), vars_loc) :: instr_rev) )) - in - let instr_rev = - match vars_rev with - | [] -> instr_rev - | vars_rev -> (Variable_statement (List.rev vars_rev), vars_loc) :: instr_rev - in - List.rev instr_rev + List.filter l ~f:(function + | (Empty_statement | Expression_statement (EVar _)), _ -> false + | _ -> true) + |> List.group ~f:(fun (x, _) (prev, _) -> + match prev, x with + | Variable_statement (k1, _), Variable_statement (k2, _) when Poly.(k1 = k2) + -> true + | _, _ -> false) + |> List.map ~f:(function + | (Variable_statement (k1, _), _) :: _ as l -> + let loc = + List.find_map l ~f:(fun (_, loc) -> + match loc with + | N | U -> None + | Pi _ -> Some loc) + |> function + | None -> N + | Some x -> x + in + + ( Variable_statement + ( k1 + , List.concat_map l ~f:(function + | Variable_statement (_, l), _ -> l + | _ -> assert false) ) + , loc ) + | [ x ] -> x + | [] | _ :: _ :: _ -> assert false) method statement s = let s = super#statement s in @@ -922,30 +1254,9 @@ class clean = | While_statement (cond, st) -> While_statement (cond, b st) | For_statement (p1, p2, p3, st) -> For_statement (p1, p2, p3, b st) | ForIn_statement (param, e, st) -> ForIn_statement (param, e, b st) + | ForOf_statement (param, e, st) -> ForOf_statement (param, e, b st) | Switch_statement (e, l, Some [], []) -> Switch_statement (e, l, None, []) | s -> s - - method sources l = - let append_st st_rev sources_rev = - let st = m#statements (List.rev st_rev) in - let st = List.map st ~f:(fun (s, loc) -> Statement s, loc) in - List.rev_append st sources_rev - in - let st_rev, sources_rev = - List.fold_left l ~init:([], []) ~f:(fun (st_rev, sources_rev) (x, loc) -> - match x with - | Statement s -> (s, loc) :: st_rev, sources_rev - | Function_declaration _ as x when List.is_empty st_rev -> - [], (m#source x, loc) :: sources_rev - | Function_declaration _ as x -> - [], (m#source x, loc) :: append_st st_rev sources_rev) - in - let sources_rev = - match st_rev with - | [] -> sources_rev - | st_rev -> append_st st_rev sources_rev - in - List.rev sources_rev end let translate_assign_op = function @@ -960,6 +1271,10 @@ let translate_assign_op = function | Mul -> StarEq | Plus -> PlusEq | Minus -> MinusEq + | And -> AndEq + | Or -> OrEq + | Exp -> ExpEq + | Coalesce -> CoalesceEq | _ -> assert false let is_one = function @@ -984,7 +1299,12 @@ let assign_op = function | false, false -> None | true, _ -> Some (EBin (StarEq, exp, exp'')) | _, true -> Some (EBin (StarEq, exp, exp'))) - | exp, EBin (((Div | Mod | Lsl | Asr | Lsr | Band | Bxor | Bor) as unop), exp', y) + | ( exp + , EBin + ( ((Div | Mod | Lsl | Asr | Lsr | Band | Bxor | Bor | And | Or | Exp | Coalesce) + as unop) + , exp' + , y ) ) when Poly.(exp = exp') -> Some (EBin (translate_assign_op unop, exp, y)) | _ -> None @@ -993,6 +1313,11 @@ let opt_cons b l = | Some b -> b :: l | None -> l +(* - Split variable_statement *) +(* - rewrite assign_op *) +(* - rewrite function_expression into function_declaration *) +(* - if simplification *) +(* - arithmetic simplification *) class simpl = object (m) inherit map as super @@ -1017,7 +1342,7 @@ class simpl = | ENum n, _ when Num.is_neg n -> EBin (Plus, e1, ENum (Num.neg n)) | (ENum _ as x), ENum zero when is_zero zero -> x | _ -> e) - | _ -> e + | e -> e method statement s = let s = super#statement s in @@ -1025,6 +1350,22 @@ class simpl = | Block [ x ] -> fst x | _ -> s + method program p = m#statements_top (m#statements p) + + method function_body b = m#statements_top (m#statements b) + + method private statements_top l = + (* In strict mode, functions inside blocks are scoped to that + block. Prior to ES2015, block-level functions were forbidden + in strict mode. *) + List.map l ~f:(function s, loc -> + (match s with + | Variable_statement + ((Var | Let | Const), [ DeclIdent (addr, Some (EFun (None, decl), loc)) ]) + -> Function_declaration (addr, decl), loc + | Variable_statement ((Var | Let | Const), ([] | _ :: _ :: _)) -> assert false + | s -> s, loc)) + method statements s = let s = super#statements s in List.fold_right s ~init:[] ~f:(fun (st, loc) rem -> @@ -1040,43 +1381,16 @@ class simpl = , Some (Expression_statement (EBin (Eq, v2, e2)), _) ) when Poly.(v1 = v2) -> (Expression_statement (EBin (Eq, v1, ECond (cond, e1, e2))), loc) :: rem - | Variable_statement l1 -> + | Variable_statement ((Var as k), l1) -> let x = List.map l1 ~f:(function - | ident, None -> Variable_statement [ ident, None ], loc - | ident, Some (exp, pc) -> ( + | DeclPattern _ as d -> Variable_statement (k, [ d ]), loc + | DeclIdent (_, None) as d -> Variable_statement (k, [ d ]), loc + | DeclIdent (ident, Some (exp, _)) as d -> ( match assign_op (EVar ident, exp) with | Some e -> Expression_statement e, loc - | None -> Variable_statement [ ident, Some (exp, pc) ], loc)) + | None -> Variable_statement (k, [ d ]), loc)) in x @ rem | _ -> (st, loc) :: rem) - - method sources l = - let append_st st_rev sources_rev = - let st = m#statements (List.rev st_rev) in - let st = - List.map st ~f:(function - | ( Variable_statement - [ (addr, Some (EFun (None, params, body, loc'), loc)) ] - , _ ) -> Function_declaration (addr, params, body, loc'), loc - | s, loc -> Statement s, loc) - in - List.rev_append st sources_rev - in - let st_rev, sources_rev = - List.fold_left l ~init:([], []) ~f:(fun (st_rev, sources_rev) x -> - match x with - | Statement s, loc -> (s, loc) :: st_rev, sources_rev - | (Function_declaration _ as x), loc when List.is_empty st_rev -> - [], (m#source x, loc) :: sources_rev - | (Function_declaration _ as x), loc -> - [], (m#source x, loc) :: append_st st_rev sources_rev) - in - let sources_rev = - match st_rev with - | [] -> sources_rev - | st_rev -> append_st st_rev sources_rev - in - List.rev sources_rev end diff --git a/compiler/lib/js_traverse.mli b/compiler/lib/js_traverse.mli index 57978fca7b..b120ca33d8 100644 --- a/compiler/lib/js_traverse.mli +++ b/compiler/lib/js_traverse.mli @@ -16,24 +16,39 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -open Stdlib +open! Stdlib open Javascript class type mapper = object + method loc : Javascript.location -> Javascript.location + method expression : expression -> expression method expression_o : expression option -> expression option method switch_case : expression -> expression + method block : Javascript.statement_list -> Javascript.statement_list + + method fun_decl : Javascript.function_declaration -> Javascript.function_declaration + + method class_decl : Javascript.class_declaration -> Javascript.class_declaration + method initialiser : expression * location -> expression * location method initialiser_o : (expression * location) option -> (expression * location) option + method for_binding : + Javascript.variable_declaration_kind + -> Javascript.for_binding + -> Javascript.for_binding + method variable_declaration : - Javascript.variable_declaration -> Javascript.variable_declaration + Javascript.variable_declaration_kind + -> Javascript.variable_declaration + -> Javascript.variable_declaration method statement : statement -> statement @@ -41,17 +56,53 @@ class type mapper = method statement_o : (statement * location) option -> (statement * location) option - method source : source_element -> source_element - - method sources : source_elements -> source_elements - method ident : ident -> ident + method formal_parameter_list : + Javascript.formal_parameter_list -> Javascript.formal_parameter_list + method program : program -> program + + method function_body : statement_list -> statement_list + end + +class type iterator = + object + method early_error : Javascript.early_error -> unit + + method expression : Javascript.expression -> unit + + method expression_o : Javascript.expression option -> unit + + method switch_case : Javascript.expression -> unit + + method initialiser : Javascript.expression * Javascript.location -> unit + + method initialiser_o : (Javascript.expression * Javascript.location) option -> unit + + method for_binding : + Javascript.variable_declaration_kind -> Javascript.for_binding -> unit + + method variable_declaration : + Javascript.variable_declaration_kind -> Javascript.variable_declaration -> unit + + method statement : Javascript.statement -> unit + + method statement_o : (Javascript.statement * Javascript.location) option -> unit + + method statements : Javascript.statement_list -> unit + + method ident : Javascript.ident -> unit + + method program : Javascript.program -> unit + + method function_body : Javascript.statement_list -> unit end class map : mapper +class iter : iterator + class subst : (ident -> ident) -> object @@ -59,15 +110,15 @@ class subst : end type t = - { use_name : Utf8_string_set.t - ; def_name : Utf8_string_set.t - ; def : Code.Var.Set.t - ; use : Code.Var.Set.t + { use : IdentSet.t + ; def_var : IdentSet.t + ; def_local : IdentSet.t } type block = - | Catch of ident - | Params of ident list + | Catch of formal_parameter + | Params of formal_parameter_list + | Normal class type freevar = object ('a) @@ -75,27 +126,25 @@ class type freevar = method merge_info : 'a -> unit - method block : block -> unit + method merge_block_info : 'a -> unit + + method record_block : block -> unit method def_var : ident -> unit + method def_local : Javascript.ident -> unit + method use_var : ident -> unit method state : t method get_count : int IdentMap.t - method get_free_name : Utf8_string_set.t - - method get_free : Code.Var.Set.t - - method get_def_name : Utf8_string_set.t - - method get_def : Code.Var.Set.t + method get_free : IdentSet.t - method get_use_name : Utf8_string_set.t + method get_def : IdentSet.t - method get_use : Code.Var.Set.t + method get_use : IdentSet.t end class free : freevar diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml index ea72844e04..e699d6a4a0 100644 --- a/compiler/lib/linker.ml +++ b/compiler/lib/linker.ml @@ -21,8 +21,11 @@ open! Stdlib let to_stringset utf8_string_set = - Utf8_string_set.fold - (fun (Utf8_string.Utf8 x) acc -> StringSet.add x acc) + Javascript.IdentSet.fold + (fun x acc -> + match x with + | S { name = Utf8 x; _ } -> StringSet.add x acc + | V _ -> acc) utf8_string_set StringSet.empty @@ -41,10 +44,10 @@ end = struct match p with | [] -> None | ( Javascript.Function_declaration - (Javascript.S { Javascript.name = Utf8 n; _ }, l, _, _) + (Javascript.S { Javascript.name = Utf8 n; _ }, (_, { list; rest = None }, _, _)) , _ ) :: _ - when String.equal name n -> Some (List.length l) + when String.equal name n -> Some (List.length list) | _ :: rem -> find rem ~name end @@ -59,9 +62,8 @@ end = struct let open Javascript in (match x with | ECall - ( EVar (S { name = Utf8 "caml_named_value"; _ }) - , [ (EStr (Utf8 v), `Not_spread) ] - , _ ) -> all := StringSet.add v !all + (EVar (S { name = Utf8 "caml_named_value"; _ }), _, [ Arg (EStr (Utf8 v)) ], _) + -> all := StringSet.add v !all | _ -> ()); self#expression x end @@ -79,15 +81,18 @@ module Check = struct inherit Js_traverse.free as super method merge_info from = - let def = from#get_def_name in - let use = from#get_use_name in - let diff = Utf8_string_set.diff def use in + let def = from#get_def in + let use = from#get_use in + let diff = Javascript.IdentSet.diff def use in let diff = - Utf8_string_set.fold - (fun (Utf8_string.Utf8 s) acc -> - if String.is_prefix s ~prefix:"_" || String.equal s name - then acc - else s :: acc) + Javascript.IdentSet.fold + (fun x acc -> + match x with + | S { name = Utf8_string.Utf8 s; _ } -> + if String.is_prefix s ~prefix:"_" || String.equal s name + then acc + else s :: acc + | V _ -> acc) diff [] in @@ -110,7 +115,7 @@ module Check = struct else new Js_traverse.free in let _code = free#program code in - let freename = to_stringset free#get_free_name in + let freename = to_stringset free#get_free in let freename = List.fold_left requires ~init:freename ~f:(fun freename x -> StringSet.remove x freename) @@ -128,7 +133,7 @@ module Check = struct instead@." (loc pi); let freename = StringSet.remove Constant.old_global_object freename in - let defname = to_stringset free#get_def_name in + let defname = to_stringset free#get_def in if not (StringSet.mem name defname) then warn @@ -215,26 +220,8 @@ module Fragment = struct pi.Parse_info.line pi.Parse_info.col in - let blocks = - let groups : Javascript.program_with_annots list = - List.group program ~f:(fun x pred -> - match x, pred with - | (_, []), (_, _) -> true - | _ -> false) - in - List.map groups ~f:(fun l -> - match l with - | [] -> assert false - | (c, annots) :: rest -> - let rest = - List.map rest ~f:(fun (c, a) -> - assert (List.is_empty a); - c) - in - annots, c :: rest) - in let res = - List.map blocks ~f:(fun (annot, code) -> + List.map program ~f:(fun (annot, code) -> match annot with | [] -> Always_include code | annot -> @@ -526,7 +513,7 @@ let check_deps () = (fun id (code, requires) -> let traverse = new Js_traverse.free in let _js = traverse#program code in - let free = to_stringset traverse#get_free_name in + let free = to_stringset traverse#get_free in let requires = List.fold_right requires ~init:StringSet.empty ~f:StringSet.add in let real = StringSet.inter free provided in let missing = StringSet.diff real requires in diff --git a/compiler/lib/macro.ml b/compiler/lib/macro.ml index cd44ac0c94..268d5382c1 100644 --- a/compiler/lib/macro.ml +++ b/compiler/lib/macro.ml @@ -26,26 +26,30 @@ class macro_mapper = method expression x = let module J = Javascript in match x with - | J.ECall (J.EVar (J.S { name = Utf8 name; _ }), args, _) -> ( + | J.ECall (J.EVar (J.S { name = Utf8 name; _ }), (ANormal | ANullish), args, _) -> ( match name, args with - | "FLAG", [ (J.EStr (Utf8 s), `Not_spread) ] -> + | "FLAG", [ J.Arg (J.EStr (Utf8 s)) ] -> let i = if Config.Flag.find s then 1l else 0l in J.ENum (J.Num.of_int32 i) - | "BLOCK", (J.ENum tag, `Not_spread) :: (_ :: _ as args) + | "BLOCK", J.Arg (J.ENum tag) :: (_ :: _ as args) when List.for_all args ~f:(function - | _, `Not_spread -> true - | _ -> false) -> + | J.Arg _ -> true + | J.ArgSpread _ -> false) -> let tag = Int32.to_int (J.Num.to_int32 tag) in - let args = List.map args ~f:(fun (e, _) -> m#expression e) in + let args = + List.map args ~f:(function + | J.Arg e -> m#expression e + | J.ArgSpread _ -> assert false) + in Mlvalue.Block.make ~tag ~args - | "TAG", [ (e, `Not_spread) ] -> Mlvalue.Block.tag (m#expression e) - | "LENGTH", [ (e, `Not_spread) ] -> Mlvalue.Array.length (m#expression e) - | "FIELD", [ (e, `Not_spread); (J.ENum n, `Not_spread) ] -> + | "TAG", [ J.Arg e ] -> Mlvalue.Block.tag (m#expression e) + | "LENGTH", [ J.Arg e ] -> Mlvalue.Array.length (m#expression e) + | "FIELD", [ J.Arg e; J.Arg (J.ENum n) ] -> let idx = Int32.to_int (J.Num.to_int32 n) in Mlvalue.Block.field (m#expression e) idx - | "FIELD", [ _; (J.EUn (J.Neg, _), `Not_spread) ] -> + | "FIELD", [ _; J.Arg (J.EUn (J.Neg, _)) ] -> failwith "Negative field indexes are not allowed" - | "ISBLOCK", [ (e, `Not_spread) ] -> Mlvalue.is_block (m#expression e) + | "ISBLOCK", [ J.Arg e ] -> Mlvalue.is_block (m#expression e) | (("BLOCK" | "TAG" | "LENGTH" | "FIELD" | "ISBLOCK" | "FLAG") as name), _ -> failwith (Format.sprintf "macro %s called with inappropriate arguments" name) diff --git a/compiler/lib/mlvalue.ml b/compiler/lib/mlvalue.ml index 81b7bead7b..8b5de2ca7b 100644 --- a/compiler/lib/mlvalue.ml +++ b/compiler/lib/mlvalue.ml @@ -36,20 +36,22 @@ let is_immediate e = type_of_is_number J.EqEqEq e module Block = struct let make ~tag ~args = J.EArr - (List.map ~f:(fun x -> Some x) (J.ENum (J.Num.of_int32 (Int32.of_int tag)) :: args)) + (List.map + ~f:(fun x -> J.Element x) + (J.ENum (J.Num.of_int32 (Int32.of_int tag)) :: args)) - let tag e = J.EAccess (e, zero) + let tag e = J.EAccess (e, ANormal, zero) let field e idx = let adjusted = J.ENum (J.Num.of_int32 (Int32.of_int (idx + 1))) in - J.EAccess (e, adjusted) + J.EAccess (e, ANormal, adjusted) end module Array = struct let make = Block.make let length e = - let underlying = J.EDot (e, Utf8_string.of_string_exn "length") in + let underlying = J.EDot (e, ANormal, Utf8_string.of_string_exn "length") in J.EBin (J.Minus, underlying, one) let field e i = @@ -57,9 +59,9 @@ module Array = struct | J.ENum n -> let idx = J.Num.to_int32 n in let adjusted = J.ENum (J.Num.of_int32 (Int32.add idx 1l)) in - J.EAccess (e, adjusted) + J.EAccess (e, ANormal, adjusted) | J.EUn (J.Neg, _) -> failwith "Negative field indexes are not allowed" | _ -> let adjusted = J.EBin (J.Plus, one, i) in - J.EAccess (e, adjusted) + J.EAccess (e, ANormal, adjusted) end diff --git a/compiler/lib/parse_js.ml b/compiler/lib/parse_js.ml index 920e49f291..c327317cf0 100644 --- a/compiler/lib/parse_js.ml +++ b/compiler/lib/parse_js.ml @@ -29,30 +29,22 @@ module Lexer : sig val curr_pos : t -> Lexing.position - val stash : t -> unit - - val rollback : t -> unit - val token : t -> Js_token.t * (Lexing.position * Lexing.position) - val regexp : t -> Js_token.t * (Lexing.position * Lexing.position) + val lex_as_regexp : t -> Js_token.t * (Lexing.position * Lexing.position) val dummy_pos : Lexing.position end = struct - type elt = Js_token.t * (Lexing.position * Lexing.position) * Flow_lexer.Lex_env.t - type t = { l : Sedlexing.lexbuf ; mutable env : Flow_lexer.Lex_env.t - ; mutable curr : elt option - ; mutable stashed : elt list } let dummy_pos = { Lexing.pos_fname = ""; pos_lnum = 0; pos_cnum = 0; pos_bol = 0 } let zero_pos = { Lexing.pos_fname = ""; pos_lnum = 1; pos_cnum = 0; pos_bol = 0 } - let create l = { l; env = Flow_lexer.Lex_env.create l; curr = None; stashed = [] } + let create l = { l; env = Flow_lexer.Lex_env.create l } let of_file file : t = let ic = open_in file in @@ -82,64 +74,91 @@ end = struct List.iter l ~f:(fun (loc, e) -> let loc = match loc.Flow_lexer.Loc.source with - | None -> Printf.sprintf "%d:%d" loc.start.line loc.start.column - | Some f -> Printf.sprintf "%s:%d:%d" f loc.start.line loc.start.column + | None -> + Printf.sprintf + "%d:%d" + loc.start.pos_lnum + (loc.start.pos_cnum - loc.start.pos_bol) + | Some f -> + Printf.sprintf + "%s:%d:%d" + f + loc.start.pos_lnum + (loc.start.pos_cnum - loc.start.pos_bol) in + Printf.eprintf "Lexer error: %s: %s\n" loc (Flow_lexer.Parse_error.to_string e)) let token (t : t) = - match t.stashed with - | [] -> - let env, res = Flow_lexer.token t.env in - t.env <- env; - let tok = Flow_lexer.Lex_result.token res in - let pos = Flow_lexer.Lex_result.loc res in - report_errors res; - let c = tok, pos, env in - t.curr <- Some c; - tok, pos - | ((tok, pos, env) as c) :: xs -> - t.stashed <- xs; - t.env <- env; - t.curr <- Some c; - tok, pos - - let regexp (t : t) = - match t.stashed with - | [] -> - let env, res = Flow_lexer.regexp t.env in - t.env <- env; - let tok = Flow_lexer.Lex_result.token res in - let pos = Flow_lexer.Lex_result.loc res in - report_errors res; - let c = tok, pos, env in - t.curr <- Some c; - tok, pos - | ((tok, pos, env) as c) :: xs -> - t.stashed <- xs; - t.env <- env; - t.curr <- Some c; - tok, pos - - let rollback (t : t) = Sedlexing.rollback t.l - - let stash (t : t) = - match t.curr with - | None -> () - | Some (tok, p, env) -> t.stashed <- (tok, p, env) :: t.stashed + let env, res = Flow_lexer.lex t.env in + t.env <- env; + let tok = Flow_lexer.Lex_result.token res in + let pos = Flow_lexer.Lex_result.loc res in + report_errors res; + tok, pos + + let lex_as_regexp (t : t) = + Sedlexing.rollback t.l; + let env, res = Flow_lexer.regexp t.env in + t.env <- env; + let tok = Flow_lexer.Lex_result.token res in + let pos = Flow_lexer.Lex_result.loc res in + report_errors res; + tok, pos end exception Parsing_error of Parse_info.t +let matching_token (o : Js_token.t) (c : Js_token.t) = + match o, c with + | T_LPAREN, T_RPAREN | T_LBRACKET, T_RBRACKET | T_LCURLY, T_RCURLY -> true + | _ -> false + +module Tokens : sig + type elt = Js_token.t * (Lexing.position * Lexing.position) + + type +'a t + + val add : elt -> 'a -> 'a t -> 'a t + + val last : 'a t -> elt option + + val last' : 'a t -> (elt * 'a t * 'a) option + + val empty : 'a t + + val all : 'a t -> (Js_token.t * Parse_info.t) list +end = struct + type elt = Js_token.t * (Lexing.position * Lexing.position) + + type 'a t = (elt * 'a) list + + let empty = [] + + let add elt data t = (elt, data) :: t + + let rec last = function + | [] -> None + | (((Js_token.TComment _ | TCommentLineDirective _), _), _) :: l -> last l + | (x, _) :: _ -> Some x + + let rec last' = function + | [] -> None + | (((Js_token.TComment _ | TCommentLineDirective _), _), _) :: l -> last' l + | (x, data) :: l -> Some (x, l, data) + + let all t_rev = List.rev_map t_rev ~f:(fun ((t, (p, _)), _) -> t, Parse_info.t_of_pos p) +end + let parse_aux the_parser (lexbuf : Lexer.t) = let init = the_parser (Lexer.curr_pos lexbuf) in let fol prev (_, (c, _)) = - match prev with - | [] -> true - | (_, (_, p)) :: _ -> c.Lexing.pos_lnum <> p.Lexing.pos_lnum + match Tokens.last prev with + | None -> true + | Some (_, (_, p)) -> c.Lexing.pos_lnum <> p.Lexing.pos_lnum in let rec loop_error prev checkpoint = let module I = Js_parser.MenhirInterpreter in @@ -173,34 +192,43 @@ let parse_aux the_parser (lexbuf : Lexer.t) = | Not_found -> None | _ -> None) in - let rec loop prev prev_with_comment (last_checkpoint, checkpoint) = + let rec loop prev buffer checkpoint = let module I = Js_parser.MenhirInterpreter in match checkpoint with | I.InputNeeded _env -> - let inputneeded = checkpoint in - let token, prev_with_comment = - match prev with - | ((Js_token.T_EOF, _) as prev) :: _ -> prev, prev_with_comment + let token, buffer, prev = + match Tokens.last prev with + | Some ((Js_token.T_EOF, _) as last) -> last, buffer, prev | _ -> - let rec read_one prev_with_comment (lexbuf : Lexer.t) = - match Lexer.token lexbuf with - | (TCommentLineDirective _ as tok), pos -> - read_one ((tok, pos) :: prev_with_comment) lexbuf - | (TComment s as tok), pos -> - if fol prev_with_comment (tok, pos) + let read_tok buffer lexbuf = + match buffer with + | [] -> buffer, Lexer.token lexbuf + | x :: xs -> xs, x + in + let rec read_one prev buffer (lexbuf : Lexer.t) = + let buffer, t = read_tok buffer lexbuf in + match t with + | (TCommentLineDirective _, _) as t -> + let prev = Tokens.add t checkpoint prev in + read_one prev buffer lexbuf + | (TComment s, loc) as t -> + if fol prev t then match parse_annot s with - | None -> read_one ((tok, pos) :: prev_with_comment) lexbuf + | None -> + let prev = Tokens.add t checkpoint prev in + read_one prev buffer lexbuf | Some annot -> - let tok = Js_token.TAnnot (s, annot) in - (tok, pos), prev_with_comment - else read_one ((tok, pos) :: prev_with_comment) lexbuf - | TAnnot _, _pos -> assert false - | t, pos -> (t, pos), prev_with_comment + let t = Js_token.TAnnot (s, annot), loc in + t, buffer, prev + else + let prev = Tokens.add t checkpoint prev in + read_one prev buffer lexbuf + | t -> t, buffer, prev in - let t, prev_with_comment = read_one prev_with_comment lexbuf in - let t, pos = - match prev, t with + let t, buffer, prev = read_one prev buffer lexbuf in + let (t, pos), buffer = + match Tokens.last prev, t with (* restricted productions * 7.9.1 - 3 * When, as the program is parsed from left to right, a token is encountered @@ -211,41 +239,42 @@ let parse_aux the_parser (lexbuf : Lexer.t) = * and the restricted token is separated from the previous token by at least * one LineTerminator, then a semicolon is automatically inserted before the * restricted token. *) - | ( ((T_RETURN | T_CONTINUE | T_BREAK | T_THROW), _) :: _ - , (((T_SEMICOLON | T_VIRTUAL_SEMICOLON), _) as t) ) -> t - | ((T_RETURN | T_CONTINUE | T_BREAK | T_THROW), _) :: _, t when fol prev t - -> - Lexer.stash lexbuf; - T_VIRTUAL_SEMICOLON, (Lexer.dummy_pos, Lexer.dummy_pos) + | ( Some ((T_RETURN | T_CONTINUE | T_BREAK | T_THROW | T_YIELD), _) + , (((T_SEMICOLON | T_VIRTUAL_SEMICOLON), _) as t) ) -> t, buffer + | Some ((T_RETURN | T_CONTINUE | T_BREAK | T_THROW | T_YIELD), _), t + when fol prev t -> + let buffer = t :: buffer in + (T_VIRTUAL_SEMICOLON, (Lexer.dummy_pos, Lexer.dummy_pos)), buffer (* The practical effect of these restricted productions is as follows: * When a ++ or -- token is encountered where the parser would treat it * as a postfix operator, and at least one LineTerminator occurred between * the preceding token and the ++ or -- token, then a semicolon is automatically * inserted before the ++ or -- token. *) | _, ((T_DECR, pos) as tok) when not (fol prev tok) -> - Js_token.T_DECR_NB, pos + (Js_token.T_DECR_NB, pos), buffer | _, ((T_INCR, pos) as tok) when not (fol prev tok) -> - Js_token.T_INCR_NB, pos - | _, ((((T_DIV | T_DIV_ASSIGN) as t), ((start_pos, _) as _pos)) as tok) -> + (Js_token.T_INCR_NB, pos), buffer + | _, ((((T_DIV | T_DIV_ASSIGN) as t), ((start_pos, _) as _pos)) as tok) + -> ( if I.acceptable checkpoint t start_pos - then tok - else ( - Lexer.rollback lexbuf; - let t, pos = Lexer.regexp lexbuf in - t, pos) - | _, t -> t + then tok, buffer + else + match buffer with + | [] -> Lexer.lex_as_regexp lexbuf, buffer + | _ -> + (* Trying to lex token differently, not allowed *) tok, buffer) + | _, t -> t, buffer in - (t, pos), prev_with_comment + (t, pos), buffer, prev in - let last_checkpoint = prev, prev_with_comment, inputneeded in - let t, pos = token in - let checkpoint = I.offer checkpoint (t, fst pos, snd pos) in - loop (token :: prev) (token :: prev_with_comment) (last_checkpoint, checkpoint) - | I.Shifting _ | I.AboutToReduce _ -> - loop prev prev_with_comment (last_checkpoint, I.resume checkpoint) - | I.Accepted v -> `Ok (v, prev_with_comment) + let t, (pos_start, pos_stop) = token in + let prev = Tokens.add token checkpoint prev in + let checkpoint = I.offer checkpoint (t, pos_start, pos_stop) in + loop prev buffer checkpoint + | I.Shifting _ | I.AboutToReduce _ -> loop prev buffer (I.resume checkpoint) + | I.Accepted v -> `Ok (v, prev) | I.Rejected -> `Error prev - | I.HandlingError _ -> ( + | I.HandlingError _env -> ( (* 7.9.1 - 1 *) (* When, as the program is parsed from left to right, a token (called the offending token) is encountered that is not allowed by any production of the grammar, then a semicolon @@ -259,58 +288,181 @@ let parse_aux the_parser (lexbuf : Lexer.t) = (* When, as the program is parsed from left to right, the end of the input stream of tokens *) (* is encountered and the parser is unable to parse the input token stream as a single *) (* complete ECMAScript Program, then a semicolon is automatically inserted at the end *) - let insert_virtual_semmit = - match prev with - | [] | (T_VIRTUAL_SEMICOLON, _) :: _ -> false - | (T_RCURLY, _) :: _ -> true - | (T_EOF, _) :: _ -> true - | offending :: before :: _ when fol [ before ] offending -> true - | _ -> false + let to_ident (t, loc) = + let name = Js_token.to_string t in + Js_token.T_IDENTIFIER (Stdlib.Utf8_string.of_string_exn name, name), loc in + let rec rewind stack buffer prev = + match Tokens.last' prev with + | None -> None + | Some (((tok, loc) as tok'), prev, checkpoint) -> ( + match tok, stack with + | (T_RPAREN | T_RCURLY | T_RBRACKET), _ -> + let buffer = tok' :: buffer in + let stack = tok :: stack in + rewind stack buffer prev + | ((T_LPAREN | T_LCURLY | T_LBRACKET) as o), c :: stack -> ( + if not (matching_token o c) + then None + else + match stack with + | [] -> Some (loc, prev, buffer, checkpoint) + | _ -> + let buffer = tok' :: buffer in + rewind stack buffer prev) + | _, stack -> + let buffer = tok' :: buffer in + rewind stack buffer prev) + in + let end_of_do_whle prev = + match rewind [ T_RPAREN ] [] prev with + | None -> false + | Some (_, prev, _, _) -> ( + match Tokens.last' prev with + | None -> false + | Some ((T_WHILE, _), prev, _checkpoint) -> ( + match Tokens.last' prev with + | None -> false + | Some ((T_SEMICOLON, _), prev, _checkpoint) -> ( + match Tokens.last' prev with + | None -> false + | Some ((T_DO, _), _, _) -> true + | Some (_, _, _) -> false) + | Some ((T_RCURLY, _), prev, _checkpoint) -> ( + match rewind [ T_RCURLY ] [] prev with + | None -> false + | Some (_, prev, _, _) -> ( + match Tokens.last' prev with + | None -> false + | Some ((T_DO, _), _, _) -> true + | Some (_, _, _) -> false)) + | Some (_, _, _) -> false) + | Some (_, _, _) -> false) + in + let kind = + match Tokens.last' prev with + | None | Some ((T_VIRTUAL_SEMICOLON, _), _, _) -> `None + (* contextually allowed as identifiers, namely await and yield; *) + | Some ((((T_YIELD | T_AWAIT), _) as tok), rest, checkpoint) + when I.acceptable checkpoint (fst (to_ident tok)) Lexer.dummy_pos -> + `Replace (to_ident tok, rest, checkpoint) + | Some (((T_RCURLY, _) as tok), rest, checkpoint) + when I.acceptable checkpoint Js_token.T_VIRTUAL_SEMICOLON Lexer.dummy_pos -> + `Semi_colon (tok, rest, checkpoint) + | Some (((T_EOF, _) as tok), rest, checkpoint) + when I.acceptable checkpoint Js_token.T_VIRTUAL_SEMICOLON Lexer.dummy_pos -> + `Semi_colon (tok, rest, checkpoint) + | Some (((T_ARROW, _) as tok), prev, checkpoint) when not (fol prev tok) -> + `Arrow (tok, prev, checkpoint) + | Some (last, rest, checkpoint) -> ( + match Tokens.last' rest with + | Some ((T_VIRTUAL_SEMICOLON, _), _, _) -> `None + | (Some _ | None) + when fol rest last + && I.acceptable + checkpoint + Js_token.T_VIRTUAL_SEMICOLON + Lexer.dummy_pos -> `Semi_colon (last, rest, checkpoint) + | Some ((T_RPAREN, _), rest, _) + when end_of_do_whle rest + && I.acceptable + checkpoint + Js_token.T_VIRTUAL_SEMICOLON + Lexer.dummy_pos -> `Semi_colon (last, rest, checkpoint) + | _ -> `None) + in + let drop_annot_or_error () = - match prev with - | (TAnnot (s, _), pos) :: _ -> - let prev, prev_with_comment, checkpoint = last_checkpoint in - let t = Js_token.TComment s in - loop prev ((t, pos) :: prev_with_comment) (last_checkpoint, checkpoint) + match Tokens.last' prev with + | Some ((TAnnot (s, _), pos), prev, checkpoint) -> + let t = Js_token.TComment s, pos in + let prev = Tokens.add t checkpoint prev in + loop prev buffer checkpoint | _ -> loop_error prev (I.resume checkpoint) in - match insert_virtual_semmit with - | false -> drop_annot_or_error () - | true -> - let prev, prev_with_comment, checkpoint = last_checkpoint in - if I.acceptable - checkpoint - Js_token.T_VIRTUAL_SEMICOLON - (Lexer.curr_pos lexbuf) - then ( - Lexer.stash lexbuf; - let t = Js_token.T_VIRTUAL_SEMICOLON, (Lexer.dummy_pos, Lexer.dummy_pos) in - let checkpoint = - let t, pos = t in - I.offer checkpoint (t, fst pos, snd pos) - in - loop (t :: prev) (t :: prev_with_comment) (last_checkpoint, checkpoint)) - else drop_annot_or_error ()) + match kind with + | `None -> drop_annot_or_error () + | `Arrow (tok, prev, _checkpoint) -> ( + (* Restart parsing from the openning parens, patching the + token to be T_LPAREN_ARROW to help the parser *) + let buffer = tok :: buffer in + let err () = loop_error prev (I.resume checkpoint) in + match Tokens.last' prev with + | Some (((T_RPAREN, _) as tok), prev, _) -> ( + let buffer = tok :: buffer in + match rewind [ T_RPAREN ] buffer prev with + | None -> err () + | Some (loc, prev, buffer, checkpoint) -> + let buffer = (Js_token.T_LPAREN_ARROW, loc) :: buffer in + loop prev buffer checkpoint) + | Some _ | None -> err ()) + | `Replace (t, prev, checkpoint) -> + let checkpoint = + let t, pos = t in + I.offer checkpoint (t, fst pos, snd pos) + in + let prev = Tokens.add t checkpoint prev in + loop prev buffer checkpoint + | `Semi_colon (tok, prev, checkpoint) -> + let buffer = tok :: buffer in + let t = Js_token.T_VIRTUAL_SEMICOLON, (Lexer.dummy_pos, Lexer.dummy_pos) in + let checkpoint = + let t, pos = t in + I.offer checkpoint (t, fst pos, snd pos) + in + let prev = Tokens.add t checkpoint prev in + loop prev buffer checkpoint) in - match loop [] [] (([], [], init), init) with + match loop Tokens.empty [] init with | `Ok x -> x - | `Error tok -> - let pi = - match tok with - | [] -> Parse_info.zero - | (_, (p, _)) :: _ -> Parse_info.t_of_pos p + | `Error toks -> + let rec pi last = + match Tokens.last' last with + | None -> Parse_info.zero + | Some ((_, (p, _)), rest, _) -> + if Poly.(p = Lexer.dummy_pos) then pi rest else Parse_info.t_of_pos p in - raise (Parsing_error pi) + raise (Parsing_error (pi toks)) + +let fail_early = + object + inherit Js_traverse.iter + + method early_error p = raise (Parsing_error p.loc) + end + +let check_program p = + List.iter p ~f:(function + | `Annot _ -> () + | `Item p -> fail_early#program [ p ]) let parse' lex = - let p, t_rev = parse_aux Js_parser.Incremental.program lex in - p, List.rev_map t_rev ~f:(fun (t, (p, _)) -> t, Parse_info.t_of_pos p) + let p, toks = parse_aux Js_parser.Incremental.program lex in + check_program p; + let groups = + List.group p ~f:(fun a pred -> + match pred, a with + | `Item _, `Annot _ -> false + | `Annot _, `Annot _ -> true + | `Item _, `Item _ -> true + | `Annot _, `Item _ -> true) + in + let p = + List.map groups ~f:(fun g -> + List.partition_map g ~f:(function + | `Annot a -> `Fst a + | `Item i -> `Snd i)) + in + p, Tokens.all toks let parse lex = let p, _ = parse_aux Js_parser.Incremental.program lex in - List.map p ~f:(fun (c, _) -> c) + check_program p; + List.filter_map p ~f:(function + | `Item i -> Some i + | `Annot _ -> None) let parse_expr lex = let expr, _ = parse_aux Js_parser.Incremental.standalone_expression lex in + fail_early#expression expr; expr diff --git a/compiler/lib/parse_js.mli b/compiler/lib/parse_js.mli index e0598b8b47..a6b380725f 100644 --- a/compiler/lib/parse_js.mli +++ b/compiler/lib/parse_js.mli @@ -31,6 +31,9 @@ exception Parsing_error of Parse_info.t val parse : Lexer.t -> Javascript.program -val parse' : Lexer.t -> Javascript.program_with_annots * (Js_token.t * Parse_info.t) list +val parse' : + Lexer.t + -> ((Js_token.Annot.t * Parse_info.t) list * Javascript.program) list + * (Js_token.t * Parse_info.t) list val parse_expr : Lexer.t -> Javascript.expression diff --git a/compiler/tests-compiler/exports.ml b/compiler/tests-compiler/exports.ml index d2c8394c19..2c74d0fa1a 100644 --- a/compiler/tests-compiler/exports.ml +++ b/compiler/tests-compiler/exports.ml @@ -24,28 +24,30 @@ let%expect_test "static eval of string get" = let open Js_of_ocaml_compiler in let traverse = new Js_traverse.free in let _ = traverse#program [ st ] in - let jsoo_exports = Stdlib.Utf8_string.of_string_exn "jsoo_exports" in - Stdlib.Utf8_string_set.mem jsoo_exports traverse#get_use_name - || Stdlib.Utf8_string_set.mem jsoo_exports traverse#get_def_name + let jsoo_exports = + Javascript.ident (Stdlib.Utf8_string.of_string_exn "jsoo_exports") + in + Javascript.IdentSet.mem jsoo_exports traverse#get_use + || Javascript.IdentSet.mem jsoo_exports traverse#get_def in let clean program = let clean_statement st = let open Js_of_ocaml_compiler.Javascript in match st with - | Function_declaration (name, param, body, loc1), loc2 -> ( + | Function_declaration (name, (k, param, body, loc1)), loc2 -> ( match List.filter use_jsoo_exports body with | [] -> None - | body -> Some (Function_declaration (name, param, body, loc1), loc2)) - | ( Statement (Expression_statement (ECall (EFun (name, param, body, loc1), a, l))) + | body -> Some (Function_declaration (name, (k, param, body, loc1)), loc2)) + | ( Expression_statement (ECall (EFun (name, (k, param, body, loc1)), ANormal, a, l)) , loc ) -> ( match List.filter use_jsoo_exports body with | [] -> None | body -> Some - ( Statement - (Expression_statement (ECall (EFun (name, param, body, loc1), a, l))) + ( Expression_statement + (ECall (EFun (name, (k, param, body, loc1)), ANormal, a, l)) , loc )) - | Statement _, _ -> Some st + | _, _ -> Some st in List.filter_map clean_statement program in diff --git a/compiler/tests-compiler/gh1051.ml b/compiler/tests-compiler/gh1051.ml index 134048b17e..e616425ba3 100644 --- a/compiler/tests-compiler/gh1051.ml +++ b/compiler/tests-compiler/gh1051.ml @@ -22,11 +22,10 @@ let prog = {|let () = Printf.printf "%nx" 0xffffffffn;;|} let%expect_test _ = - Util.compile_and_run prog; + Util.compile_and_run ~skip_modern:true prog; [%expect {| Warning: integer overflow: integer 0xffffffff (4294967295) truncated to 0xffffffff (-1); the generated code might be incorrect. -Warning: integer overflow: integer 0xffffffff (4294967295) truncated to 0xffffffff (-1); the generated code might be incorrect. ffffffff |}]; () diff --git a/compiler/tests-compiler/js_parser_printer.ml b/compiler/tests-compiler/js_parser_printer.ml index 6c16b466ba..d0633e3e9a 100644 --- a/compiler/tests-compiler/js_parser_printer.ml +++ b/compiler/tests-compiler/js_parser_printer.ml @@ -20,15 +20,58 @@ open Js_of_ocaml_compiler.Stdlib open Js_of_ocaml_compiler -let print ~compact source = +let remove_loc p = + (object + inherit Js_traverse.map + + method! loc _ = N + end) + #program + p + +let p_to_string p = + let buffer = Buffer.create 17 in + let pp = Pretty_print.to_buffer buffer in + Pretty_print.set_compact pp false; + let _ = Js_output.program pp p in + let s = Buffer.contents buffer in + s + +let print ?(report = false) ?(invalid = false) ~compact source = + let stdout = Util.check_javascript_source source in + (match invalid, stdout with + | false, _ -> print_endline stdout + | true, "" -> print_endline "invalid file but node --check didn't complain" + | true, _ -> ()); let buffer = Buffer.create (String.length source) in let pp = Pretty_print.to_buffer buffer in Pretty_print.set_compact pp compact; let lexed = Parse_js.Lexer.of_string source in - let parsed = Parse_js.parse lexed in - Config.Flag.enable "debuginfo"; - let _ = Js_output.program pp parsed in - print_endline (Buffer.contents buffer) + try + let parsed = Parse_js.parse lexed in + Config.Flag.enable "debuginfo"; + let _ = Js_output.program pp parsed in + let s = Buffer.contents buffer in + print_endline s; + (let lexed = Parse_js.Lexer.of_string s in + let parsed2 = Parse_js.parse lexed in + let p1 = remove_loc parsed in + let p2 = remove_loc parsed2 in + if not (Poly.equal p1 p2) then print_endline ""); + let stdout = Util.check_javascript_source s in + (match invalid, stdout with + | false, _ -> print_endline stdout + | true, "" -> print_endline "invalid file but node --check didn't complain" + | true, _ -> ()); + print_endline stdout + with Parse_js.Parsing_error pi as e -> + if report + then + Printf.printf + "cannot parse js (from l:%d, c:%d)@." + pi.Parse_info.line + pi.Parse_info.col + else raise e let%expect_test "spread operator survives round-trip" = print ~compact:true "f(...[1, 2, 3])"; @@ -106,14 +149,399 @@ let%expect_test "preserve number literals" = /*<< 15 5>>*/ /*<< 15 11>>*/ var t=1E+3; |}] let%expect_test "preserve number literals in property_name" = - print ~compact:false {| - var number_as_key = { 100000000000000000000 : 2 }; |}; + print + ~compact:false + {| + var number_as_key = { 100000000000000000000 : 2 }; + var number_as_key = { 100000000000000000000n : 2 }; + |}; + [%expect + {| + /*<< 2 4>>*/ /*<< 2 22>>*/ var number_as_key={100000000000000000000:2}; + /*<< 3 4>>*/ /*<< 3 22>>*/ var number_as_key={100000000000000000000n:2}; |}] + +let%expect_test "ops" = + print + ~report:true + ~compact:false + {| + a += a; + b ||= true; + c **= b ** 2; + 1 ** 2; + (-1) ** 2; + -(1 ** 2); + f ??= fw; + g = c || (a ?? b) || c; + g = (c || a) ?? (b || c); + g = c && (a ?? b) && c; + g = (c && a) ?? (b && c); + y = a ?? b ?? c ?? d + + y = a?.b?.s?.[a] ?? c ?? d + + a?.b + a?.[b] + a?.(b) + |}; + (* FIXME: parsing & parens *) + [%expect + {| + /*<< 2 4>>*/ a += a; + /*<< 3 4>>*/ b ||= true; + /*<< 4 4>>*/ c **= b ** 2; + /*<< 5 4>>*/ 1 ** 2; + /*<< 6 4>>*/ (- 1) ** 2; + /*<< 7 4>>*/ - (1 ** 2); + /*<< 8 4>>*/ f ??= fw; + /*<< 9 4>>*/ g = c || (a ?? b) || c; + /*<< 10 4>>*/ g = (c || a) ?? (b || c); + /*<< 11 4>>*/ g = c && (a ?? b) && c; + /*<< 12 4>>*/ g = (c && a) ?? (b && c); + /*<< 13 4>>*/ y = a ?? b ?? c ?? d; + /*<< 15 4>>*/ y = a?.b?.s?.[a] ?? c ?? d; + /*<< 17 4>>*/ a?.b; + /*<< 18 4>>*/ a?.[b]; + /*<< 19 4>>*/ /*<< 19 4>>*/ a?.(b); |}] + +let%expect_test "arrow" = + print + ~report:true + ~compact:false + {| + var a = (x => x + 2) + var a = (() => 2); + var a = ((x) => x + 2); + var a = ((x,y) => x + y); + + var a = (x => { x + 2 }); + var a = (() => { 2 }); + var a = ((x) => { x + 2 }); + + var a = ((x = 1 / 2) => x + 10 ); + + var a = ((x = /qwe/g ) => x + 10 ); + + + var a = x => y => x + y + var a = x => (y => x + y) + + var a = async x => y + var a = async (a,b) => a + b + |}; + + [%expect + {| + /*<< 2 4>>*/ /*<< 2 10>>*/ var a=x=> /*<< 2 18>>*/ x + 2; + /*<< 3 4>>*/ /*<< 3 10>>*/ var a=()=> /*<< 3 19>>*/ 2; + /*<< 4 4>>*/ /*<< 4 10>>*/ var a=x=> /*<< 4 20>>*/ x + 2; + /*<< 5 4>>*/ /*<< 5 10>>*/ var a=(x,y)=> /*<< 5 22>>*/ x + y; + /*<< 7 4>>*/ /*<< 7 10>>*/ var a=x=>{ /*<< 7 20>>*/ x + 2 /*<< 7 13>>*/ }; + /*<< 8 4>>*/ /*<< 8 10>>*/ var a=()=>{ /*<< 8 21>>*/ 2 /*<< 8 13>>*/ }; + /*<< 9 4>>*/ /*<< 9 10>>*/ var a=x=>{ /*<< 9 22>>*/ x + 2 /*<< 9 13>>*/ }; + /*<< 11 4>>*/ /*<< 11 10>>*/ var + a= + ( /*<< 11 16>>*/ x=1 / 2)=> /*<< 11 28>>*/ x + 10; + /*<< 13 4>>*/ /*<< 13 10>>*/ var + a= + ( /*<< 13 16>>*/ x=/qwe/g)=> /*<< 13 30>>*/ x + 10; + /*<< 16 4>>*/ /*<< 16 10>>*/ var + a= + x=> /*<< 16 17>>*/ y=> /*<< 16 22>>*/ x + y; + /*<< 17 4>>*/ /*<< 17 10>>*/ var + a= + x=> /*<< 17 17>>*/ y=> /*<< 17 23>>*/ x + y; + /*<< 19 4>>*/ /*<< 19 10>>*/ var a=async x=> /*<< 19 23>>*/ y; + /*<< 20 4>>*/ /*<< 20 10>>*/ var a=async (a,b)=> /*<< 20 27>>*/ a + b; |}] + +let%expect_test "trailing comma" = + (* GH#989 *) + print + ~report:true + ~compact:false + {| + +// Provides: rehb_new_face +function rehb_new_face( + _fontName /*: string */, +) { + return undefined; +} + +// Provides: rehb_shape +// Requires: caml_to_js_string +function rehb_shape(_face /*: fk_face */, text /*: string */) { + var str = caml_to_js_string(text); + var ret = str.split("").map(function mapper(_char) { + return [/* */ 0, /* glyphId */ 0, /* cluster */ 0]; + }); + + // Adding the leading `0` to make it a jsoo compatible array + ret.unshift(0); + return ret; +} + |}; + + [%expect + {| + /*<< 4 0>>*/ function rehb_new_face(_fontName) + { /*<< 7 2>>*/ return undefined /*<< 8 0>>*/ } + /*<< 12 0>>*/ function rehb_shape(_face,text) + { /*<< 13 2>>*/ /*<< 13 10>>*/ var + str= + /*<< 13 12>>*/ caml_to_js_string(text); + /*<< 14 2>>*/ /*<< 14 10>>*/ var + ret= + /*<< 14 12>>*/ /*<< 14 12>>*/ str.split("").map + (function mapper(_char){ /*<< 15 6>>*/ return [0,0,0] /*<< 14 30>>*/ }); + /*<< 19 2>>*/ /*<< 19 2>>*/ ret.unshift(0); + /*<< 20 2>>*/ return ret /*<< 21 0>>*/ } |}] + +let%expect_test "rest parameters" = + (* GH#1031 *) + print + ~report:true + ~compact:false + {| + api_obj[key_module][key_func] = function(...args) { + return checkIfInitialized().then(function() { + return callWithProto(api_json[key_module][key_func], args); + }); + }; + |}; + [%expect {| - /*<< 2 4>>*/ /*<< 2 22>>*/ var number_as_key={100000000000000000000:2}; |}] + /*<< 2 6>>*/ api_obj[key_module][key_func] + = + function(...args) + { /*<< 3 8>>*/ return /*<< 3 15>>*/ /*<< 3 15>>*/ checkIfInitialized().then + (function() + { /*<< 4 10>>*/ return /*<< 4 17>>*/ callWithProto + (api_json[key_module][key_func],args) /*<< 3 41>>*/ }) /*<< 2 38>>*/ }; |}] + +let%expect_test "async/await" = + (* GH#1017 *) + print + ~report:true + ~compact:false + {| + async function compile(src) + { + const glslangModule = await import( + "https://unpkg.com/@webgpu/glslang@0.0.7/web/glslang.js" + ); + const glslang = await glslangModule.default(); + return glslang.compileGLSL(src, "compute"); + } + |}; + + [%expect + {| + /*<< 2 9>>*/ async function compile(src) + { /*<< 4 11>>*/ /*<< 4 31>>*/ const + glslangModule= + await + /*<< 4 39>>*/ import + ("https://unpkg.com/@webgpu/glslang@0.0.7/web/glslang.js"); + /*<< 7 11>>*/ /*<< 7 25>>*/ const + glslang= + await /*<< 7 33>>*/ glslangModule.default(); + /*<< 8 11>>*/ return /*<< 8 18>>*/ glslang.compileGLSL(src,"compute") /*<< 2 9>>*/ } |}] + +let%expect_test "get/set property" = + (* GH#1017 *) + print + ~report:true + ~compact:false + {| + var x = { + get prop() { return 3 }, + set prop(x) { return x == 2 }, + a : 4, + b() { return 5}, + *e() { return 5}, + async e() { return 5}, + async* e() { return 5}, + ["field" + 1]: 3 + }; + + |}; + + [%expect + {| + /*<< 2 5>>*/ /*<< 2 11>>*/ var + x= + {get prop(){ /*<< 3 20>>*/ return 3 /*<< 3 7>>*/ }, + set prop(x){ /*<< 4 21>>*/ return x == 2 /*<< 4 7>>*/ }, + a:4, + b(){ /*<< 6 13>>*/ return 5 /*<< 6 7>>*/ }, + * e(){ /*<< 7 14>>*/ return 5 /*<< 7 7>>*/ }, + async e(){ /*<< 8 19>>*/ return 5 /*<< 8 7>>*/ }, + async* e(){ /*<< 9 20>>*/ return 5 /*<< 9 7>>*/ }, + ["field" + 1]:3}; |}] + +let%expect_test "assignment pattern" = + (* GH#1017 *) + print + ~report:true + ~compact:false + {| + var x, y, rest; + var [x,y] = [1,2] + var [x,y,...rest] = [1,2, ...o] + + var {x,y} = {x:1,y:2} + var {x,y,...rest} = {x:1,y:2,...o}; + + [x,y] = [1,2]; + [x,y,...rest] = [1,2]; + + ({x,y} = {x:1,y:2}); + ({x,y,...rest} = {x:1,y:2}); + + for([a,b,{c,d=e,[f]:[g,h,a,i,j]}] in 3); + + for([a,b,{c,d=e,[f]:[g,h,a,i,j]}] of 3); + + |}; + + [%expect + {| + /*<< 2 4>>*/ var x,y,rest; + /*<< 3 4>>*/ /*<< 3 14>>*/ var [x,y]=[1,2]; + /*<< 4 4>>*/ /*<< 4 22>>*/ var [x,y,...rest]=[1,2,...o]; + /*<< 6 4>>*/ /*<< 6 14>>*/ var {x:x,y:y}={x:1,y:2}; + /*<< 7 4>>*/ /*<< 7 22>>*/ var {x:x,y:y,...rest}={x:1,y:2,...o}; + /*<< 9 4>>*/ [x,y] = [1,2]; + /*<< 10 4>>*/ [x,y,...rest] = [1,2]; + /*<< 12 4>>*/ ({x,y} = {x:1,y:2}); + /*<< 13 4>>*/ ({x,y,...rest} = {x:1,y:2}); + /*<< 15 4>>*/ for([a,b,{c,d= /*<< 15 17>>*/ e,[f]:[g,h,a,i,j]}] in 3) + /*<< 15 43>>*/ ; + /*<< 17 4>>*/ for([a,b,{c,d= /*<< 17 17>>*/ e,[f]:[g,h,a,i,j]}] of 3) + /*<< 17 43>>*/ ; |}] + +let%expect_test "string template" = + (* GH#1017 *) + print + ~report:true + ~compact:false + {| + var s = `asdte` + var s = `asd ${ test } te` + + var s = tag`asd ${ test } te` + + var s = `asd ${ f(`space ${test} space`, 32) } te` + |}; + + [%expect + {| + /*<< 2 4>>*/ /*<< 2 10>>*/ var s=`asdte`; + /*<< 3 4>>*/ /*<< 3 10>>*/ var s=`asd ${test} te`; + /*<< 5 4>>*/ /*<< 5 10>>*/ var s= /*<< 5 12>>*/ tag`asd ${test} te`; + /*<< 7 4>>*/ /*<< 7 10>>*/ var + s= + `asd ${ /*<< 7 20>>*/ f(`space ${test} space`,32)} te`; |}] + +let%expect_test "from keyword" = + (* GH#1017 *) + print + ~report:true + ~compact:false + {| +({key:"from", + value: + function from(field,get) + {if(!get)get=function get(x){return x;}; + return this.compute([field],function(state){return get(state.field(field));});}}) |}; + [%expect + {| + /*<< 2 0>>*/ ({key:"from", + value: + function from(field,get) + { /*<< 5 6>>*/ if(! get) + /*<< 5 14>>*/ get + = + function get(x){ /*<< 5 34>>*/ return x /*<< 5 18>>*/ }; + /*<< 6 6>>*/ return /*<< 6 13>>*/ this.compute + ([field], + function(state) + { /*<< 6 50>>*/ return /*<< 6 57>>*/ get + ( /*<< 6 61>>*/ state.field(field)) /*<< 6 34>>*/ }) /*<< 4 3>>*/ }}); |}] + +let%expect_test "new.target" = + (* GH#1017 *) + print ~report:true ~compact:false {| + var s = new.target + |}; + + [%expect {| + /*<< 2 4>>*/ /*<< 2 10>>*/ var s=new.target; |}] + +let%expect_test "super" = + (* GH#1017 *) + print + ~report:true + ~compact:false + {| +class x extends p { + constructor() { + super(a,b,c); + } + foo() { + + var s = super[d] + var s = super.d + } + + static bar() { + + var s = super[d] + var s = super.d + } + x = 3 + + static y = 5 + + #z = 6 + + static #t = 2 + + static { var x = 3 } +} + |}; + + [%expect + {| + /*<< 2 0>>*/ class + x + extends + p{constructor(){ /*<< 4 6>>*/ /*<< 4 6>>*/ super(a,b,c) /*<< 3 4>>*/ } + foo() + { /*<< 8 6>>*/ /*<< 8 12>>*/ var s=super[d]; + /*<< 9 6>>*/ /*<< 9 12>>*/ var s=super.d /*<< 6 4>>*/ } + static + bar() + { /*<< 14 6>>*/ /*<< 14 12>>*/ var s=super[d]; + /*<< 15 6>>*/ /*<< 15 12>>*/ var s=super.d /*<< 12 11>>*/ } + x= + /*<< 17 5>>*/ 3 + static + y= + /*<< 19 12>>*/ 5 + #z= + /*<< 21 6>>*/ 6 + static + #t= + /*<< 23 13>>*/ 2 + static{ /*<< 25 12>>*/ /*<< 25 18>>*/ var x=3} + } |}] let%expect_test "error reporting" = - (try print ~compact:false {| + (try + print ~invalid:true ~compact:false {| var x = 2; { var = 5; @@ -191,7 +619,12 @@ let check_vs_string s toks = in loop 0 0 toks -let parse_print_token ?(extra = false) s = +let parse_print_token ?(invalid = false) ?(extra = false) s = + let stdout = Util.check_javascript_source s in + (match invalid, stdout with + | false, _ -> print_endline stdout + | true, "" -> print_endline "invalid file but node --check didn't complain" + | true, _ -> ()); let lex = Parse_js.Lexer.of_string s in let _p, tokens = try Parse_js.parse' lex @@ -216,17 +649,33 @@ let parse_print_token ?(extra = false) s = loop tokens let%expect_test "tokens" = - parse_print_token {| + parse_print_token + {| var a = 42; var \u{1ee62} = 42; + var a = x => x + 2 + var a = () => 2 + + var s = `asdte` + var s = `asd ${ test } te` + var s = tag`asd ${ test } te` + + var s = `asd ${ f(`space ${test} space`, 32) } te` |}; [%expect {| - 2: 4:var, 8:a, 10:=, 12:42, 14:;, - 3: 4:var, 8:\u{1ee62}, 18:=, 20:42, 22:;, |}] + 2: 4:var, 8:a, 10:=, 12:42, 14:;, + 3: 4:var, 8:\u{1ee62}, 18:=, 20:42, 22:;, + 4: 4:var, 8:a, 10:=, 12:x, 14:=>, 17:x, 19:+, 21:2, 0:;, + 5: 4:var, 8:a, 10:=, 12:(, 13:), 15:=>, 18:2, 0:;, + 7: 4:var, 8:s, 10:=, 12:`, 13:asdte, 18:`, 0:;, + 8: 4:var, 8:s, 10:=, 12:`, 13:asd , 17:${, 20:test, 25:}, 26: te, 29:`, 0:;, + 9: 4:var, 8:s, 10:=, 12:tag, 15:`, 16:asd , 20:${, 23:test, 28:}, 29: te, 32:`, 0:;, + 11: 4:var, 8:s, 10:=, 12:`, 13:asd , 17:${, 20:f, 21:(, 22:`, 23:space , 29:${, 31:test, 35:}, 36: space, 42:`, 43:,, 45:32, 47:), 49:}, 50: te, 53:`, 0:;, |}] let%expect_test "invalid ident" = parse_print_token + ~invalid:true {| var \uD83B\uDE62 = 42; // invalid surrogate escape sequence var \u{1F42B} = 2; // U+1F42B is not a valid id @@ -254,7 +703,7 @@ let%expect_test "string" = 5: 4:var, 8:a, 10:=, 12:"munpi\207\128\207\128\207\128qtex", 26:;, |}] let%expect_test "multiline string" = - parse_print_token {| + parse_print_token ~invalid:true {| 42; " "; @@ -278,7 +727,7 @@ let%expect_test "multiline string" = 3: 4:" ", 4: 5:;, 5: 4:42, 0:;, |}]; - parse_print_token {| + parse_print_token ~invalid:true {| 42; " @@ -345,21 +794,21 @@ let%expect_test "div_or_regexp" = {| 1 / 2 1 + /regexp/ + (b) / denominator if(a) { e } /regexp/ + if(b) /regexp/ +{ } / denominator +{ } / denominator[a] - if(b) /regexp/ - (b) / denominator -|}; + |}; [%expect {| 2: 4:1, 6:/, 8:2, 0:;, - 3: 4:1, 6:+, 8:/regexp/, 0:;, - 4: 4:if, 6:(, 7:a, 8:), 10:{, 12:e, 0:;, 14:}, 16:/regexp/, - 5: 4:+, 5:{, 7:}, 9:/, 11:denominator, - 6: 4:+, 5:{, 7:}, 9:/, 11:denominator, 22:[, 23:a, 24:], 0:;, - 7: 4:if, 6:(, 7:b, 8:), 10:/regexp/, - 8: 4:(, 5:b, 6:), 8:/, 10:denominator, 0:;, |}] + 3: 4:1, 6:+, 8:/regexp/, + 4: 4:(, 5:b, 6:), 8:/, 10:denominator, 0:;, + 5: 4:if, 6:(, 7:a, 8:), 10:{, 12:e, 0:;, 14:}, 16:/regexp/, 0:;, + 6: 4:if, 6:(, 7:b, 8:), 10:/regexp/, + 7: 4:+, 5:{, 7:}, 9:/, 11:denominator, + 8: 4:+, 5:{, 7:}, 9:/, 11:denominator, 22:[, 23:a, 24:], 0:;, |}] let%expect_test "virtual semicolon" = parse_print_token @@ -369,7 +818,7 @@ let%expect_test "virtual semicolon" = return 2 return 2 - +a:while(true){ continue; continue a continue @@ -379,7 +828,7 @@ let%expect_test "virtual semicolon" = break a break a - +} throw 2; throw 2 @@ -399,6 +848,7 @@ let%expect_test "virtual semicolon" = 3: 4:return, 11:2, 0:; (virtual), 4: 4:return, 0:; (virtual), 5: 4:2, 0:; (virtual), + 6: 0:a (identifier), 1::, 2:while, 7:(, 8:true, 12:), 13:{, 7: 4:continue, 12:;, 8: 4:continue, 13:a (identifier), 0:; (virtual), 9: 4:continue, 0:; (virtual), @@ -407,6 +857,7 @@ let%expect_test "virtual semicolon" = 13: 4:break, 10:a (identifier), 0:; (virtual), 14: 4:break, 0:; (virtual), 15: 4:a (identifier), 0:; (virtual), + 16: 0:}, 17: 4:throw, 10:2, 11:;, 18: 4:throw, 10:2, 0:; (virtual), 20: 4:{, 6:1, 0:; (virtual), @@ -439,7 +890,7 @@ function UnexpectedVirtualElement(data) { {| 2: 0:function, 9:UnexpectedVirtualElement (identifier), 33:(, 34:data (identifier), 38:), 40:{, 3: 4:var, 8:err (identifier), 12:=, 14:new, 18:Error (identifier), 23:(, 24:), 25:;, - 5: 4:err (identifier), 7:., 8:type, 13:=, 15:"virtual-hyperscript.unexpected.virtual-element", 63:;, + 5: 4:err (identifier), 7:., 8:type (identifier), 13:=, 15:"virtual-hyperscript.unexpected.virtual-element", 63:;, 6: 4:err (identifier), 7:., 8:message (identifier), 16:=, 7: 8:"The parent vnode is:\\n", 33:+, 8: 8:errorString (identifier), 19:(, 20:data (identifier), 24:., 25:parentVnode (identifier), 36:), 0:; (virtual), @@ -494,8 +945,23 @@ Event.prototype.initEvent = function _Event_initEvent(type, bubbles, cancelable) |}; [%expect {| - 2: 0:Event (identifier), 5:., 6:prototype (identifier), 15:., 16:initEvent (identifier), 26:=, 28:function, 37:_Event_initEvent (identifier), 53:(, 54:type, 58:,, 60:bubbles (identifier), 67:,, 69:cancelable (identifier), 79:), 81:{, - 3: 4:this, 8:., 9:type, 14:=, 16:type, 0:; (virtual), + 2: 0:Event (identifier), 5:., 6:prototype (identifier), 15:., 16:initEvent (identifier), 26:=, 28:function, 37:_Event_initEvent (identifier), 53:(, 54:type (identifier), 58:,, 60:bubbles (identifier), 67:,, 69:cancelable (identifier), 79:), 81:{, + 3: 4:this, 8:., 9:type (identifier), 14:=, 16:type (identifier), 0:; (virtual), 4: 4:this, 8:., 9:bubbles (identifier), 17:=, 19:bubbles (identifier), 0:; (virtual), 5: 4:this, 8:., 9:cancelable (identifier), 20:=, 22:cancelable (identifier), 0:; (virtual), 6: 0:}, 0:; (virtual), |}] + +let%expect_test _ = + parse_print_token + ~extra:true + {| +var y = { async: 35} + +var y = async x => x +var y = async => async +|}; + [%expect + {| + 2: 0:var, 4:y (identifier), 6:=, 8:{, 10:async, 15::, 17:35, 19:}, 0:; (virtual), + 4: 0:var, 4:y (identifier), 6:=, 8:async, 14:x (identifier), 16:=>, 19:x (identifier), 0:; (virtual), + 5: 0:var, 4:y (identifier), 6:=, 8:async, 14:=>, 17:async, 0:; (virtual), |}] diff --git a/compiler/tests-compiler/jsopt.ml b/compiler/tests-compiler/jsopt.ml index 10f0b9fc98..2ae7ab2900 100644 --- a/compiler/tests-compiler/jsopt.ml +++ b/compiler/tests-compiler/jsopt.ml @@ -337,9 +337,9 @@ let%expect_test "string sharing" = {"use strict"; var str_npi_xcf_x80="npi\xcf\x80", + str_abcdef="abcdef", str_npi="npiπ", str_abc_def="abc\\def", - str_abcdef="abcdef", runtime=globalThis.jsoo_runtime, s3=str_abcdef, s6=str_npi_xcf_x80, @@ -448,9 +448,9 @@ let%expect_test "string sharing" = {"use strict"; var str_npi_xcf_x80="npi\xcf\x80", + str_abcdef="abcdef", str_npi="npiπ", str_abc_def="abc\\def", - str_abcdef="abcdef", runtime=globalThis.jsoo_runtime, caml_string_of_jsbytes=runtime.caml_string_of_jsbytes, s3=caml_string_of_jsbytes(str_abcdef), diff --git a/compiler/tests-compiler/minify.ml b/compiler/tests-compiler/minify.ml index 77f3602e6c..647ca06dfb 100644 --- a/compiler/tests-compiler/minify.ml +++ b/compiler/tests-compiler/minify.ml @@ -154,3 +154,107 @@ try { throw 1; } catch (xx) { a(0) } 3: try { throw 1; } catch (xx) { a(0) } $ cat "test.min.js" 1: a=function(){return 0};try{throw 1}catch(b){a(0)} |}]) + +let%expect_test _ = + with_temp_dir ~f:(fun () -> + let js_prog = + {| +a = function (yyyy) { +try { var xxxxx = 3; var bbb = 2; throw 1; } catch (xx) { const bbb = a(0) } } +|} + in + let js_file = + js_prog |> Filetype.js_text_of_string |> Filetype.write_js ~name:"test.js" + in + let js_min_file = + js_file |> jsoo_minify ~flags:[ "--enable"; "shortvar" ] ~pretty:false + in + print_file (Filetype.path_of_js_file js_file); + print_file (Filetype.path_of_js_file js_min_file); + [%expect + {| + $ cat "test.js" + 1: + 2: a = function (yyyy) { + 3: try { var xxxxx = 3; var bbb = 2; throw 1; } catch (xx) { const bbb = a(0) } } + $ cat "test.min.js" + 1: a=function(b){try{var + 2: e=3,d=2;throw 1}catch(c){const + 3: b=a(0)}}; |}]) + +let%expect_test _ = + with_temp_dir ~f:(fun () -> + let js_prog = + {| +a = function (aaa,b,c,yyy) { + if (true) { let xxx = 2; var y = 3; return xxx + xxx } + else { let xxx = 3; let aaa = xxx; return xxx * yyy } + } +|} + in + let js_file = + js_prog |> Filetype.js_text_of_string |> Filetype.write_js ~name:"test.js" + in + let js_min_file = + js_file |> jsoo_minify ~flags:[ "--enable"; "shortvar" ] ~pretty:false + in + print_file (Filetype.path_of_js_file js_file); + print_file (Filetype.path_of_js_file js_min_file); + [%expect + {| + $ cat "test.js" + 1: + 2: a = function (aaa,b,c,yyy) { + 3: if (true) { let xxx = 2; var y = 3; return xxx + xxx } + 4: else { let xxx = 3; let aaa = xxx; return xxx * yyy } + 5: } + $ cat "test.min.js" + 1: a=function(b,c,d,e){if(true){let + 2: b=2;var + 3: f=3;return b+b}else{let + 4: b=3,c=b;return b*e}}; |}]) + +let%expect_test _ = + with_temp_dir ~f:(fun () -> + let js_prog = + {| + var long1 = 1; + let long2 = 2; + const long3 = 3; + function f () { + var long1 = 1; + let long2 = 2; + const long3 = 3; + } + |} + in + let js_file = + js_prog |> Filetype.js_text_of_string |> Filetype.write_js ~name:"test.js" + in + let js_min_file = + js_file |> jsoo_minify ~flags:[ "--enable"; "shortvar" ] ~pretty:false + in + print_file (Filetype.path_of_js_file js_file); + print_file (Filetype.path_of_js_file js_min_file); + [%expect + {| + $ cat "test.js" + 1: + 2: var long1 = 1; + 3: let long2 = 2; + 4: const long3 = 3; + 5: function f () { + 6: var long1 = 1; + 7: let long2 = 2; + 8: const long3 = 3; + 9: } + 10: + $ cat "test.min.js" + 1: var + 2: long1=1;let + 3: a=2;const + 4: b=3;function + 5: f(){var + 6: a=1;let + 7: b=2;const + 8: c=3} |}]) diff --git a/compiler/tests-compiler/sourcemap.ml b/compiler/tests-compiler/sourcemap.ml index 4b0a71e1e4..e1c84eb42e 100644 --- a/compiler/tests-compiler/sourcemap.ml +++ b/compiler/tests-compiler/sourcemap.ml @@ -71,7 +71,6 @@ let%expect_test _ = 10: (globalThis)); 11: 12: //# sourceMappingURL=test.map - null:-1:-1 -> 5:4 /dune-root/test.ml:1:4 -> 6:13 /dune-root/test.ml:1:7 -> 6:16 /dune-root/test.ml:1:11 -> 6:19 diff --git a/compiler/tests-compiler/util/util.ml b/compiler/tests-compiler/util/util.ml index 5211fd88ce..62fc613f07 100644 --- a/compiler/tests-compiler/util/util.ml +++ b/compiler/tests-compiler/util/util.ml @@ -172,7 +172,7 @@ let channel_to_string c_in = (try loop () with End_of_file -> ()); Buffer.contents buffer -let exec_to_string_exn ~fail ~cmd = +let exec_to_string_exn ?input ~fail ~cmd () = let build_path_prefix_map = "BUILD_PATH_PREFIX_MAP=" in let cwd = Sys.getcwd () in let build_path = @@ -204,7 +204,12 @@ let exec_to_string_exn ~fail ~cmd = | WSTOPPED i -> Format.sprintf "%s\nprocess stopped with signal number %d\n %s\n" std_out i cmd in - let ((proc_in, _, proc_err) as proc_full) = Unix.open_process_full cmd env in + let ((proc_in, oc, proc_err) as proc_full) = Unix.open_process_full cmd env in + (match input with + | None -> () + | Some s -> + output_string oc s; + close_out oc); let results = channel_to_string proc_in in let results' = channel_to_string proc_err in let exit_status = Unix.close_process_full proc_full in @@ -229,11 +234,22 @@ let run_javascript file = exec_to_string_exn ~fail:false ~cmd:(Format.sprintf "%s %s" node (Filetype.path_of_js_file file)) + () + +let check_javascript file = + exec_to_string_exn + ~fail:false + ~cmd:(Format.sprintf "%s --check %s" node (Filetype.path_of_js_file file)) + () + +let check_javascript_source source = + exec_to_string_exn ~input:source ~fail:false ~cmd:(Format.sprintf "%s --check" node) () let run_bytecode file = exec_to_string_exn ~fail:false ~cmd:(Format.sprintf "%s %s" ocamlrun (Filetype.path_of_bc_file file)) + () let swap_extention filename ~ext = Format.sprintf "%s.%s" (Filename.remove_extension filename) ext @@ -296,11 +312,16 @@ let compile_to_javascript in let cmd = Format.sprintf "%s %s %s -o %s" compiler_location extra_args file out_file in - let stdout = exec_to_string_exn ~fail:true ~cmd in + let stdout = exec_to_string_exn ~fail:true ~cmd () in print_string stdout; (* this print shouldn't do anything, so if something weird happens, we'll get the results here *) - Filetype.js_file_of_path out_file + let jsfile = Filetype.js_file_of_path out_file in + let stdout = check_javascript jsfile in + print_string stdout; + (* this print shouldn't do anything, so if + something weird happens, we'll get the results here *) + jsfile let jsoo_minify ?(flags = []) ~pretty file = let file = Filetype.path_of_js_file file in @@ -312,7 +333,7 @@ let jsoo_minify ?(flags = []) ~pretty file = in let cmd = Format.sprintf "%s %s %s -o %s" compiler_location extra_args file out_file in - let stdout = exec_to_string_exn ~fail:true ~cmd in + let stdout = exec_to_string_exn ~fail:true ~cmd () in print_string stdout; (* this print shouldn't do anything, so if something weird happens, we'll get the results here *) @@ -356,6 +377,7 @@ let compile_ocaml_to_cmo ?(debug = true) file = (if debug then "-g" else "") file out_file) + () in print_string stdout; Filetype.cmo_file_of_path out_file @@ -374,6 +396,7 @@ let compile_ocaml_to_bc ?(debug = true) ?(unix = false) file = (if unix then "-I +unix unix.cma" else "") file out_file) + () in print_string stdout; Filetype.bc_file_of_path out_file @@ -389,6 +412,7 @@ let compile_lib list name = ocamlc (String.concat ~sep:" " (List.map ~f:Filetype.path_of_cmo_file list)) out_file) + () in print_string stdout; Filetype.cmo_file_of_path out_file @@ -405,19 +429,19 @@ let program_to_string ?(compact = false) p = let expression_to_string ?(compact = false) e = let module J = Jsoo.Javascript in - let p = [ J.Statement (J.Expression_statement e), J.N ] in + let p = [ J.Expression_statement e, J.N ] in program_to_string ~compact p class find_variable_declaration r n = object inherit Jsoo.Js_traverse.map as super - method! variable_declaration v = + method! variable_declaration k v = (match v with - | Jsoo.Javascript.S { name = Utf8 name; _ }, _ when String.equal name n -> - r := v :: !r + | DeclIdent (Jsoo.Javascript.S { name = Utf8 name; _ }, _) when String.equal name n + -> r := v :: !r | _ -> ()); - super#variable_declaration v + super#variable_declaration k v end let print_var_decl program n = @@ -426,26 +450,34 @@ let print_var_decl program n = ignore (o#program program); print_string (Format.sprintf "var %s = " n); match !r with - | [ (_, Some (expression, _)) ] -> print_string (expression_to_string expression) + | [ DeclIdent (_, Some (expression, _)) ] -> + print_string (expression_to_string expression) | _ -> print_endline "not found" class find_function_declaration r n = object inherit Jsoo.Js_traverse.map as super - method! source s = + method! statement s = + let open Jsoo.Javascript in (match s with - | Function_declaration fd -> - let record = - match fd, n with - | _, None -> true - | (Jsoo.Javascript.S { name = Utf8 name; _ }, _, _, _), Some n -> - String.equal name n - | _ -> false - in - if record then r := fd :: !r - | Statement _ -> ()); - super#source s + | Variable_statement (_, l) -> + List.iter l ~f:(function + | DeclIdent ((S { name = Utf8 name; _ } as id), Some (EFun (_, fun_decl), _)) + -> ( + let fd = id, fun_decl in + match n with + | None -> r := fd :: !r + | Some n -> if String.equal name n then r := fd :: !r else ()) + | _ -> ()) + | Function_declaration (name, fun_decl) -> ( + match name, n with + | _, None -> r := (name, fun_decl) :: !r + | S { name = Utf8 s; _ }, Some n -> + if String.equal s n then r := (name, fun_decl) :: !r else () + | _ -> ()) + | _ -> ()); + super#statement s end let print_program p = print_string (program_to_string p) @@ -456,7 +488,8 @@ let print_fun_decl program n = ignore (o#program program); let module J = Jsoo.Javascript in match !r with - | [ fd ] -> print_string (program_to_string [ J.Function_declaration fd, J.N ]) + | [ (n, fd) ] -> + print_string (program_to_string [ J.Function_declaration (n, fd), J.N ]) | [] -> print_endline "not found" | l -> print_endline (Format.sprintf "%d functions found" (List.length l)) @@ -469,7 +502,14 @@ let compile_and_run_bytecode ?unix s = |> run_bytecode |> print_endline) -let compile_and_run ?debug ?(flags = []) ?effects ?use_js_string ?unix s = +let compile_and_run + ?debug + ?(skip_modern = false) + ?(flags = []) + ?effects + ?use_js_string + ?unix + s = with_temp_dir ~f:(fun () -> let bytecode_file = s @@ -486,22 +526,24 @@ let compile_and_run ?debug ?(flags = []) ?effects ?use_js_string ?unix s = bytecode_file |> run_javascript in - let output_with_stdlib_modern = - compile_bc_to_javascript - ~flags:(flags @ [ "+stdlib_modern.js" ]) - ?effects - ?use_js_string - ?sourcemap:debug - bytecode_file - |> run_javascript - in print_endline output_without_stdlib_modern; - if not (String.equal output_without_stdlib_modern output_with_stdlib_modern) - then ( - print_endline "Output was different with stdlib_modern.js:"; - print_endline "==========================================="; - print_string output_with_stdlib_modern; - print_endline "===========================================")) + if not skip_modern + then + let output_with_stdlib_modern = + compile_bc_to_javascript + ~flags:(flags @ [ "+stdlib_modern.js" ]) + ?effects + ?use_js_string + ?sourcemap:debug + bytecode_file + |> run_javascript + in + if not (String.equal output_without_stdlib_modern output_with_stdlib_modern) + then ( + print_endline "Output was different with stdlib_modern.js:"; + print_endline "==========================================="; + print_string output_with_stdlib_modern; + print_endline "===========================================")) let compile_and_parse_whole_program ?(debug = true) ?flags ?effects ?use_js_string ?unix s = diff --git a/compiler/tests-compiler/util/util.mli b/compiler/tests-compiler/util/util.mli index f433e89e59..5cdf488398 100644 --- a/compiler/tests-compiler/util/util.mli +++ b/compiler/tests-compiler/util/util.mli @@ -57,6 +57,10 @@ val extract_sourcemap : Filetype.js_file -> Js_of_ocaml_compiler.Source_map.t op val run_javascript : Filetype.js_file -> string +val check_javascript : Filetype.js_file -> string + +val check_javascript_source : string -> string + val expression_to_string : ?compact:bool -> Javascript.expression -> string val print_file : string -> unit @@ -69,6 +73,7 @@ val print_fun_decl : Javascript.program -> string option -> unit val compile_and_run : ?debug:bool + -> ?skip_modern:bool -> ?flags:string list -> ?effects:bool -> ?use_js_string:bool diff --git a/compiler/tests-js-parser/dune b/compiler/tests-js-parser/dune new file mode 100644 index 0000000000..0af1851523 --- /dev/null +++ b/compiler/tests-js-parser/dune @@ -0,0 +1,6 @@ +(executable + (name run) + (libraries js_of_ocaml_compiler unix str)) + +;; $ git clone git@github.com:tc39/test262-parser-tests.git +;; $ dune exe compiler/tests-js-parser/run.exe test262-parser-tests/pass/* diff --git a/compiler/tests-js-parser/run.ml b/compiler/tests-js-parser/run.ml new file mode 100644 index 0000000000..c8791dea98 --- /dev/null +++ b/compiler/tests-js-parser/run.ml @@ -0,0 +1,125 @@ +open Js_of_ocaml_compiler +open Stdlib + +let failure_expected = ref false + +let flags, files = + Sys.argv + |> Array.to_list + |> List.tl + |> List.partition ~f:(fun x -> Char.equal (String.get x 0) '-') + +let () = + List.iter flags ~f:(function + | "-fail" -> failure_expected := true + | f -> failwith ("unrecognised flag " ^ f)) + +let unsupported_syntax = ref [] + +let fail = ref [] + +let pass = ref [] + +let rs = + [ Str.regexp_string "import" + ; Str.regexp_string "export" + ; Str.regexp_string "with" + ; Str.regexp_string "" + ] + +let has_unsupported_syntax c = + List.exists rs ~f:(fun r -> + try + let (_ : int) = Str.search_forward r c 0 in + true + with Not_found -> false) + +class clean_loc = + object + inherit Js_traverse.map + + method! loc _ = N + end + +let clean_loc = new clean_loc + +let clean_loc p = clean_loc#program p + +let p_to_string p = + let buffer = Buffer.create 100 in + let pp = Pretty_print.to_buffer buffer in + let _ = Js_output.program pp p in + Buffer.contents buffer + +let patdiff = false + +let vs_explicit = false + +let () = + List.iter files ~f:(fun filename -> + let ic = open_in_bin filename in + let content = In_channel.input_all ic in + let add r = r := (filename, content) :: !r in + close_in ic; + try + let p1 = Parse_js.Lexer.of_string ~filename content |> Parse_js.parse in + if patdiff + then ( + let s = p_to_string (clean_loc p1) in + let jsoo_name = filename ^ ".jsoo" in + let oc = open_out_bin jsoo_name in + output_string oc s; + close_out oc; + let _ret = Sys.command (Printf.sprintf "patdiff %s %s" filename jsoo_name) in + ()); + (if vs_explicit + then + try + let explicit = + Filename.( + concat + (concat (dirname (dirname filename)) "pass-explicit") + (basename filename)) + in + let ic = open_in_bin explicit in + let content = In_channel.input_all ic in + close_in ic; + let p2 = + Parse_js.Lexer.of_string ~filename:explicit content |> Parse_js.parse + in + let p1 = clean_loc p1 and p2 = clean_loc p2 in + let p1s = p_to_string p1 and p2s = p_to_string p2 in + if Poly.(p1 <> p2) + then ( + Printf.printf ">>>>>>> MISMATCH %s <<<<<<<<<<\n" filename; + Printf.printf "%s\n\n%s\n" p1s p2s) + with _ -> ()); + add pass + with Parse_js.Parsing_error loc -> + if has_unsupported_syntax content + then add unsupported_syntax + else fail := (filename, loc, content) :: !fail); + Printf.printf "Summary:\n"; + Printf.printf " skip : %d\n" (List.length !unsupported_syntax); + Printf.printf " fail : %d\n" (List.length !fail); + Printf.printf " pass : %d\n" (List.length !pass); + let l = !fail in + if !failure_expected + then + List.iter !pass ~f:(fun (f, c) -> + Printf.printf "succeded to parse %s\n" f; + Printf.printf "%s\n\n" c) + else + List.iter l ~f:(fun (f, (pi : Parse_info.t), c) -> + Printf.printf "failed to parse %s:%d:%d\n" f pi.line pi.col; + List.iteri (String.split_on_char ~sep:'\n' c) ~f:(fun i c -> + if i + 1 = pi.line + then ( + let b = Buffer.create (String.length c) in + String.fold_utf_8 c () ~f:(fun () i u -> + if i = pi.col then Buffer.add_utf_8_uchar b (Uchar.of_int 0x274C); + Buffer.add_utf_8_uchar b u); + Printf.printf "%s\n" (Buffer.contents b)) + else Printf.printf "%s\n" c); + Printf.printf "\n") diff --git a/compiler/tests-sourcemap/dump.reference b/compiler/tests-sourcemap/dump.reference index 051d20e5d5..bd61924d34 100644 --- a/compiler/tests-sourcemap/dump.reference +++ b/compiler/tests-sourcemap/dump.reference @@ -5,5 +5,5 @@ b.ml:1:10 -> 18: function f(x){<>return x - 1 | 0} b.ml:1:6 -> 25: function f(x){return <>x - 1 | 0} b.ml:1:15 -> 34: function f(x){return x - 1 | 0<>} b.ml:1:4 -> 21: var Testlib_B=[0,<>f]; -a.ml:-1:-1 -> 4: <>var runtime=globalThis.jsoo_runtime; +a.ml:-1:-1 -> 4: <>function caml_call1(f,a0) a.ml:-1:-1 -> 44: throw [0,Int,caml_call1(Testlib_B[1],2)]<>}