From ffb6e9add8109073bc613e9d7e082ec5ded86262 Mon Sep 17 00:00:00 2001 From: Dmitry Zakharov Date: Thu, 8 Aug 2024 01:04:48 +0400 Subject: [PATCH 1/5] Remove unused non-bs code --- jscomp/ext/config.ml | 2 - jscomp/ext/config.mli | 2 - jscomp/ml/cmt_format.ml | 4 +- jscomp/ml/ctype.ml | 11 ----- jscomp/ml/env.ml | 2 +- jscomp/ml/matching.ml | 98 +++++------------------------------------ jscomp/ml/predef.ml | 12 ----- jscomp/ml/predef.mli | 7 --- jscomp/ml/switch.ml | 32 +++----------- jscomp/ml/typedecl.ml | 13 +----- jscomp/ml/typetexp.ml | 9 ---- 11 files changed, 19 insertions(+), 173 deletions(-) diff --git a/jscomp/ext/config.ml b/jscomp/ext/config.ml index 3526004ad1..4f75158c25 100644 --- a/jscomp/ext/config.ml +++ b/jscomp/ext/config.ml @@ -7,8 +7,6 @@ let standard_library = let standard_library_default = standard_library -let bs_only = ref true - let unsafe_empty_array = ref false let cmi_magic_number = "Caml1999I022" diff --git a/jscomp/ext/config.mli b/jscomp/ext/config.mli index ddfef8eba6..0bd4de3027 100644 --- a/jscomp/ext/config.mli +++ b/jscomp/ext/config.mli @@ -21,8 +21,6 @@ val version : string val standard_library : string (* The directory containing the standard libraries *) -val bs_only : bool ref - val unsafe_empty_array : bool ref val load_path : string list ref diff --git a/jscomp/ml/cmt_format.ml b/jscomp/ml/cmt_format.ml index ff83baa422..907f2e7122 100644 --- a/jscomp/ml/cmt_format.ml +++ b/jscomp/ml/cmt_format.ml @@ -174,9 +174,7 @@ open Cmi_format let save_cmt filename modname binary_annots sourcefile initial_env cmi = if !Clflags.binary_annotations then begin - (if !Config.bs_only then Misc.output_to_bin_file_directly else - Misc.output_to_file_via_temporary - ~mode:[Open_binary] ) filename + Misc.output_to_bin_file_directly filename (fun temp_file_name oc -> let this_crc = match cmi with diff --git a/jscomp/ml/ctype.ml b/jscomp/ml/ctype.ml index d3b1a325b8..9adf2b55a7 100644 --- a/jscomp/ml/ctype.ml +++ b/jscomp/ml/ctype.ml @@ -2534,16 +2534,6 @@ and unify_row env row1 row2 = let rm1 = row_more row1 and rm2 = row_more row2 in if unify_eq rm1 rm2 then () else let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in - if not !Config.bs_only && (r1 <> [] && r2 <> []) then begin - (* pairs are the intersection, r1 , r2 should be disjoint *) - let ht = Hashtbl.create (List.length r1) in - List.iter (fun (l,_) -> Hashtbl.add ht (hash_variant l) l) r1; - List.iter - (fun (l,_) -> - try raise (Tags(l, Hashtbl.find ht (hash_variant l))) - with Not_found -> ()) - r2 - end; let fixed1 = row_fixed row1 and fixed2 = row_fixed row2 in let more = if fixed1 then rm1 else @@ -3712,7 +3702,6 @@ let rec subtype_rec env trace t1 t2 cstrs = (trace, t1, t2, !univar_pairs)::cstrs end | Tvariant v, _ when - !Config.bs_only && !variant_is_subtype env (row_repr v) t2 -> cstrs diff --git a/jscomp/ml/env.ml b/jscomp/ml/env.ml index af9308691a..b5a6c4f8ef 100644 --- a/jscomp/ml/env.ml +++ b/jscomp/ml/env.ml @@ -1117,7 +1117,7 @@ and lookup_module ~load ?loc lid env : Path.t = (* see #5965 *) raise Recmodule | Mty_alias (_, Path.Pident id) -> - if !Config.bs_only && not !Clflags.transparent_modules && Ident.persistent id then + if not !Clflags.transparent_modules && Ident.persistent id then find_pers_struct (Ident.name id) |> ignore | _ -> () end; diff --git a/jscomp/ml/matching.ml b/jscomp/ml/matching.ml index ff213fac65..9dde41874e 100644 --- a/jscomp/ml/matching.ml +++ b/jscomp/ml/matching.ml @@ -1335,7 +1335,6 @@ let make_constr_matching p def ctx = function (arg, Alias) :: argl else match cstr.cstr_tag with | Cstr_block _ when - !Config.bs_only && Datarepr.constructor_has_optional_shape cstr -> begin @@ -2280,7 +2279,6 @@ let split_extension_cases tag_lambda_list = | (cstr, act) :: rem -> let (consts, nonconsts) = split_rec rem in match cstr with - Cstr_extension(path, true) when not !Config.bs_only -> ((path, act) :: consts, nonconsts) | Cstr_extension(path, _) -> (consts, (path, act) :: nonconsts) | _ -> assert false in split_rec tag_lambda_list @@ -2309,17 +2307,13 @@ let combine_constructor sw_names loc arg ex_pat cstr partial ctx def match nonconsts with [] -> default | _ -> - let tag = Ident.create "tag" in - let tests = - List.fold_right - (fun (path, act) rem -> - let ext = transl_extension_path ex_pat.pat_env path in - Lifthenelse(Lprim(extension_slot_eq , [Lvar tag; ext], loc), - act, rem)) - nonconsts - default - in - Llet(Alias, Pgenval,tag, arg, tests) + List.fold_right + (fun (path, act) rem -> + let ext = transl_extension_path ex_pat.pat_env path in + Lifthenelse(Lprim(extension_slot_eq , [arg; ext], loc), + act, rem)) + nonconsts + default in List.fold_right (fun (path, act) rem -> @@ -2355,7 +2349,7 @@ let combine_constructor sw_names loc arg ex_pat cstr partial ctx def (* Typically, match on lists, will avoid isint primitive in that case *) let arg = - if !Config.bs_only && Datarepr.constructor_has_optional_shape cstr then + if Datarepr.constructor_has_optional_shape cstr then Lprim(is_not_none_bs_primitve , [arg], loc) else arg in @@ -2452,10 +2446,7 @@ let combine_variant names loc row arg partial ctx def else num_constr := max_int; let test_int_or_block arg if_int if_block = - if !Config.bs_only then - Lifthenelse(Lprim (Pccall(Primitive.simple ~name:"#is_poly_var_block" ~arity:1 ~alloc:false), [arg], loc), if_block, if_int) - else - Lifthenelse(Lprim (Pisint, [arg], loc), if_int, if_block) in + Lifthenelse(Lprim (Pccall(Primitive.simple ~name:"#is_poly_var_block" ~arity:1 ~alloc:false), [arg], loc), if_block, if_int) in let sig_complete = List.length tag_lambda_list = !num_constr and one_action = same_actions tag_lambda_list in (* reduandant work under bs context *) let fail, local_jumps = @@ -3001,67 +2992,6 @@ let simple_for_let loc param pat body = catch/exit. *) -let rec map_return f = function - | Llet (str, k, id, l1, l2) -> Llet (str, k, id, l1, map_return f l2) - | Lletrec (l1, l2) -> Lletrec (l1, map_return f l2) - | Lifthenelse (lcond, lthen, lelse) -> - Lifthenelse (lcond, map_return f lthen, map_return f lelse) - | Lsequence (l1, l2) -> Lsequence (l1, map_return f l2) - | Ltrywith (l1, id, l2) -> Ltrywith (map_return f l1, id, map_return f l2) - | Lstaticcatch (l1, b, l2) -> - Lstaticcatch (map_return f l1, b, map_return f l2) - | Lstaticraise _ | Lprim(Praise _, _, _) as l -> l - | l -> f l - -(* The 'opt' reference indicates if the optimization is worthy. - - It is shared by the different calls to 'assign_pat' performed from - 'map_return'. For example with the code - let (x, y) = if foo then z else (1,2) - the else-branch will activate the optimization for both branches. - - That means that the optimization is activated if *there exists* an - interesting tuple in one hole of the let-rhs context. We could - choose to activate it only if *all* holes are interesting. We made - that choice because being optimistic is extremely cheap (one static - exit/catch overhead in the "wrong cases"), while being pessimistic - can be costly (one unnecessary tuple allocation). -*) - -let assign_pat opt nraise catch_ids loc pat lam = - let rec collect acc pat lam = match pat.pat_desc, lam with - | Tpat_tuple patl, Lprim(Pmakeblock _, lams, _) -> - opt := true; - List.fold_left2 collect acc patl lams - | Tpat_tuple patl, Lconst(Const_block( _, scl)) -> - opt := true; - let collect_const acc pat sc = collect acc pat (Lconst sc) in - List.fold_left2 collect_const acc patl scl - | _ -> - (* pattern idents will be bound in staticcatch (let body), so we - refresh them here to guarantee binders uniqueness *) - let pat_ids = pat_bound_idents pat in - let fresh_ids = List.map (fun id -> id, Ident.rename id) pat_ids in - (fresh_ids, alpha_pat fresh_ids pat, lam) :: acc - in - - (* sublets were accumulated by 'collect' with the leftmost tuple - pattern at the bottom of the list; to respect right-to-left - evaluation order for tuples, we must evaluate sublets - top-to-bottom. To preserve tail-rec, we will fold_left the - reversed list. *) - let rev_sublets = List.rev (collect [] pat lam) in - let exit = - (* build an Ident.tbl to avoid quadratic refreshing costs *) - let add t (id, fresh_id) = Ident.add id fresh_id t in - let add_ids acc (ids, _pat, _lam) = List.fold_left add acc ids in - let tbl = List.fold_left add_ids Ident.empty rev_sublets in - let fresh_var id = Lvar (Ident.find_same id tbl) in - Lstaticraise(nraise, List.map fresh_var catch_ids) - in - let push_sublet code (_ids, pat, lam) = simple_for_let loc lam pat code in - List.fold_left push_sublet exit rev_sublets - let for_let loc param pat body = match pat.pat_desc with | Tpat_any -> @@ -3072,15 +3002,7 @@ let for_let loc param pat body = (* fast path, and keep track of simple bindings to unboxable numbers *) Llet(Strict, Pgenval, id, param, body) | _ -> - (* Turn off such optimization to reduce diff in the beginning - FIXME*) - if !Config.bs_only then simple_for_let loc param pat body - else - let opt = ref false in - let nraise = next_raise_count () in - let catch_ids = pat_bound_idents pat in - let bind = map_return (assign_pat opt nraise catch_ids loc pat) param in - if !opt then Lstaticcatch(bind, (nraise, catch_ids), body) - else simple_for_let loc param pat body + simple_for_let loc param pat body (* Handling of tupled functions and matchings *) diff --git a/jscomp/ml/predef.ml b/jscomp/ml/predef.ml index fb45e343d2..3e789ec8eb 100644 --- a/jscomp/ml/predef.ml +++ b/jscomp/ml/predef.ml @@ -140,18 +140,6 @@ and ident_assert_failure = ident_create_predef_exn "Assert_failure" and ident_undefined_recursive_module = ident_create_predef_exn "Undefined_recursive_module" -let all_predef_exns = [ - ident_match_failure; - ident_invalid_argument; - ident_failure; - ident_js_error; - ident_not_found; - ident_end_of_file; - ident_division_by_zero; - ident_assert_failure; - ident_undefined_recursive_module; -] - let path_match_failure = Pident ident_match_failure and path_assert_failure = Pident ident_assert_failure and path_undefined_recursive_module = Pident ident_undefined_recursive_module diff --git a/jscomp/ml/predef.mli b/jscomp/ml/predef.mli index a8049b5325..6012116830 100644 --- a/jscomp/ml/predef.mli +++ b/jscomp/ml/predef.mli @@ -77,13 +77,6 @@ val build_initial_env: val builtin_values: (string * Ident.t) list val builtin_idents: (string * Ident.t) list -(** All predefined exceptions, exposed as [Ident.t] for flambda (for - building value approximations). - The [Ident.t] for division by zero is also exported explicitly - so flambda can generate code to raise it. *) -val ident_division_by_zero: Ident.t -val all_predef_exns : Ident.t list - type test = | For_sure_yes | For_sure_no diff --git a/jscomp/ml/switch.ml b/jscomp/ml/switch.ml index a4bab631ef..c8a1d9cdc5 100644 --- a/jscomp/ml/switch.ml +++ b/jscomp/ml/switch.ml @@ -560,15 +560,8 @@ and enum top cases = do_make_if_out (Arg.make_const d) ctx.arg (mk_ifso ctx) (mk_ifno ctx) | _ -> - if (*true || *)!Config.bs_only then - do_make_if_out - (Arg.make_const d) (Arg.make_offset ctx.arg (-l)) (mk_ifso ctx) (mk_ifno ctx) else - Arg.bind - (Arg.make_offset ctx.arg (-l)) - (fun arg -> - let ctx = {off= (-l+ctx.off) ; arg=arg} in - do_make_if_out - (Arg.make_const d) arg (mk_ifso ctx) (mk_ifno ctx)) + do_make_if_out + (Arg.make_const d) (Arg.make_offset ctx.arg (-l)) (mk_ifso ctx) (mk_ifno ctx) let do_make_if_in h arg ifso ifno = Arg.make_if (Arg.make_isin h arg) ifso ifno @@ -578,15 +571,8 @@ and enum top cases = do_make_if_in (Arg.make_const d) ctx.arg (mk_ifso ctx) (mk_ifno ctx) | _ -> - if (*true || *) !Config.bs_only then - do_make_if_in - (Arg.make_const d) (Arg.make_offset ctx.arg (-l)) (mk_ifso ctx) (mk_ifno ctx) else - Arg.bind - (Arg.make_offset ctx.arg (-l)) - (fun arg -> - let ctx = {off= (-l+ctx.off) ; arg=arg} in - do_make_if_in - (Arg.make_const d) arg (mk_ifso ctx) (mk_ifno ctx)) + do_make_if_in + (Arg.make_const d) (Arg.make_offset ctx.arg (-l)) (mk_ifso ctx) (mk_ifno ctx) let rec c_test ctx ({cases=cases ; actions=actions} as s) = let lcases = Array.length cases in @@ -756,15 +742,7 @@ let make_switch loc {cases=cases ; actions=actions} i j sw_names = (fun act i -> acts.(i) <- actions.(act)) t ; (fun ctx -> - if !Config.bs_only then - Arg.make_switch ~offset:(ll+ctx.off) loc ctx.arg tbl acts sw_names - else - match -ll-ctx.off with - | 0 -> Arg.make_switch loc ctx.arg tbl acts sw_names ~offset:0 - | _ -> - Arg.bind - (Arg.make_offset ctx.arg (-ll-ctx.off)) - (fun arg -> Arg.make_switch loc arg tbl acts sw_names ~offset:0)) + Arg.make_switch ~offset:(ll+ctx.off) loc ctx.arg tbl acts sw_names) let make_clusters loc ({cases=cases ; actions=actions} as s) n_clusters k sw_names = diff --git a/jscomp/ml/typedecl.ml b/jscomp/ml/typedecl.ml index cdb97223cb..70f8b5ecf3 100644 --- a/jscomp/ml/typedecl.ml +++ b/jscomp/ml/typedecl.ml @@ -208,18 +208,9 @@ let make_params env params = List.map make_param params let transl_labels ?record_name env closed lbls = - if !Config.bs_only then - match !Builtin_attributes.check_duplicated_labels lbls with + (match !Builtin_attributes.check_duplicated_labels lbls with | None -> () - | Some {loc;txt=name} -> raise (Error(loc,Duplicate_label (name, record_name))) - else ( - let all_labels = ref StringSet.empty in - List.iter - (fun {pld_name = {txt=name; loc}} -> - if StringSet.mem name !all_labels then - raise(Error(loc, Duplicate_label (name, record_name))); - all_labels := StringSet.add name !all_labels) - lbls); + | Some {loc;txt=name} -> raise (Error(loc,Duplicate_label (name, record_name)))); let mk {pld_name=name;pld_mutable=mut;pld_type=arg;pld_loc=loc; pld_attributes=attrs} = Builtin_attributes.warning_scope attrs diff --git a/jscomp/ml/typetexp.ml b/jscomp/ml/typetexp.ml index 4365194ea6..def4427a3b 100644 --- a/jscomp/ml/typetexp.ml +++ b/jscomp/ml/typetexp.ml @@ -411,16 +411,7 @@ and transl_type_aux env policy styp = row_bound=(); row_closed=true; row_fixed=false; row_name=None}) in let hfields = Hashtbl.create 17 in - let collection_detect = Hashtbl.create 17 in let add_typed_field loc l f = - if not !Config.bs_only then begin - let h = Btype.hash_variant l in - if Hashtbl.mem collection_detect h then - let l' = Hashtbl.find collection_detect h in - (* Check for tag conflicts *) - if l <> l' then raise(Error(styp.ptyp_loc, env, Variant_tags(l, l'))); - else Hashtbl.add collection_detect h l - end ; try let (_,f') = Hashtbl.find hfields l in let ty = mkfield l f and ty' = mkfield l f' in From f1432ad235a3eddba7b03130ba15f6acf8701b6f Mon Sep 17 00:00:00 2001 From: Dmitry Zakharov Date: Thu, 8 Aug 2024 01:29:29 +0400 Subject: [PATCH 2/5] Remove unreachable case with const extention cases --- jscomp/ml/matching.ml | 36 +++++++++++++----------------------- 1 file changed, 13 insertions(+), 23 deletions(-) diff --git a/jscomp/ml/matching.ml b/jscomp/ml/matching.ml index 9dde41874e..8f51c0c895 100644 --- a/jscomp/ml/matching.ml +++ b/jscomp/ml/matching.ml @@ -2273,13 +2273,13 @@ let split_variant_cases tag_lambda_list = sort_int_lambda_list const, sort_int_lambda_list nonconst -let split_extension_cases tag_lambda_list = +let get_extension_cases tag_lambda_list = let rec split_rec = function - [] -> ([], []) + [] -> [] | (cstr, act) :: rem -> - let (consts, nonconsts) = split_rec rem in + let nonconsts = split_rec rem in match cstr with - | Cstr_extension(path, _) -> (consts, (path, act) :: nonconsts) + | Cstr_extension(path, _) -> ((path, act) :: nonconsts) | _ -> assert false in split_rec tag_lambda_list @@ -2293,35 +2293,25 @@ let combine_constructor sw_names loc arg ex_pat cstr partial ctx def let fail, local_jumps = mk_failaction_neg partial ctx def in let lambda1 = - let consts, nonconsts = split_extension_cases tag_lambda_list in - let default, consts, nonconsts = + let extension_cases = get_extension_cases tag_lambda_list in + let default, extension_cases = match fail with | None -> - begin match consts, nonconsts with - | _, (_, act)::rem -> act, consts, rem - | (_, act)::rem, _ -> act, rem, nonconsts - | _ -> assert false + begin match extension_cases with + | (_, act)::rem -> act, rem + | _ -> failwith "Empty extension case list is not possible" end - | Some fail -> fail, consts, nonconsts in - let nonconst_lambda = - match nonconsts with - [] -> default + | Some fail -> fail, extension_cases in + match extension_cases with + | [] -> default | _ -> List.fold_right (fun (path, act) rem -> let ext = transl_extension_path ex_pat.pat_env path in Lifthenelse(Lprim(extension_slot_eq , [arg; ext], loc), act, rem)) - nonconsts + extension_cases default - in - List.fold_right - (fun (path, act) rem -> - let ext = transl_extension_path ex_pat.pat_env path in - Lifthenelse(Lprim(extension_slot_eq , [arg; ext], loc), - act, rem)) - consts - nonconst_lambda in lambda1, jumps_union local_jumps total1 end else begin From 8a28dafe71082da9d40eb53ea182dc2eb85fc5f8 Mon Sep 17 00:00:00 2001 From: Dmitry Zakharov Date: Thu, 8 Aug 2024 11:06:29 +0400 Subject: [PATCH 3/5] Revert unrelated changes --- jscomp/ml/matching.ml | 20 ++++++++++++-------- jscomp/ml/predef.ml | 12 ++++++++++++ jscomp/ml/predef.mli | 7 +++++++ 3 files changed, 31 insertions(+), 8 deletions(-) diff --git a/jscomp/ml/matching.ml b/jscomp/ml/matching.ml index 8f51c0c895..c0541dfabe 100644 --- a/jscomp/ml/matching.ml +++ b/jscomp/ml/matching.ml @@ -2299,19 +2299,23 @@ let combine_constructor sw_names loc arg ex_pat cstr partial ctx def | None -> begin match extension_cases with | (_, act)::rem -> act, rem - | _ -> failwith "Empty extension case list is not possible" + | _ -> assert false end | Some fail -> fail, extension_cases in match extension_cases with | [] -> default | _ -> - List.fold_right - (fun (path, act) rem -> - let ext = transl_extension_path ex_pat.pat_env path in - Lifthenelse(Lprim(extension_slot_eq , [arg; ext], loc), - act, rem)) - extension_cases - default + let tag = Ident.create "tag" in + let tests = + List.fold_right + (fun (path, act) rem -> + let ext = transl_extension_path ex_pat.pat_env path in + Lifthenelse(Lprim(extension_slot_eq , [Lvar tag; ext], loc), + act, rem)) + extension_cases + default + in + Llet(Alias, Pgenval,tag, arg, tests) in lambda1, jumps_union local_jumps total1 end else begin diff --git a/jscomp/ml/predef.ml b/jscomp/ml/predef.ml index 3e789ec8eb..fb45e343d2 100644 --- a/jscomp/ml/predef.ml +++ b/jscomp/ml/predef.ml @@ -140,6 +140,18 @@ and ident_assert_failure = ident_create_predef_exn "Assert_failure" and ident_undefined_recursive_module = ident_create_predef_exn "Undefined_recursive_module" +let all_predef_exns = [ + ident_match_failure; + ident_invalid_argument; + ident_failure; + ident_js_error; + ident_not_found; + ident_end_of_file; + ident_division_by_zero; + ident_assert_failure; + ident_undefined_recursive_module; +] + let path_match_failure = Pident ident_match_failure and path_assert_failure = Pident ident_assert_failure and path_undefined_recursive_module = Pident ident_undefined_recursive_module diff --git a/jscomp/ml/predef.mli b/jscomp/ml/predef.mli index 6012116830..a8049b5325 100644 --- a/jscomp/ml/predef.mli +++ b/jscomp/ml/predef.mli @@ -77,6 +77,13 @@ val build_initial_env: val builtin_values: (string * Ident.t) list val builtin_idents: (string * Ident.t) list +(** All predefined exceptions, exposed as [Ident.t] for flambda (for + building value approximations). + The [Ident.t] for division by zero is also exported explicitly + so flambda can generate code to raise it. *) +val ident_division_by_zero: Ident.t +val all_predef_exns : Ident.t list + type test = | For_sure_yes | For_sure_no From 39a6e88fc503c174cf95e5e0e09b444a4f3c950a Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Thu, 15 Aug 2024 09:22:46 +0200 Subject: [PATCH 4/5] Add Dockerfile for development container (#6951) --- Makefile | 5 ++++- docker/Dockerfile | 14 ++++++++++++++ 2 files changed, 18 insertions(+), 1 deletion(-) create mode 100644 docker/Dockerfile diff --git a/Makefile b/Makefile index 86acda755f..8bb9fd0741 100644 --- a/Makefile +++ b/Makefile @@ -89,6 +89,9 @@ clean: clean-all: clean clean-gentype +dev-container: + docker build -t rescript-dev-container docker + .DEFAULT_GOAL := build -.PHONY: build watch rewatch ninja bench dce test test-syntax test-syntax-roundtrip test-gentype test-all lib playground playground-cmijs playground-release artifacts format checkformat clean-gentype clean clean-all +.PHONY: build watch rewatch ninja bench dce test test-syntax test-syntax-roundtrip test-gentype test-all lib playground playground-cmijs playground-release artifacts format checkformat clean-gentype clean clean-all dev-container diff --git a/docker/Dockerfile b/docker/Dockerfile new file mode 100644 index 0000000000..b7e011e901 --- /dev/null +++ b/docker/Dockerfile @@ -0,0 +1,14 @@ +FROM rust:1.80.1-bullseye +LABEL org.opencontainers.image.authors="Christoph Knittel " +LABEL org.opencontainers.image.description="Docker image for ReScript development." + +RUN apt update && apt install -y --no-install-recommends ca-certificates curl git rsync opam musl-tools python3 python-is-python3 + +# Node.js +RUN curl -sL https://deb.nodesource.com/setup_20.x | bash - +RUN apt install -y nodejs + +# OCaml +RUN opam init -y --bare --disable-sandboxing git+https://github.com/rescript-lang/opam-repository +RUN opam switch create 5.2.0 --packages ocaml-option-static +RUN opam install -y dune cppo=1.6.9 js_of_ocaml-compiler=5.8.1 ocamlformat=0.26.2 ounit2=2.2.7 reanalyze=2.25.1 \ No newline at end of file From 9a6585663816d69ee35212af7bba555776ac2612 Mon Sep 17 00:00:00 2001 From: Shulhi Sapli Date: Thu, 15 Aug 2024 15:25:08 +0800 Subject: [PATCH 5/5] Skip trailing comma in explicit partial application (#6949) * Check for dotdotdot in args * Check on attribute rather than label * Add tests * Fix naming convention * Update CHANGELOG --- CHANGELOG.md | 3 ++ jscomp/syntax/src/res_parsetree_viewer.ml | 7 +++ jscomp/syntax/src/res_parsetree_viewer.mli | 2 + jscomp/syntax/src/res_printer.ml | 28 +++++++--- jscomp/syntax/tests/printer/expr/apply.res | 34 +++++++++++++ .../tests/printer/expr/expected/apply.res.txt | 51 +++++++++++++++++++ 6 files changed, 118 insertions(+), 7 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8ee29f0853..9c4e84f4d6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -23,6 +23,9 @@ - Removed empty line at the end of `switch` statement - Removed empty `default` case from `switch` statement in the generated code +#### :bug: Bug Fix +- Fix issue where long layout break added a trailing comma in partial application `...`. https://github.com/rescript-lang/rescript-compiler/pull/6949 + # 12.0.0-alpha.1 #### :rocket: New Feature diff --git a/jscomp/syntax/src/res_parsetree_viewer.ml b/jscomp/syntax/src/res_parsetree_viewer.ml index 4b26dc55ec..75d0228442 100644 --- a/jscomp/syntax/src/res_parsetree_viewer.ml +++ b/jscomp/syntax/src/res_parsetree_viewer.ml @@ -57,6 +57,13 @@ let process_partial_app_attribute attrs = in process false [] attrs +let has_partial_attribute attrs = + List.exists + (function + | {Location.txt = "res.partial"}, _ -> true + | _ -> false) + attrs + type function_attributes_info = {async: bool; attributes: Parsetree.attributes} let process_function_attributes attrs = diff --git a/jscomp/syntax/src/res_parsetree_viewer.mli b/jscomp/syntax/src/res_parsetree_viewer.mli index 6661dfc923..0cd2053694 100644 --- a/jscomp/syntax/src/res_parsetree_viewer.mli +++ b/jscomp/syntax/src/res_parsetree_viewer.mli @@ -17,6 +17,8 @@ val functor_type : val process_partial_app_attribute : Parsetree.attributes -> bool * Parsetree.attributes +val has_partial_attribute : Parsetree.attributes -> bool + type function_attributes_info = {async: bool; attributes: Parsetree.attributes} (* determines whether a function is async and/or uncurried based on the given attributes *) diff --git a/jscomp/syntax/src/res_printer.ml b/jscomp/syntax/src/res_printer.ml index fbb397f83e..ae8055d7b5 100644 --- a/jscomp/syntax/src/res_printer.ml +++ b/jscomp/syntax/src/res_printer.ml @@ -4146,7 +4146,13 @@ and print_pexp_apply ~state expr cmt_tbl = let partial, attrs = ParsetreeViewer.process_partial_app_attribute attrs in let args = if partial then - let dummy = Ast_helper.Exp.constant (Ast_helper.Const.int 0) in + let loc = + {Asttypes.txt = "res.partial"; Asttypes.loc = expr.pexp_loc} + in + let attr = (loc, Parsetree.PTyp (Ast_helper.Typ.any ())) in + let dummy = + Ast_helper.Exp.constant ~attrs:[attr] (Ast_helper.Const.int 0) + in args @ [(Asttypes.Labelled "...", dummy)] else args in @@ -4730,6 +4736,18 @@ and print_arguments ~state ?(partial = false) in Doc.concat [Doc.lparen; arg_doc; Doc.rparen] | args -> + (* Avoid printing trailing comma when there is ... in function application *) + let has_partial_attr, printed_args = + List.fold_right + (fun arg (flag, acc) -> + let _, expr = arg in + let has_partial_attr = + ParsetreeViewer.has_partial_attribute expr.Parsetree.pexp_attributes + in + let doc = print_argument ~state arg cmt_tbl in + (flag || has_partial_attr, doc :: acc)) + args (false, []) + in Doc.group (Doc.concat [ @@ -4738,13 +4756,9 @@ and print_arguments ~state ?(partial = false) (Doc.concat [ Doc.soft_line; - Doc.join - ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map - (fun arg -> print_argument ~state arg cmt_tbl) - args); + Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) printed_args; ]); - (if partial then Doc.nil else Doc.trailing_comma); + (if partial || has_partial_attr then Doc.nil else Doc.trailing_comma); Doc.soft_line; Doc.rparen; ]) diff --git a/jscomp/syntax/tests/printer/expr/apply.res b/jscomp/syntax/tests/printer/expr/apply.res index 9d44d720d3..3c9d1aed48 100644 --- a/jscomp/syntax/tests/printer/expr/apply.res +++ b/jscomp/syntax/tests/printer/expr/apply.res @@ -73,3 +73,37 @@ f(. { resolve(.) resolve(. ()) + +let g = f( + a => LongModuleName.functionWithAlongNameThatWrapsTheEditorToTheNextLinexxxxxxxxxxxxxxxxxxxxxx(a), + b, + c +) + +let g = f( + a => LongModuleName.functionWithAlongNameThatWrapsTheEditorToTheNextLinexxxxxxxxxxxxxxxxxxxxxx(a), + b, + c, + ... +) + +let g = f( + a => LongModuleName.functionWithAlongNameThatWrapsTheEditorToTheNextLinexxxxxxxxxxxxxxxxxxxxxx(a), + b, + c => LongModuleName.functionWithAlongNameThatWrapsTheEditorToTheNextLinexxxxxxxxxxxxxxxxxxxxxx(d, ...), + ... +) + +let g = f( + a => LongModuleName.functionWithAlongNameThatWrapsTheEditorToTheNextLinexxxxxxxxxxxxxxxxxxxxxx(a, ...), + b, + c => LongModuleName.functionWithAlongNameThatWrapsTheEditorToTheNextLinexxxxxxxxxxxxxxxxxxxxxx(d), + ... +) + + +let g = f( + a => LongModuleName.functionWithAlongNameThatWrapsTheEditorToTheNextLinexxxxxxxxxxxxxxxxxxxxxx(a), + b, + c => LongModuleName.functionWithAlongNameThatWrapsTheEditorToTheNextLinexxxxxxxxxxxxxxxxxxxxxx(d, ...) +) diff --git a/jscomp/syntax/tests/printer/expr/expected/apply.res.txt b/jscomp/syntax/tests/printer/expr/expected/apply.res.txt index c04b627ad2..f37f83f248 100644 --- a/jscomp/syntax/tests/printer/expr/expected/apply.res.txt +++ b/jscomp/syntax/tests/printer/expr/expected/apply.res.txt @@ -93,3 +93,54 @@ f({ resolve() resolve() + +let g = f( + a => LongModuleName.functionWithAlongNameThatWrapsTheEditorToTheNextLinexxxxxxxxxxxxxxxxxxxxxx(a), + b, + c, +) + +let g = + f( + a => + LongModuleName.functionWithAlongNameThatWrapsTheEditorToTheNextLinexxxxxxxxxxxxxxxxxxxxxx(a), + b, + c, + ... + ) + +let g = + f( + a => + LongModuleName.functionWithAlongNameThatWrapsTheEditorToTheNextLinexxxxxxxxxxxxxxxxxxxxxx(a), + b, + c => + LongModuleName.functionWithAlongNameThatWrapsTheEditorToTheNextLinexxxxxxxxxxxxxxxxxxxxxx( + d, + ... + ), + ... + ) + +let g = + f( + a => + LongModuleName.functionWithAlongNameThatWrapsTheEditorToTheNextLinexxxxxxxxxxxxxxxxxxxxxx( + a, + ... + ), + b, + c => + LongModuleName.functionWithAlongNameThatWrapsTheEditorToTheNextLinexxxxxxxxxxxxxxxxxxxxxx(d), + ... + ) + +let g = f( + a => LongModuleName.functionWithAlongNameThatWrapsTheEditorToTheNextLinexxxxxxxxxxxxxxxxxxxxxx(a), + b, + c => + LongModuleName.functionWithAlongNameThatWrapsTheEditorToTheNextLinexxxxxxxxxxxxxxxxxxxxxx( + d, + ... + ), +)