From 312f5a59522a3e475781d8752946e4bda9c1331f Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Fri, 10 Nov 2023 21:06:15 -0800 Subject: [PATCH 01/19] feat: support `@mel.as` in variant definitions --- jscomp/common/external_ffi_types.ml | 2 +- jscomp/common/lam_constant.ml | 6 +-- jscomp/common/lam_constant.mli | 2 +- jscomp/core/ast_payload.mli | 2 +- jscomp/core/lam.ml | 15 ++++--- jscomp/core/lam_compile_const.ml | 6 +-- jscomp/core/lam_constant_convert.ml | 56 ++++++++++++++++++++++----- jscomp/core/lam_convert.cppo.ml | 10 ++++- jscomp/core/lam_pass_lets_dce.cppo.ml | 14 +++---- ppx/melange_ppx.ml | 30 ++++++++++++++ test/blackbox-tests/mel-as-variants.t | 16 ++++++++ 11 files changed, 126 insertions(+), 33 deletions(-) create mode 100644 test/blackbox-tests/mel-as-variants.t diff --git a/jscomp/common/external_ffi_types.ml b/jscomp/common/external_ffi_types.ml index fcabc4de4d..dde5f39629 100644 --- a/jscomp/common/external_ffi_types.ml +++ b/jscomp/common/external_ffi_types.ml @@ -213,7 +213,7 @@ let inline_string_primitive (s : string) (op : string option) : string list = | Some op -> Utf8_string.is_unicode_string op | None -> false in - Const_string { s; unicode } + Const_string { s; unicode; comment = None } in [ ""; to_string (Ffi_inline_const lam) ] diff --git a/jscomp/common/lam_constant.ml b/jscomp/common/lam_constant.ml index 91ddf87681..b0cc5eee21 100644 --- a/jscomp/common/lam_constant.ml +++ b/jscomp/common/lam_constant.ml @@ -48,7 +48,7 @@ type t = | Const_js_false | Const_int of { i : int32; comment : pointer_info } | Const_char of char - | Const_string of { s : string; unicode : bool } + | Const_string of { s : string; unicode : bool; comment : pointer_info } | Const_float of string | Const_int64 of int64 | Const_pointer of string @@ -69,9 +69,9 @@ let rec eq_approx (x : t) (y : t) = | Const_js_false -> y = Const_js_false | Const_int ix -> ( match y with Const_int iy -> ix.i = iy.i | _ -> false) | Const_char ix -> ( match y with Const_char iy -> ix = iy | _ -> false) - | Const_string { s = sx; unicode = ux } -> ( + | Const_string { s = sx; unicode = ux; comment = _ } -> ( match y with - | Const_string { s = sy; unicode = uy } -> sx = sy && ux = uy + | Const_string { s = sy; unicode = uy; comment = _ } -> sx = sy && ux = uy | _ -> false) | Const_float ix -> ( match y with Const_float iy -> ix = iy | _ -> false) | Const_int64 ix -> ( match y with Const_int64 iy -> ix = iy | _ -> false) diff --git a/jscomp/common/lam_constant.mli b/jscomp/common/lam_constant.mli index 4ba2dbe647..d2c3cd2bb4 100644 --- a/jscomp/common/lam_constant.mli +++ b/jscomp/common/lam_constant.mli @@ -42,7 +42,7 @@ type t = | Const_js_false | Const_int of { i : int32; comment : pointer_info } | Const_char of char - | Const_string of { s : string; unicode : bool } + | Const_string of { s : string; unicode : bool; comment : pointer_info } | Const_float of string | Const_int64 of int64 | Const_pointer of string diff --git a/jscomp/core/ast_payload.mli b/jscomp/core/ast_payload.mli index 5724d24e4a..b891d7cc2c 100644 --- a/jscomp/core/ast_payload.mli +++ b/jscomp/core/ast_payload.mli @@ -26,7 +26,7 @@ open Import type t = Parsetree.payload (** A utility module used when destructuring parsetree attributes, used for - compiling FFI attributes and built-in ppx *) + compiling FFI attributes and built-in ppx *) type action = string Asttypes.loc * Parsetree.expression option diff --git a/jscomp/core/lam.ml b/jscomp/core/lam.ml index bec0e244a6..22ad0e4d36 100644 --- a/jscomp/core/lam.ml +++ b/jscomp/core/lam.ml @@ -458,7 +458,7 @@ let switch lam (lam_switch : lambda_switch) : t = let stringswitch (lam : t) cases default : t = match lam with - | Lconst (Const_string { s; unicode = false }) -> ( + | Lconst (Const_string { s; unicode = false; comment = _ }) -> ( match List.assoc s cases with | v -> v | exception Not_found -> Option.get default) @@ -519,7 +519,10 @@ module Lift = struct Lconst ((Const_nativeint b)) *) let int64 b : t = Lconst (Const_int64 b) - let string s : t = Lconst (Const_string { s; unicode = false }) + + let string s : t = + Lconst (Const_string { s; unicode = false; comment = None }) + let char b : t = Lconst (Const_char b) end @@ -535,7 +538,7 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t = Lift.int (Int32.of_float (float_of_string a)) (* | Pnegfloat -> Lift.float (-. a) *) (* | Pabsfloat -> Lift.float (abs_float a) *) - | Pstringlength, Const_string { s; unicode = false } -> + | Pstringlength, Const_string { s; unicode = false; comment = _ } -> Lift.int (Int32.of_int (String.length s)) (* | Pnegbint Pnativeint, ( (Const_nativeint i)) *) (* -> *) @@ -608,11 +611,11 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t = | Psequor, Const_js_false, Const_js_true -> true_ | Psequor, Const_js_false, Const_js_false -> false_ | ( Pstringadd, - Const_string { s = a; unicode = false }, - Const_string { s = b; unicode = false } ) -> + Const_string { s = a; unicode = false; comment = _ }, + Const_string { s = b; unicode = false; comment = _ } ) -> Lift.string (a ^ b) | ( (Pstringrefs | Pstringrefu), - Const_string { s = a; unicode = false }, + Const_string { s = a; unicode = false; comment = _ }, Const_int { i = b; _ } ) -> ( try Lift.char (String.get a (Int32.to_int b)) with _ -> default ()) | _ -> default ()) diff --git a/jscomp/core/lam_compile_const.ml b/jscomp/core/lam_compile_const.ml index 20716f10fa..6863f68d6f 100644 --- a/jscomp/core/lam_compile_const.ml +++ b/jscomp/core/lam_compile_const.ml @@ -64,15 +64,15 @@ and translate (x : Lam.Constant.t) : J.expression = - : float = 9.22337203685477581e+18 ]} Note we should compile it to Int64 as JS's - speical representation -- + special representation -- it is not representatble in JS number *) (* E.float (Int64.to_string i) *) Js_long.of_const i (* https://github.com/google/closure-library/blob/master/closure%2Fgoog%2Fmath%2Flong.js *) | Const_float f -> E.float f (* TODO: preserve float *) - | Const_string { s; unicode = false } -> E.str s - | Const_string { s; unicode = true } -> E.unicode s + | Const_string { s; unicode = false; comment = _ } -> E.str s + | Const_string { s; unicode = true; comment = _ } -> E.unicode s | Const_pointer name -> E.str name | Const_block (tag, tag_info, xs) -> Js_of_lam_block.make_block NA tag_info (E.small_int tag) diff --git a/jscomp/core/lam_constant_convert.ml b/jscomp/core/lam_constant_convert.ml index 496ec881e7..bae3267cd0 100644 --- a/jscomp/core/lam_constant_convert.ml +++ b/jscomp/core/lam_constant_convert.ml @@ -24,6 +24,24 @@ open Import +let find_mel_as_name (attr : Parsetree.attribute) = + match attr.attr_name with + | { txt = "mel.as" | "as"; _ } -> ( + match attr.attr_payload with + | PStr + [ + { + pstr_desc = Pstr_eval ({ pexp_desc = Pexp_constant const; _ }, _); + _; + }; + ] -> ( + match const with + | Pconst_string (s, _, _) -> Some (`String s) + | Pconst_integer (s, None) -> Some (`Int (int_of_string s)) + | _ -> None) + | _ -> None) + | _ -> None + let rec convert_constant (const : Lambda.structured_constant) : Lam.Constant.t = match const with | Const_base @@ -38,12 +56,30 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam.Constant.t = | Pt_shape_none -> Lam.Constant.lam_none | Pt_assertfalse -> Const_int { i = Int32.of_int i; comment = Pt_assertfalse } - | Pt_constructor { name; const; non_const; attributes } -> - Const_int - { - i = Int32.of_int i; - comment = Pt_constructor { name; const; non_const; attributes }; - } + | Pt_constructor { name; const; non_const; attributes } -> ( + match List.find_map ~f:find_mel_as_name attributes with + | Some (`String s) -> + Const_string + { + s; + unicode = false; + comment = + Pt_constructor { name; const; non_const; attributes }; + } + | Some (`Int i) -> + Const_int + { + i = Int32.of_int i; + comment = + Pt_constructor { name; const; non_const; attributes }; + } + | None -> + Const_int + { + i = Int32.of_int i; + comment = + Pt_constructor { name; const; non_const; attributes }; + }) | Pt_constructor_access { cstr_name } -> Const_pointer (Js_exp_make.variant_pos ~constr:cstr_name (Int32.of_int i)) @@ -56,13 +92,13 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam.Constant.t = | Some opt -> Melange_ffi.Utf8_string.is_unicode_string opt | _ -> false in - Const_string { s; unicode } + Const_string { s; unicode; comment = None } | Const_base (Const_float i, _) -> Const_float i | Const_base (Const_int32 i, _) -> Const_int { i; comment = None } | Const_base (Const_int64 i, _) -> Const_int64 i | Const_base (Const_nativeint _, _) -> assert false | Const_float_array s -> Const_float_array s - | Const_immstring s -> Const_string { s; unicode = false } + | Const_immstring s -> Const_string { s; unicode = false; comment = None } | Const_block (i, t, xs) -> ( match t with | Blk_some_not_nested -> Const_some (convert_constant (List.hd xs)) @@ -71,6 +107,7 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam.Constant.t = let t : Lam.Tag_info.t = Blk_constructor { name; num_nonconst; attributes } in + (* TODO: *) Const_block (i, t, List.map ~f:convert_constant xs) | Blk_tuple -> let t : Lam.Tag_info.t = Blk_tuple in @@ -89,7 +126,8 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam.Constant.t = ( i, t, [ - Const_string { s; unicode = false }; convert_constant value; + Const_string { s; unicode = false; comment = None }; + convert_constant value; ] ) | _ -> assert false) | Blk_record s -> diff --git a/jscomp/core/lam_convert.cppo.ml b/jscomp/core/lam_convert.cppo.ml index a0b2a6f202..e86d003300 100644 --- a/jscomp/core/lam_convert.cppo.ml +++ b/jscomp/core/lam_convert.cppo.ml @@ -248,7 +248,12 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t = let info : Lam.Tag_info.t = Blk_poly_var in Lam.prim ~primitive:(Pmakeblock (tag, info, mutable_flag)) - ~args:[ Lam.const (Const_string { s; unicode = false }); value ] + ~args: + [ + Lam.const + (Const_string { s; unicode = false; comment = None }); + value; + ] loc | _ -> assert false) | Blk_lazy_general -> ( @@ -739,7 +744,8 @@ let convert (exports : Ident.Set.t) (lam : Lambda.lambda) : | Lprim (Pgetglobal id, args, _) -> let args = List.map ~f:(convert_aux ~dynamic_import) args in if Ident.is_predef id then - Lam.const (Const_string { s = Ident.name id; unicode = false }) + Lam.const + (Const_string { s = Ident.name id; unicode = false; comment = None }) else ( may_depend may_depends (Lam_module_ident.of_ml ~dynamic_import id); assert (args = []); diff --git a/jscomp/core/lam_pass_lets_dce.cppo.ml b/jscomp/core/lam_pass_lets_dce.cppo.ml index 8c5a4647f9..5f72e326cf 100644 --- a/jscomp/core/lam_pass_lets_dce.cppo.ml +++ b/jscomp/core/lam_pass_lets_dce.cppo.ml @@ -67,7 +67,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t = *) -> Ident.Hash.add subst v (simplif l1); simplif l2 - | _, Lconst (Const_string { s; unicode = false }) -> + | _, Lconst (Const_string { s; unicode = false; comment = _ }) -> (* only "" added for later inlining *) Ident.Hash.add string_table v s; Lam.let_ Alias v l1 (simplif l2) @@ -118,7 +118,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t = | _ -> ( let l1 = simplif l1 in match l1 with - | Lconst (Const_string { s; unicode = false }) -> + | Lconst (Const_string { s; unicode = false; comment = _ }) -> Ident.Hash.add string_table v s; (* we need move [simplif lbody] later, since adding Hash does have side effect *) Lam.let_ Alias v l1 (simplif lbody) @@ -136,7 +136,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t = let l1 = simplif l1 in match (kind, l1) with - | Strict, Lconst (Const_string { s; unicode = false }) -> + | Strict, Lconst (Const_string { s; unicode = false; comment = _ }) -> Ident.Hash.add string_table v s; Lam.let_ Alias v l1 (simplif l2) | _ -> @@ -177,7 +177,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t = let r' = simplif r in let opt_l = match l' with - | Lconst (Const_string { s = ls; unicode = false }) -> Some ls + | Lconst (Const_string { s = ls; unicode = false; comment = _ }) -> Some ls | Lvar i -> Ident.Hash.find_opt string_table i | _ -> None in @@ -186,14 +186,14 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t = | Some l_s -> ( let opt_r = match r' with - | Lconst (Const_string { s = rs; unicode = false }) -> Some rs + | Lconst (Const_string { s = rs; unicode = false; comment = _ }) -> Some rs | Lvar i -> Ident.Hash.find_opt string_table i | _ -> None in match opt_r with | None -> Lam.prim ~primitive:Pstringadd ~args:[ l'; r' ] loc | Some r_s -> - Lam.const (Const_string { s = l_s ^ r_s; unicode = false }))) + Lam.const (Const_string { s = l_s ^ r_s; unicode = false; comment = None }))) | Lprim { primitive = (Pstringrefu | Pstringrefs) as primitive; @@ -205,7 +205,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t = let r' = simplif r in let opt_l = match l' with - | Lconst (Const_string { s = ls; unicode = false }) -> Some ls + | Lconst (Const_string { s = ls; unicode = false; comment = _ }) -> Some ls | Lvar i -> Ident.Hash.find_opt string_table i | _ -> None in diff --git a/ppx/melange_ppx.ml b/ppx/melange_ppx.ml index 9584887340..458156aff0 100644 --- a/ppx/melange_ppx.ml +++ b/ppx/melange_ppx.ml @@ -766,6 +766,36 @@ module Mapper = struct pstr_desc = Pstr_module { mb with pmb_name; pmb_attributes = attrs }; } + | Pstr_type (_r, tdcls) -> + List.iter + ~f:(fun (tdcl : type_declaration) -> + match tdcl.ptype_kind with + | Ptype_variant cstrs -> + List.iter + ~f:(fun + ({ pcd_attributes; _ } : constructor_declaration) -> + List.iter + ~f:(fun ({ attr_payload; _ } as attr) -> + match attr_payload with + | PStr + [ + { + pstr_desc = Pstr_eval ({ pexp_desc; _ }, _); + _; + }; + ] -> ( + match pexp_desc with + | Pexp_constant + (Pconst_string _ | Pconst_integer _) -> + Mel_ast_invariant.mark_used_mel_attribute + attr + | _ -> ()) + | _ -> ()) + pcd_attributes) + cstrs + | _ -> ()) + tdcls; + super#structure_item str | _ -> super#structure_item str method! signature_item sigi = diff --git a/test/blackbox-tests/mel-as-variants.t b/test/blackbox-tests/mel-as-variants.t new file mode 100644 index 0000000000..22da6de66a --- /dev/null +++ b/test/blackbox-tests/mel-as-variants.t @@ -0,0 +1,16 @@ +Test `@mel.as` in variant constructors + + $ . ./setup.sh + $ cat > x.ml < type t = Not_A [@mel.as "A"] | Not_B [@mel.as "B"] | Not_C + > let x = Not_A + > EOF + $ melc -ppx melppx x.ml + // Generated by Melange + 'use strict'; + + + var x = "A"; + + exports.x = x; + /* No side effect */ From 413b03a517ebcfe8ceeca7b6cf9a55a834a9a57f Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 17 Sep 2024 17:30:44 +0200 Subject: [PATCH 02/19] fix test --- test/blackbox-tests/mel-as-variants.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/blackbox-tests/mel-as-variants.t b/test/blackbox-tests/mel-as-variants.t index 22da6de66a..8c0372dc6c 100644 --- a/test/blackbox-tests/mel-as-variants.t +++ b/test/blackbox-tests/mel-as-variants.t @@ -10,7 +10,7 @@ Test `@mel.as` in variant constructors 'use strict'; - var x = "A"; + const x = "A"; exports.x = x; /* No side effect */ From eed11e8bdeeb491c959d822417fe5a72146e61b6 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 24 Sep 2024 23:40:22 +0100 Subject: [PATCH 03/19] commit checkpoint -- constant variants working --- jscomp/common/lam_constant.ml | 15 ++- jscomp/common/lam_constant.mli | 7 +- jscomp/common/lam_tag_info.ml | 1 + jscomp/core/j.ml | 2 +- jscomp/core/js_dump.ml | 4 +- jscomp/core/js_exp_make.ml | 16 +-- jscomp/core/js_exp_make.mli | 1 + jscomp/core/js_of_lam_variant.ml | 6 +- jscomp/core/js_stmt_make.ml | 7 +- jscomp/core/js_stmt_make.mli | 4 +- jscomp/core/lam_compile.ml | 105 +++++++++++++----- jscomp/core/lam_compile_const.ml | 8 +- jscomp/core/lam_compile_util.ml | 20 ---- jscomp/core/lam_compile_util.mli | 1 - jscomp/core/lam_constant_convert.ml | 63 ++++------- jscomp/core/lam_constant_convert.mli | 1 + jscomp/core/lam_convert.cppo.ml | 18 ++-- jscomp/core/lam_primitive.ml | 13 ++- jscomp/core/lam_primitive.mli | 7 +- jscomp/core/lam_print.ml | 8 +- jscomp/core/matching_polyfill.cppo.ml | 11 +- jscomp/core/record_attributes_check.ml | 55 +++++----- ppx/ast_derive/ast_derive_js_mapper.ml | 144 ++----------------------- 23 files changed, 229 insertions(+), 288 deletions(-) diff --git a/jscomp/common/lam_constant.ml b/jscomp/common/lam_constant.ml index b0cc5eee21..83921d54d1 100644 --- a/jscomp/common/lam_constant.ml +++ b/jscomp/common/lam_constant.ml @@ -27,7 +27,7 @@ open Import type pointer_info = | None | Pt_constructor of { - name : string; + name : Lambda.cstr_name; const : int; non_const : int; attributes : Parsetree.attributes; @@ -35,12 +35,21 @@ type pointer_info = | Pt_assertfalse | Some of string -let string_of_pointer_info (x : pointer_info) : string option = +let comment_of_pointer_info (x : pointer_info) : string option = match x with - | Some name | Pt_constructor { name; _ } -> Some name + | Some name -> Some name + | Pt_constructor { name = { Lambda.name; _ }; _ } -> Some name | Pt_assertfalse -> Some "assert_false" | None -> None +let modifier_of_pointer_info (x : pointer_info) : Lambda.as_modifier option = + match x with + | Pt_constructor { name = { as_modifier = Some modifier; _ }; _ } -> + Some modifier + | Pt_constructor { name = { as_modifier = None; _ }; _ } + | Pt_assertfalse | Some _ | None -> + None + type t = | Const_js_null | Const_js_undefined diff --git a/jscomp/common/lam_constant.mli b/jscomp/common/lam_constant.mli index d2c3cd2bb4..482e68f336 100644 --- a/jscomp/common/lam_constant.mli +++ b/jscomp/common/lam_constant.mli @@ -22,10 +22,12 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +open Import + type pointer_info = | None | Pt_constructor of { - name : string; + name : Lambda.cstr_name; const : int; non_const : int; attributes : Parsetree.attributes; @@ -33,7 +35,8 @@ type pointer_info = | Pt_assertfalse | Some of string -val string_of_pointer_info : pointer_info -> string option +val modifier_of_pointer_info : pointer_info -> Lambda.as_modifier option +val comment_of_pointer_info : pointer_info -> string option type t = | Const_js_null diff --git a/jscomp/common/lam_tag_info.ml b/jscomp/common/lam_tag_info.ml index daced6fd18..8dbb384be0 100644 --- a/jscomp/common/lam_tag_info.ml +++ b/jscomp/common/lam_tag_info.ml @@ -39,6 +39,7 @@ type t = name : string; num_nonconst : int; fields : string array; + attributes : Parsetree.attributes; } | Blk_constructor of { name : string; diff --git a/jscomp/core/j.ml b/jscomp/core/j.ml index ca2edf79be..cd7a75e0f9 100644 --- a/jscomp/core/j.ml +++ b/jscomp/core/j.ml @@ -262,7 +262,7 @@ and case_clause = { comment : string option; } -and string_clause = string * case_clause +and string_clause = Lambda.as_modifier * case_clause and int_clause = int * case_clause and statement_desc = diff --git a/jscomp/core/js_dump.ml b/jscomp/core/js_dump.ml index ce02345788..1893d8f0dd 100644 --- a/jscomp/core/js_dump.ml +++ b/jscomp/core/js_dump.ml @@ -1188,7 +1188,9 @@ and statement_desc top cxt (s : J.statement_desc) : cxt = brace_vgroup cxt 1 (fun _ -> let cxt = loop_case_clauses cxt - (fun cxt s -> Js_dump_string.pp_string cxt.pp s) + (fun cxt as_value -> + let e = E.as_value as_value in + ignore @@ expression_desc cxt ~level:0 e.expression_desc) cc in match def with diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 51a1916784..b21740b268 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -300,6 +300,15 @@ let small_int i : t = | 248 -> obj_int_tag_literal | i -> int (Int32.of_int i) +(* var (Jident.create_js "true") *) +let true_ : t = make_expression (Bool true) +let false_ : t = make_expression (Bool false) +let bool v = if v then true_ else false_ + +let as_value = function + | Lambda.String s -> str s (* ~delim:DStarJ *) + | Int i -> small_int i + let array_index ?loc ?comment (e0 : t) (e1 : t) : t = match (e0.expression_desc, e1.expression_desc) with | Array (l, _), Number (Int { i; _ }) @@ -509,13 +518,6 @@ let obj ?loc ?comment properties : t = (* currently only in method call, no dependency introduced *) -(* Static_index .....................*) - -(* var (Jident.create_js "true") *) -let true_ : t = make_expression (Bool true) -let false_ : t = make_expression (Bool false) -let bool v = if v then true_ else false_ - (** Arith operators *) (* Static_index .....................**) diff --git a/jscomp/core/js_exp_make.mli b/jscomp/core/js_exp_make.mli index 9949f49f57..d842c12cac 100644 --- a/jscomp/core/js_exp_make.mli +++ b/jscomp/core/js_exp_make.mli @@ -175,6 +175,7 @@ val assign_by_int : ?loc:Location.t -> ?comment:string -> t -> int32 -> t -> t val assign_by_exp : t -> t -> t -> t val assign : ?loc:Location.t -> ?comment:string -> t -> t -> t +val as_value : Import.Lambda.as_modifier -> t val triple_equal : ?loc:Location.t -> ?comment:string -> t -> t -> t (* TODO: reduce [triple_equal] use *) diff --git a/jscomp/core/js_of_lam_variant.ml b/jscomp/core/js_of_lam_variant.ml index 14cd3c53d8..d38c2560ae 100644 --- a/jscomp/core/js_of_lam_variant.ml +++ b/jscomp/core/js_of_lam_variant.ml @@ -40,7 +40,7 @@ let eval (arg : J.expression) (dispatches : (string * string) list) : E.t = S.string_switch arg (List.map ~f:(fun (i, r) -> - ( i, + ( Lambda.String i, J. { switch_body = [ S.return_stmt (E.str r) ]; @@ -74,7 +74,7 @@ let eval_as_event (arg : J.expression) (E.poly_var_tag_access arg) (List.map ~f:(fun (i, r) -> - ( i, + ( Lambda.String i, J. { switch_body = [ S.return_stmt (E.str r) ]; @@ -110,7 +110,7 @@ let eval_as_int (arg : J.expression) (dispatches : (string * int) list) : E.t = S.string_switch arg (List.map ~f:(fun (i, r) -> - ( i, + ( Lambda.String i, J. { switch_body = diff --git a/jscomp/core/js_stmt_make.ml b/jscomp/core/js_stmt_make.ml index 59677fce9f..576849596e 100644 --- a/jscomp/core/js_stmt_make.ml +++ b/jscomp/core/js_stmt_make.ml @@ -131,14 +131,17 @@ let int_switch ?(comment : string option) let string_switch ?(comment : string option) ?(declaration : (J.property * Ident.t) option) ?(default : J.block option) - (e : J.expression) (clauses : (string * J.case_clause) list) : t = + (e : J.expression) (clauses : (Lambda.as_modifier * J.case_clause) list) : t + = match e.expression_desc with | Str (_, txt) | Unicode txt -> ( let continuation = match List.find_map ~f:(fun (switch_case, (x : J.case_clause)) -> - if switch_case = txt then Some x.switch_body else None) + match switch_case with + | Lambda.String s -> if s = txt then Some x.switch_body else None + | Int _ -> None) clauses with | Some case -> case diff --git a/jscomp/core/js_stmt_make.mli b/jscomp/core/js_stmt_make.mli index f3c77d8432..2235983a49 100644 --- a/jscomp/core/js_stmt_make.mli +++ b/jscomp/core/js_stmt_make.mli @@ -22,6 +22,8 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +open Import + (** Creator utilities for the [J] module *) type t = J.statement @@ -77,7 +79,7 @@ val string_switch : ?declaration:Lam_group.let_kind * Ident.t -> ?default:J.block -> J.expression -> - (string * J.case_clause) list -> + (Lambda.as_modifier * J.case_clause) list -> t val declare_variable : diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 562a30022c..1862dd7d38 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -26,6 +26,19 @@ open Import module E = Js_exp_make module S = Js_stmt_make +module AsValue = struct + type t = Lambda.as_modifier = String of string | Int of int + + let compare a b = + match (a, b) with + | String s1, String s2 -> String.compare s1 s2 + | Int i1, Int i2 -> Int.compare i1 i2 + | Int _, String _ -> -1 + | String _, Int _ -> 1 +end + +module AsValueMap = Map.Make (AsValue) + let args_either_function_or_const (args : Lam.t list) = List.for_all ~f:(fun (x : Lam.t) -> @@ -505,7 +518,7 @@ and compile_recursive_lets cxt id_args : Js_output.t = and compile_general_cases : 'a. - ('a -> string option) -> + get_cstr_name:('a -> Lambda.cstr_name option) -> ('a -> J.expression) -> (J.expression -> J.expression -> J.expression) -> Lam_compile_context.t -> @@ -518,7 +531,8 @@ and compile_general_cases : ('a * Lam.t) list -> default_case -> J.block = - fun (make_comment : _ -> string option) (make_exp : _ -> J.expression) + fun ~(get_cstr_name : _ -> Lambda.cstr_name option) + (make_exp : _ -> J.expression) (eq_exp : J.expression -> J.expression -> J.expression) (cxt : Lam_compile_context.t) (switch : @@ -555,7 +569,7 @@ and compile_general_cases : (eq_exp switch_exp (make_exp id)) then_block ~else_:else_block; ]) - | _, _ -> + | _ :: _, _ -> (* TODO: this is not relevant to switch case however, in a subset of switch-case if we can analysis its branch are the same, we can propogate which @@ -582,6 +596,11 @@ and compile_general_cases : | Default lam -> Some (Js_output.output_as_block (compile_lambda cxt lam)) in + let make_comment i = + match get_cstr_name i with + | None -> None + | Some { name; _ } -> Some name + in let body = group_apply cases (fun last (switch_case, lam) -> if last then @@ -618,13 +637,48 @@ and compile_general_cases : [ switch ?default ?declaration switch_exp body ]) -and compile_cases cxt (switch_exp : E.t) table default get_name = - compile_general_cases get_name - (fun i -> { (E.small_int i) with comment = get_name i }) - E.int_equal cxt - (fun ?default ?declaration e clauses -> - S.int_switch ?default ?declaration e clauses) - switch_exp table default +and all_cases_as_value = + let exception Local in + fun table ~get_cstr_name -> + match + List.fold_right + ~f:(fun (i, lam) (acc, map) -> + match get_cstr_name i with + | Some ({ Lambda.as_modifier = Some as_value; _ } as cstr_name) -> + ((as_value, lam) :: acc, AsValueMap.add as_value cstr_name map) + | Some ({ as_modifier = None; _ } as cstr_name) -> + let as_value = Lambda.Int i in + ((as_value, lam) :: acc, AsValueMap.add as_value cstr_name map) + | None -> raise Local) + table ~init:([], AsValueMap.empty) + with + | table -> Some table + | exception Local -> None + +and compile_cases cxt (switch_exp : E.t) table default ~get_cstr_name = + match all_cases_as_value table ~get_cstr_name with + | Some (modifier_table, as_value_map) -> + let get_cstr_name as_value = AsValueMap.find_opt as_value as_value_map in + compile_string_cases ~get_cstr_name cxt switch_exp modifier_table default + | None -> + compile_general_cases ~get_cstr_name + (fun i -> + match get_cstr_name i with + | Some { name; as_modifier = Some modifier } -> + { + (match modifier with + | Int modifier -> E.small_int modifier + | String s -> E.str s) + with + comment = Some name; + } + | Some { name; as_modifier = None } -> + { (E.small_int i) with comment = Some name } + | None -> E.small_int i) + E.int_equal cxt + (fun ?default ?declaration e clauses -> + S.int_switch ?default ?declaration e clauses) + switch_exp table default and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) (lambda_cxt : Lam_compile_context.t) = @@ -661,18 +715,21 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) block @ if sw_consts_full && sw_consts = [] then - compile_cases cxt (E.tag e) sw_blocks sw_blocks_default get_block_name + compile_cases cxt (E.tag e) sw_blocks sw_blocks_default + ~get_cstr_name:get_block_name else if sw_blocks_full && sw_blocks = [] then - compile_cases cxt e sw_consts sw_num_default get_const_name + compile_cases cxt e sw_consts sw_num_default + ~get_cstr_name:get_const_name else (* [e] will be used twice *) let dispatch e = S.if_ (E.is_type_number e) - (compile_cases cxt e sw_consts sw_num_default get_const_name) + (compile_cases cxt e sw_consts sw_num_default + ~get_cstr_name:get_const_name) (* default still needed, could simplified*) ~else_: (compile_cases cxt (E.tag e) sw_blocks sw_blocks_default - get_block_name) + ~get_cstr_name:get_block_name) in match e.expression_desc with | J.Var _ -> [ dispatch e ] @@ -699,10 +756,8 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) :: compile_whole { lambda_cxt with continuation = Assign id }) | EffectCall _ | Assign _ -> Js_output.make (compile_whole lambda_cxt) -and compile_string_cases cxt switch_exp table default = - compile_general_cases - (fun _ -> None) - E.str E.string_equal cxt +and compile_string_cases ~get_cstr_name cxt switch_exp table default = + compile_general_cases ~get_cstr_name E.as_value E.string_equal cxt (fun ?default ?declaration e clauses -> S.string_switch ?default ?declaration e clauses) switch_exp table default @@ -724,20 +779,22 @@ and compile_stringswitch l cases default (lambda_cxt : Lam_compile_context.t) = let default = match default with Some x -> Default x | None -> Complete in + let cases = List.map ~f:(fun (s, l) -> (Lambda.String s, l)) cases in match lambda_cxt.continuation with (* TODO: can be avoided when cases are less than 3 *) | NeedValue _ -> let v = Ident.create_tmp () in Js_output.make (List.append block - (compile_string_cases + (compile_string_cases ~get_cstr_name:(Fun.const None) { lambda_cxt with continuation = Declare (Variable, v) } e cases default)) ~value:(E.var v) | _ -> Js_output.make (List.append block - (compile_string_cases lambda_cxt e cases default))) + (compile_string_cases ~get_cstr_name:(Fun.const None) lambda_cxt + e cases default))) (* This should be optimized in lambda layer (let (match/1038 = (apply g/1027 x/1028)) @@ -859,7 +916,7 @@ and compile_staticcatch (lam : Lam.t) (lambda_cxt : Lam_compile_context.t) = (Js_output.append_output lbody (Js_output.make (compile_cases new_cxt exit_expr handlers NonComplete - (fun _ -> None)) + ~get_cstr_name:(Fun.const None)) ~value:(E.var v))) | Declare (kind, id) (* declare first this we will do branching*) -> let declares = S.declare_variable ~kind id :: declares in @@ -871,7 +928,7 @@ and compile_staticcatch (lam : Lam.t) (lambda_cxt : Lam_compile_context.t) = (Js_output.append_output lbody (Js_output.make (compile_cases new_cxt exit_expr handlers NonComplete - (fun _ -> None)))) + ~get_cstr_name:(Fun.const None)))) (* place holder -- tell the compiler that we don't know if it's complete *) @@ -887,7 +944,7 @@ and compile_staticcatch (lam : Lam.t) (lambda_cxt : Lam_compile_context.t) = (Js_output.append_output lbody (Js_output.make (compile_cases new_cxt exit_expr handlers NonComplete - (fun _ -> None)))) + ~get_cstr_name:(Fun.const None)))) | Assign _ -> let new_cxt = { lambda_cxt with jmp_table } in let lbody = compile_lambda new_cxt body in @@ -895,7 +952,7 @@ and compile_staticcatch (lam : Lam.t) (lambda_cxt : Lam_compile_context.t) = (Js_output.append_output lbody (Js_output.make (compile_cases new_cxt exit_expr handlers NonComplete - (fun _ -> None))))) + ~get_cstr_name:(Fun.const None))))) and compile_sequand (l : Lam.t) (r : Lam.t) (lambda_cxt : Lam_compile_context.t) = diff --git a/jscomp/core/lam_compile_const.ml b/jscomp/core/lam_compile_const.ml index 6863f68d6f..bd43a08d82 100644 --- a/jscomp/core/lam_compile_const.ml +++ b/jscomp/core/lam_compile_const.ml @@ -48,8 +48,12 @@ and translate (x : Lam.Constant.t) : J.expression = | Const_js_false -> E.bool false | Const_js_null -> E.nil | Const_js_undefined -> E.undefined - | Const_int { i; comment } -> - E.int i ?comment:(Lam.Constant.string_of_pointer_info comment) + | Const_int { i; comment = cstr_data } -> ( + let comment = Lam.Constant.comment_of_pointer_info cstr_data in + match Lam.Constant.modifier_of_pointer_info cstr_data with + | None -> E.int i ?comment + | Some (Int i) -> E.int (Int32.of_int i) ?comment + | Some (String s) -> E.unicode ?comment s) | Const_char i -> Js_of_lam_string.const_char i (* E.float (Int32.to_string i) *) | Const_int64 i -> diff --git a/jscomp/core/lam_compile_util.ml b/jscomp/core/lam_compile_util.ml index 1c76b772d2..a5f08ba2f7 100644 --- a/jscomp/core/lam_compile_util.ml +++ b/jscomp/core/lam_compile_util.ml @@ -44,24 +44,4 @@ let jsop_of_float_comp (cmp : Lam_compat.float_comparison) : Js_op.binop = | CFge -> Ge | CFnge -> Lt -let comment_of_tag_info (x : Lam.Tag_info.t) = - match x with - | Blk_constructor { name = n; _ } -> Some n - | Blk_tuple -> Some "tuple" - | Blk_class -> Some "class" - | Blk_poly_var -> None - | Blk_record _ -> None - | Blk_record_inlined { name = ctor; _ } -> Some ctor - | Blk_record_ext _ -> None - | Blk_array -> - (* so far only appears in {!Translclass} - and some constant immutable array block - *) - Some "array" - | Blk_module_export | Blk_module _ -> - (* Turn it on next time to save some noise diff*) - None - | Blk_extension (* TODO: enhance it later *) -> None - | Blk_na s -> if s = "" then None else Some s - (* let module_alias = Some "alias" *) diff --git a/jscomp/core/lam_compile_util.mli b/jscomp/core/lam_compile_util.mli index 2f10291ddd..cf2bb66f40 100644 --- a/jscomp/core/lam_compile_util.mli +++ b/jscomp/core/lam_compile_util.mli @@ -26,4 +26,3 @@ val jsop_of_comp : Lam_compat.integer_comparison -> Js_op.binop val jsop_of_float_comp : Lam_compat.float_comparison -> Js_op.binop -val comment_of_tag_info : Lam.Tag_info.t -> string option diff --git a/jscomp/core/lam_constant_convert.ml b/jscomp/core/lam_constant_convert.ml index bae3267cd0..e8d5cd2480 100644 --- a/jscomp/core/lam_constant_convert.ml +++ b/jscomp/core/lam_constant_convert.ml @@ -24,23 +24,11 @@ open Import -let find_mel_as_name (attr : Parsetree.attribute) = - match attr.attr_name with - | { txt = "mel.as" | "as"; _ } -> ( - match attr.attr_payload with - | PStr - [ - { - pstr_desc = Pstr_eval ({ pexp_desc = Pexp_constant const; _ }, _); - _; - }; - ] -> ( - match const with - | Pconst_string (s, _, _) -> Some (`String s) - | Pconst_integer (s, None) -> Some (`Int (int_of_string s)) - | _ -> None) - | _ -> None) - | _ -> None +let modifier ~name attributes = + match Record_attributes_check.find_mel_as_name attributes with + | Some (String s) -> { Lambda.name; as_modifier = Some (String s) } + | Some (Int modifier) -> { name; as_modifier = Some (Int modifier) } + | None -> { name; as_modifier = None } let rec convert_constant (const : Lambda.structured_constant) : Lam.Constant.t = match const with @@ -56,30 +44,19 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam.Constant.t = | Pt_shape_none -> Lam.Constant.lam_none | Pt_assertfalse -> Const_int { i = Int32.of_int i; comment = Pt_assertfalse } - | Pt_constructor { name; const; non_const; attributes } -> ( - match List.find_map ~f:find_mel_as_name attributes with - | Some (`String s) -> - Const_string - { - s; - unicode = false; - comment = - Pt_constructor { name; const; non_const; attributes }; - } - | Some (`Int i) -> - Const_int - { - i = Int32.of_int i; - comment = - Pt_constructor { name; const; non_const; attributes }; - } - | None -> - Const_int - { - i = Int32.of_int i; - comment = - Pt_constructor { name; const; non_const; attributes }; - }) + | Pt_constructor { name; const; non_const; attributes } -> + Const_int + { + i = Int32.of_int i; + comment = + Pt_constructor + { + name = modifier ~name attributes; + const; + non_const; + attributes; + }; + } | Pt_constructor_access { cstr_name } -> Const_pointer (Js_exp_make.variant_pos ~constr:cstr_name (Int32.of_int i)) @@ -150,9 +127,9 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam.Constant.t = | Blk_na s -> let t : Lam.Tag_info.t = Blk_na s in Const_block (i, t, List.map ~f:convert_constant xs) - | Blk_record_inlined { name; fields; num_nonconst } -> + | Blk_record_inlined { name; fields; num_nonconst; attributes } -> let t : Lam.Tag_info.t = - Blk_record_inlined { name; fields; num_nonconst } + Blk_record_inlined { name; fields; num_nonconst; attributes } in Const_block (i, t, List.map ~f:convert_constant xs) | Blk_record_ext s -> diff --git a/jscomp/core/lam_constant_convert.mli b/jscomp/core/lam_constant_convert.mli index 9b909060b8..d4752f20e0 100644 --- a/jscomp/core/lam_constant_convert.mli +++ b/jscomp/core/lam_constant_convert.mli @@ -24,4 +24,5 @@ open Import +val modifier : name:string -> Parsetree.attribute list -> Lambda.cstr_name val convert_constant : Lambda.structured_constant -> Lam.Constant.t diff --git a/jscomp/core/lam_convert.cppo.ml b/jscomp/core/lam_convert.cppo.ml index e86d003300..9c4f54dc4b 100644 --- a/jscomp/core/lam_convert.cppo.ml +++ b/jscomp/core/lam_convert.cppo.ml @@ -124,12 +124,13 @@ let lam_is_var (x : Lam.t) (y : Ident.t) = (* Make sure no int range overflow happens also we only check [int] *) -let happens_to_be_diff (sw_consts : (int * Lam.t) list) : int32 option = +let happens_to_be_diff (sw_consts : (int * Lam.t) list) sw_names : int32 option = match sw_consts with | (a, Lconst (Const_int { i = a0; comment = _ })) :: (b, Lconst (Const_int { i = b0; comment = _ })) :: rest - when no_over_flow a && no_over_flow_int32 a0 && no_over_flow b + when sw_names = None + && no_over_flow a && no_over_flow_int32 a0 && no_over_flow b && no_over_flow_int32 b0 -> let a = Int32.of_int a in let b = Int32.of_int b in @@ -170,8 +171,8 @@ let convert_record_repr (x : Types.record_representation) : | Record_extension _ -> Record_extension | Record_unboxed _ -> assert false (* see patches in {!Typedecl.get_unboxed_from_attributes}*) - | Record_inlined { tag; name; num_nonconsts } -> - Record_inlined { tag; name; num_nonconsts } + | Record_inlined { tag; name; num_nonconsts; attributes } -> + Record_inlined { tag; name; num_nonconsts; attributes } let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t = match p with @@ -231,9 +232,9 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t = | Blk_record s -> let info : Lam.Tag_info.t = Blk_record s in Lam.prim ~primitive:(Pmakeblock (tag, info, mutable_flag)) ~args loc - | Blk_record_inlined { name; fields; num_nonconst } -> + | Blk_record_inlined { name; fields; num_nonconst; attributes } -> let info : Lam.Tag_info.t = - Blk_record_inlined { name; fields; num_nonconst } + Blk_record_inlined { name; fields; num_nonconst; attributes } in Lam.prim ~primitive:(Pmakeblock (tag, info, mutable_flag)) ~args loc | Blk_module s -> @@ -936,10 +937,11 @@ let convert (exports : Ident.Set.t) (lam : Lambda.lambda) : sw_numblocks = 0; sw_consts; sw_numconsts; + sw_names; _; } -> ( let sw_consts = List.map_snd sw_consts convert_aux in - match happens_to_be_diff sw_consts with + match happens_to_be_diff sw_consts sw_names with | Some 0l -> e | Some i -> Lam.prim ~primitive:Paddint @@ -966,7 +968,7 @@ let convert (exports : Ident.Set.t) (lam : Lambda.lambda) : sw_names = s.sw_names; } in - (convert_aux lam, may_depends) + convert_aux lam, may_depends (* FIXME: more precise analysis of [id], if it is not used, we can remove it diff --git a/jscomp/core/lam_primitive.ml b/jscomp/core/lam_primitive.ml index f82ca5759a..226b7b02c8 100644 --- a/jscomp/core/lam_primitive.ml +++ b/jscomp/core/lam_primitive.ml @@ -28,7 +28,12 @@ type ident = Ident.t type record_representation = | Record_regular - | Record_inlined of { tag : int; name : string; num_nonconsts : int } + | Record_inlined of { + tag : int; + name : string; + num_nonconsts : int; + attributes : Parsetree.attributes; + } (* Inlined record *) | Record_extension (* Inlined record under extension *) @@ -193,10 +198,12 @@ let eq_record_representation (p : record_representation) (p1 : record_representation) = match p with | Record_regular -> p1 = Record_regular - | Record_inlined { tag; name; num_nonconsts } -> ( + | Record_inlined { tag; name; num_nonconsts; attributes } -> ( match p1 with | Record_inlined rhs -> - tag = rhs.tag && name = rhs.name && num_nonconsts = rhs.num_nonconsts + tag = rhs.tag && name = rhs.name + && num_nonconsts = rhs.num_nonconsts + && attributes = rhs.attributes | _ -> false) | Record_extension -> p1 = Record_extension diff --git a/jscomp/core/lam_primitive.mli b/jscomp/core/lam_primitive.mli index d364eae1ae..8e9727dc15 100644 --- a/jscomp/core/lam_primitive.mli +++ b/jscomp/core/lam_primitive.mli @@ -28,7 +28,12 @@ type ident = Ident.t type record_representation = | Record_regular - | Record_inlined of { tag : int; name : string; num_nonconsts : int } + | Record_inlined of { + tag : int; + name : string; + num_nonconsts : int; + attributes : Parsetree.attributes; + } (* Inlined record *) | Record_extension (* Inlined record under extension *) diff --git a/jscomp/core/lam_print.ml b/jscomp/core/lam_print.ml index cf83914aee..eb0733ed68 100644 --- a/jscomp/core/lam_print.ml +++ b/jscomp/core/lam_print.ml @@ -344,14 +344,18 @@ let lambda ppf v = ~f:(fun (n, l) -> if !spc then fprintf ppf "@ " else spc := true; fprintf ppf "@[case int %i %S:@ %a@]" n - (match sw.sw_names with None -> "" | Some x -> x.consts.(n)) + (match sw.sw_names with + | None -> "" + | Some x -> x.consts.(n).name) lam l) sw.sw_consts; List.iter ~f:(fun (n, l) -> if !spc then fprintf ppf "@ " else spc := true; fprintf ppf "@[case tag %i %S:@ %a@]" n - (match sw.sw_names with None -> "" | Some x -> x.blocks.(n)) + (match sw.sw_names with + | None -> "" + | Some x -> x.blocks.(n).name) lam l) sw.sw_blocks; match sw.sw_failaction with diff --git a/jscomp/core/matching_polyfill.cppo.ml b/jscomp/core/matching_polyfill.cppo.ml index 21368854fc..6e9451253b 100644 --- a/jscomp/core/matching_polyfill.cppo.ml +++ b/jscomp/core/matching_polyfill.cppo.ml @@ -30,12 +30,17 @@ let is_nullary_variant (x : Types.constructor_arguments) = let names_from_construct_pattern (pat : Patterns.Head.desc Typedtree.pattern_data) = let names_from_type_variant (cstrs : Types.constructor_declaration list) = + let get_cstr_name (cstr: Types.constructor_declaration) = + Lam_constant_convert.modifier ~name:(Ident.name cstr.cd_id) cstr.cd_attributes + in let consts, blocks = List.fold_left - ~f:(fun (consts, blocks) (cstr : Types.constructor_declaration) -> + ~f:(fun (consts, blocks) + (cstr : Types.constructor_declaration) -> if is_nullary_variant cstr.cd_args then - (Ident.name cstr.cd_id :: consts, blocks) - else (consts, Ident.name cstr.cd_id :: blocks)) + (get_cstr_name cstr :: consts , blocks) + else + (consts , get_cstr_name cstr :: blocks)) ~init:([], []) cstrs in Some diff --git a/jscomp/core/record_attributes_check.ml b/jscomp/core/record_attributes_check.ml index 8882dfe6b0..f98cd68956 100644 --- a/jscomp/core/record_attributes_check.ml +++ b/jscomp/core/record_attributes_check.ml @@ -34,33 +34,36 @@ let namespace_error ~loc txt = `[@mel.*]' attributes. Use `[@mel.as]' instead." | _ -> () -let find_mel_as_name (attr : Parsetree.attribute) = - match attr with - | { - attr_name = { txt = ("mel.as" | "as" | "bs.as") as txt; loc }; - attr_payload = - PStr - [ - { - pstr_desc = - Pstr_eval - ({ pexp_desc = Pexp_constant (Pconst_string (s, _, _)); _ }, _); - _; - }; - ]; - _; - } -> - namespace_error ~loc txt; - Some s - | _ -> None +let find_mel_as_name = + let find_mel_as_name (attr : Parsetree.attribute) = + match attr.attr_name with + | { txt = ("mel.as" | "as" | "bs.as") as txt; loc } -> ( + match attr.attr_payload with + | PStr + [ + { + pstr_desc = Pstr_eval ({ pexp_desc = Pexp_constant const; _ }, _); + _; + }; + ] -> ( + namespace_error ~loc txt; + match const with + | Pconst_string (s, _, _) -> Some (Lambda.String s) + | Pconst_integer (s, None) -> Some (Int (int_of_string s)) + | _ -> None) + | _ -> None) + | _ -> None + in + fun attributes -> List.find_map ~f:find_mel_as_name attributes -let rec find_with_default xs ~default = +let find_with_default xs ~default = match xs with | [] -> default - | x :: l -> ( - match find_mel_as_name x with - | Some v -> v - | None -> find_with_default l ~default) + | xs -> ( + match find_mel_as_name xs with + | Some (String v) -> v + | Some (Int _) -> assert false + | None -> default) let find_name_with_loc (attr : Parsetree.attribute) : string Asttypes.loc option = @@ -128,14 +131,14 @@ let blk_record_ext fields = in Lambda.Blk_record_ext all_labels_info -let blk_record_inlined fields name num_nonconst = +let blk_record_inlined fields name num_nonconst attrs = let fields = Array.map ~f:(fun ((lbl : label), _) -> find_with_default lbl.Types.lbl_attributes ~default:lbl.lbl_name) fields in - Lambda.Blk_record_inlined { fields; name; num_nonconst } + Lambda.Blk_record_inlined { fields; name; num_nonconst; attributes = attrs } let check_mel_attributes_inclusion (attrs1 : Parsetree.attributes) (attrs2 : Parsetree.attributes) lbl_name = diff --git a/ppx/ast_derive/ast_derive_js_mapper.ml b/ppx/ast_derive/ast_derive_js_mapper.ml index 3c69ff2398..0a35d95f97 100644 --- a/ppx/ast_derive/ast_derive_js_mapper.ml +++ b/ppx/ast_derive/ast_derive_js_mapper.ml @@ -106,42 +106,12 @@ let buildMap (row_fields : row_field list) = in (data, revData, !has_mel_as) -let ( <=~ ) a b = - let loc = noloc in - [%expr [%e a] <= [%e b]] - -let ( -~ ) a b = - let loc = noloc in - [%expr Stdlib.( - ) [%e a] [%e b]] - -let ( +~ ) a b = - let loc = noloc in - [%expr Stdlib.( + ) [%e a] [%e b]] - -let ( &&~ ) a b = - let loc = noloc in - [%expr Stdlib.( && ) [%e a] [%e b]] - let ( ->~ ) a b = let loc = noloc in [%type: [%t a] -> [%t b]] let jsMapperRt = Longident.Lident "Js__Js_mapper_runtime" -let fromInt len array exp = - let loc = noloc in - [%expr - [%e Exp.ident { loc = noloc; txt = Longident.Ldot (jsMapperRt, "fromInt") }] - [%e len] [%e array] [%e exp]] - -let fromIntAssert len array exp = - let loc = noloc in - [%expr - [%e - Exp.ident - { loc = noloc; txt = Longident.Ldot (jsMapperRt, "fromIntAssert") }] - [%e len] [%e array] [%e exp]] - let raiseWhenNotFound x = let loc = noloc in [%expr @@ -151,7 +121,6 @@ let raiseWhenNotFound x = [%e x]] let derivingName = "jsConverter" -let assertExp e = Exp.assert_ e let single_non_rec_value name exp = Str.value Nonrecursive [ Vb.mk (Pat.var name) exp ] @@ -162,7 +131,6 @@ let derive_structure = let name = tdcl.ptype_name.txt in let toJs = name ^ "ToJs" in let fromJs = name ^ "FromJs" in - let constantArray = "jsMapperConstantArray" in let loc = tdcl.ptype_loc in let patToJs = { Asttypes.loc; txt = toJs } in let patFromJs = { Asttypes.loc; txt = fromJs } in @@ -271,109 +239,15 @@ let derive_structure = Exp.constant (Pconst_string (U.notApplicable derivingName, loc, None))]]]; ]) - | Ptype_variant ctors -> - if Ast_polyvar.is_enum_constructors ctors then - let xs = Ast_polyvar.map_constructor_declarations_into_ints ctors in - match xs with - | `New xs -> - let constantArrayExp = - Exp.ident { loc; txt = Lident constantArray } - in - let exp_len = - Exp.constant - (Pconst_integer (string_of_int (List.length ctors), None)) - in - let v = - [ - unsafeIndexGet; - eraseTypeStr; - single_non_rec_value - { loc; txt = constantArray } - (Ast_helper.Exp.array - (List.map - ~f:(fun x -> - Exp.constant - (Pconst_integer (string_of_int x, None))) - xs)); - toJsBody - [%expr - [%e unsafeIndexGetExp] [%e constantArrayExp] - [%e exp_param]]; - single_non_rec_value patFromJs - (Exp.fun_ Nolabel None (Pat.var pat_param) - (if createType then - fromIntAssert exp_len constantArrayExp - (exp_param +: newType) - +> core_type - else - fromInt exp_len constantArrayExp exp_param - +> Ast_core_type.lift_option_type core_type)); - ] - in - if createType then newTypeStr :: v else v - | `Offset offset -> - let v = - [ - eraseTypeStr; - toJsBody - (coerceResultToNewType - (eraseType exp_param - +~ Exp.constant - (Pconst_integer (string_of_int offset, None)))); - (let len = List.length ctors in - let range_low = - Exp.constant - (Pconst_integer (string_of_int (offset + 0), None)) - in - let range_upper = - Exp.constant - (Pconst_integer (string_of_int (offset + len - 1), None)) - in - - single_non_rec_value { loc; txt = fromJs } - (Exp.fun_ Nolabel None (Pat.var pat_param) - (if createType then - Exp.let_ Nonrecursive - [ - Vb.mk (Pat.var pat_param) (exp_param +: newType); - ] - (Exp.sequence - (assertExp - (exp_param <=~ range_upper - &&~ (range_low <=~ exp_param))) - (exp_param - -~ Exp.constant - (Pconst_integer (string_of_int offset, None)) - )) - +> core_type - else - Exp.ifthenelse - (exp_param <=~ range_upper - &&~ (range_low <=~ exp_param)) - (Exp.construct - { loc; txt = Ast_literal.predef_some } - (Some - (exp_param - -~ Exp.constant - (Pconst_integer - (string_of_int offset, None))))) - (Some - (Exp.construct - { loc; txt = Ast_literal.predef_none } - None)) - +> Ast_core_type.lift_option_type core_type))); - ] - in - if createType then newTypeStr :: v else v - else - let loc = tdcl.ptype_loc in - [ - [%stri - [%%ocaml.error - [%e - Exp.constant - (Pconst_string (U.notApplicable derivingName, loc, None))]]]; - ] + | Ptype_variant _ctors -> + let loc = tdcl.ptype_loc in + [ + [%stri + [%%ocaml.error + [%e + Exp.constant + (Pconst_string (U.notApplicable derivingName, loc, None))]]]; + ] | Ptype_open -> let loc = tdcl.ptype_loc in [ From 41f3b7d6bc8095a81d560ea6553cb4643e0d62e3 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Wed, 25 Sep 2024 01:15:29 +0100 Subject: [PATCH 04/19] add variants-as-strings test --- test/blackbox-tests/variants-as-strings.t | 81 +++++++++++++++++++++++ 1 file changed, 81 insertions(+) create mode 100644 test/blackbox-tests/variants-as-strings.t diff --git a/test/blackbox-tests/variants-as-strings.t b/test/blackbox-tests/variants-as-strings.t new file mode 100644 index 0000000000..c1bfdcba41 --- /dev/null +++ b/test/blackbox-tests/variants-as-strings.t @@ -0,0 +1,81 @@ + + + $ . ./setup.sh + $ cat > dune-project < (lang dune 3.9) + > (using melange 0.1) + > EOF + + $ cat > dune < (melange.emit + > (target js-out) + > (preprocess (pps melange.ppx)) + > (emit_stdlib false)) + > EOF + + $ cat > x.ml < type a = A | B [@mel.as "as-string"] | C + > let f x = match x with A -> "a" | _ -> "other" + > let g x = match x with B -> "as-string" | _ -> "other" + > EOF + + $ dune build @melange + $ cat ./_build/default/js-out/x.js + // Generated by Melange + 'use strict'; + + + function f(x) { + switch (x) { + case /* A */0 : + return "a"; + case /* B */"as-string" : + case /* C */2 : + return "other"; + + } + } + + function g(x) { + switch (x) { + case /* B */"as-string" : + return "as-string"; + case /* A */0 : + case /* C */2 : + return "other"; + + } + } + + exports.f = f; + exports.g = g; + /* No side effect */ + + $ cat > x.ml < type (_, _) x = + > | [] : ('a, 'a) x + > | ( :: ) : 'a * ('ty, 'v) x -> ('a -> 'ty, 'v) x + > let rec f : type a b. (a, string ref) x -> string = + > fun x -> match x with [] -> "empty" | _ :: xs -> f xs + > EOF + + $ dune build @melange + $ cat ./_build/default/js-out/x.js + // Generated by Melange + 'use strict'; + + + function f(_x) { + while(true) { + const x = _x; + if (!x) { + return "empty"; + } + _x = x.tl; + continue ; + }; + } + + exports.f = f; + /* No side effect */ + From d95fa39f87954853705e3465caba1714776f0956 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Wed, 25 Sep 2024 14:26:54 +0100 Subject: [PATCH 05/19] add support for block constructors --- flake.lock | 21 ++-- jscomp/core/js_dump.ml | 40 ++++--- jscomp/core/js_exp_make.ml | 12 +- jscomp/core/js_exp_make.mli | 1 + jscomp/core/lam_compile.ml | 2 +- ppx/ast_derive/ast_derive_js_mapper.ml | 27 ++--- ppx/ast_polyvar.ml | 13 --- ppx/ast_polyvar.mli | 1 - test/blackbox-tests/mel-as-variants.t | 135 +++++++++++++++++++++- test/blackbox-tests/variants-as-strings.t | 21 ++++ vendor/melange-compiler-libs | 2 +- 11 files changed, 211 insertions(+), 64 deletions(-) diff --git a/flake.lock b/flake.lock index 1d41da82e1..9781ef3cd1 100644 --- a/flake.lock +++ b/flake.lock @@ -28,15 +28,16 @@ ] }, "locked": { - "lastModified": 1727218463, - "narHash": "sha256-PDn96jM6pth8blF47xHdYOiZejYR8hB/N57oRLwcG8s=", + "lastModified": 1727222349, + "narHash": "sha256-vLpW0qEItoyyPO3XtPSIYQrgKl0XO3+U3/wBaGuCEWI=", "owner": "melange-re", "repo": "melange-compiler-libs", - "rev": "f6b64316eea601f02ab48a5ec6e2d8e80dc9c604", + "rev": "c83561201b7f4bac3906e2bc2aa76113a516e16e", "type": "github" }, "original": { "owner": "melange-re", + "ref": "anmonteiro/mel-as-variants", "repo": "melange-compiler-libs", "type": "github" } @@ -64,11 +65,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1727203675, - "narHash": "sha256-ibsyYaGi8KfmxkbNsy8eR1L6zT4WCAQzIEP9EcOoXJo=", + "lastModified": 1727261331, + "narHash": "sha256-8bOk8r2sRmJnshj4LtwPIlske+9SVcLQrGOdBNesPYc=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "aaa9425cea232424d486f1123f5168f2a70346cc", + "rev": "c105c75672194247d87027f263ba4f640f9ae960", "type": "github" }, "original": { @@ -79,17 +80,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1727190658, - "narHash": "sha256-hO8ullPTzvBvwd+o0dzH8SDbkNcTuUQQhex5LW45heY=", + "lastModified": 1727234896, + "narHash": "sha256-UYfPGgxulnDXzHeKCmMoPdvyUd7uktMaEzljVHB3vOk=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "5620491106cfe8c2db0628161b93830d66506ffc", + "rev": "84bd184f8179ff6999d6d10e6b0ca575b4118674", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "5620491106cfe8c2db0628161b93830d66506ffc", + "rev": "84bd184f8179ff6999d6d10e6b0ca575b4118674", "type": "github" } }, diff --git a/jscomp/core/js_dump.ml b/jscomp/core/js_dump.ml index 1893d8f0dd..96e7c7a2fa 100644 --- a/jscomp/core/js_dump.ml +++ b/jscomp/core/js_dump.ml @@ -790,18 +790,22 @@ and expression_desc cxt ~(level : int) x : cxt = (if !Js_config.debug then [ (name_symbol, E.str p.name) ] else []) (fun i -> Js_op.Lit i) in - if p.num_nonconst = 1 then tails - else - ( Js_op.Lit L.tag, - if !Js_config.debug then tag else { tag with comment = Some p.name } - ) - :: tails + let as_value = + Lam_constant_convert.modifier ~name:p.name p.attributes + in + ( Js_op.Lit L.tag, + { + (Option.value + (Option.map E.as_value as_value.as_modifier) + ~default:tag) + with + comment = Some as_value.name; + } ) + :: tails in - if p.num_nonconst = 1 && not !Js_config.debug then - pp_comment_option cxt (Some p.name); expression_desc cxt ~level (Object objs) | Caml_block (el, _, tag, Blk_constructor p) -> - let not_is_cons = not (Js_op_util.is_cons p.name) in + let is_cons = Js_op_util.is_cons p.name in let objs = let tails = List.mapi @@ -809,19 +813,25 @@ and expression_desc cxt ~(level : int) x : cxt = (Js_op.Lit (E.variant_pos ~constr:p.name (Int32.of_int i)), e)) el @ - if !Js_config.debug && not_is_cons then + if !Js_config.debug && not is_cons then [ (name_symbol, E.str p.name) ] else [] in - if p.num_nonconst = 1 then tails + if is_cons && p.num_nonconst = 1 then tails else + let as_value = + Lam_constant_convert.modifier ~name:p.name p.attributes + in ( Js_op.Lit L.tag, - if !Js_config.debug then tag else { tag with comment = Some p.name } - ) + { + (Option.value + (Option.map E.as_value as_value.as_modifier) + ~default:tag) + with + comment = Some as_value.name; + } ) :: tails in - if p.num_nonconst = 1 && (not !Js_config.debug) && not_is_cons then - pp_comment_option cxt (Some p.name); expression_desc cxt ~level (Object objs) | Caml_block (_, _, _, (Blk_module_export | Blk_na _)) -> assert false | Caml_block (el, mutable_flag, _tag, (Blk_tuple | Blk_class | Blk_array)) -> diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index b21740b268..65b1673e24 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -749,6 +749,13 @@ let string_equal ?loc ?comment (e0 : t) (e1 : t) : t = let is_type_number ?loc ?comment (e : t) : t = string_equal ?loc ?comment (typeof e) (str "number") +(* XXX(anmonteiro): this needs to change if we ever allow `[@mel.as ..]` + payloads to have types other than string or number *) +let is_tag (e : t) : t = + or_ ~comment:"tag" + (string_equal (typeof e) (str "number")) + (string_equal (typeof e) (str "string")) + let is_type_string ?loc ?comment (e : t) : t = string_equal ?loc ?comment (typeof e) (str "string") @@ -757,10 +764,7 @@ let is_type_string ?loc ?comment (e : t) : t = call plain [dot] *) -let tag ?loc ?comment e : t = - make_expression - (Bin - (Bor, make_expression ?loc ?comment (Caml_block_tag e), zero_int_literal)) +let tag ?loc ?comment e : t = make_expression ?loc ?comment (Caml_block_tag e) (* according to the compiler, [Btype.hash_variant], it's reduced to 31 bits for hash diff --git a/jscomp/core/js_exp_make.mli b/jscomp/core/js_exp_make.mli index d842c12cac..da1a2b11b5 100644 --- a/jscomp/core/js_exp_make.mli +++ b/jscomp/core/js_exp_make.mli @@ -190,6 +190,7 @@ val neq_null_undefined_boolean : ?loc:Location.t -> ?comment:string -> t -> t -> t val is_type_number : ?loc:Location.t -> ?comment:string -> t -> t +val is_tag : t -> t val is_type_string : ?loc:Location.t -> ?comment:string -> t -> t val typeof : ?loc:Location.t -> ?comment:string -> t -> t val to_int32 : ?loc:Location.t -> ?comment:string -> t -> t diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 1862dd7d38..aa88942ad9 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -723,7 +723,7 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) else (* [e] will be used twice *) let dispatch e = - S.if_ (E.is_type_number e) + S.if_ (E.is_tag e) (compile_cases cxt e sw_consts sw_num_default ~get_cstr_name:get_const_name) (* default still needed, could simplified*) diff --git a/ppx/ast_derive/ast_derive_js_mapper.ml b/ppx/ast_derive/ast_derive_js_mapper.ml index 0a35d95f97..17da3dc445 100644 --- a/ppx/ast_derive/ast_derive_js_mapper.ml +++ b/ppx/ast_derive/ast_derive_js_mapper.ml @@ -314,24 +314,15 @@ let derive_signature = Exp.constant (Pconst_string (U.notApplicable derivingName, loc, None))]]]; ]) - | Ptype_variant ctors -> - if Ast_polyvar.is_enum_constructors ctors then - let ty1 = if createType then newType else [%type: int] in - let ty2 = - if createType then core_type - else Ast_core_type.lift_option_type core_type - in - newTypeStr - +? [ toJsType ty1; Sig.value (Val.mk patFromJs (ty1 ->~ ty2)) ] - else - let loc = tdcl.ptype_loc in - [ - [%sigi: - [%%ocaml.error - [%e - Exp.constant - (Pconst_string (U.notApplicable derivingName, loc, None))]]]; - ] + | Ptype_variant _ -> + let loc = tdcl.ptype_loc in + [ + [%sigi: + [%%ocaml.error + [%e + Exp.constant + (Pconst_string (U.notApplicable derivingName, loc, None))]]]; + ] | Ptype_open -> let loc = tdcl.ptype_loc in [ diff --git a/ppx/ast_polyvar.ml b/ppx/ast_polyvar.ml index daa83fd913..5af44a2703 100644 --- a/ppx/ast_polyvar.ml +++ b/ppx/ast_polyvar.ml @@ -59,19 +59,6 @@ let is_enum_polyvar (ty : type_declaration) = Some row_fields | _ -> None -let is_enum_constructors (constructors : constructor_declaration list) = - List.for_all - ~f:(fun (x : constructor_declaration) -> - match x with - | { - pcd_args = - Pcstr_tuple [] (* Note the enum is encoded using [Pcstr_tuple []]*); - _; - } -> - true - | _ -> false) - constructors - let map_row_fields_into_ints ptyp_loc (row_fields : row_field list) = let _, acc = List.fold_left diff --git a/ppx/ast_polyvar.mli b/ppx/ast_polyvar.mli index a788255b9b..113a0f4dbf 100644 --- a/ppx/ast_polyvar.mli +++ b/ppx/ast_polyvar.mli @@ -28,7 +28,6 @@ val map_constructor_declarations_into_ints : constructor_declaration list -> [ `Offset of int | `New of int list ] val is_enum_polyvar : type_declaration -> row_field list option -val is_enum_constructors : constructor_declaration list -> bool val map_row_fields_into_ints : Location.t -> row_field list -> (string * int) list diff --git a/test/blackbox-tests/mel-as-variants.t b/test/blackbox-tests/mel-as-variants.t index 8c0372dc6c..4fdef9227c 100644 --- a/test/blackbox-tests/mel-as-variants.t +++ b/test/blackbox-tests/mel-as-variants.t @@ -10,7 +10,140 @@ Test `@mel.as` in variant constructors 'use strict'; - const x = "A"; + const x = /* Not_A */"A"; exports.x = x; /* No side effect */ + + $ cat > x.ml < type t = + > | No_payload + > | Also_no_payload [@mel.as "nopayload"] + > | Has_payload of string [@mel.as "payload1"] + > let x = No_payload + > let y = Also_no_payload + > let z = Has_payload "p1" + > let f = function + > | No_payload -> "payload1" + > | Also_no_payload -> "nopaylod2" + > | Has_payload _ -> "payload2" + > EOF + $ melc -ppx melppx x.ml + // Generated by Melange + 'use strict'; + + + function f(param) { + if (/* tag */typeof param === "number" || typeof param === "string") { + if (param === 0) { + return "payload1"; + } else { + return "nopaylod2"; + } + } else { + return "payload2"; + } + } + + const x = /* No_payload */0; + + const y = /* Also_no_payload */"nopayload"; + + const z = { + TAG: /* Has_payload */"payload1", + _0: "p1" + }; + + exports.x = x; + exports.y = y; + exports.z = z; + exports.f = f; + /* No side effect */ + + $ cat > x.ml < type t = + > | No_payload + > | Also_no_payload [@mel.as "nopayload"] + > | Has_payload of string [@mel.as "payload1"] + > | Has_payload2 of int + > let x = No_payload + > let y = Also_no_payload + > let z = Has_payload "p1" + > let t = Has_payload2 42 + > let f = function + > | No_payload -> "nopayload1" + > | Also_no_payload -> "nopaylod2" + > | Has_payload _ -> "payload1" + > | Has_payload2 _ -> "payload2" + > EOF + $ melc -ppx melppx x.ml + // Generated by Melange + 'use strict'; + + + function f(param) { + if (/* tag */typeof param === "number" || typeof param === "string") { + if (param === 0) { + return "nopayload1"; + } else { + return "nopaylod2"; + } + } else if (param.TAG === "payload1") { + return "payload1"; + } else { + return "payload2"; + } + } + + const x = /* No_payload */0; + + const y = /* Also_no_payload */"nopayload"; + + const z = { + TAG: /* Has_payload */"payload1", + _0: "p1" + }; + + const t = { + TAG: /* Has_payload2 */1, + _0: 42 + }; + + exports.x = x; + exports.y = y; + exports.z = z; + exports.t = t; + exports.f = f; + /* No side effect */ + + $ cat > x.ml < type t = + > | No_payload + > | Has_payload of string [@mel.as "payload1"] + > | Also_payload of { s: string } [@mel.as "payload2"] + > let x = No_payload + > let y = Has_payload "p1" + > let z = Also_payload { s = "p2" } + > EOF + $ melc -ppx melppx x.ml + // Generated by Melange + 'use strict'; + + + const x = /* No_payload */0; + + const y = { + TAG: /* Has_payload */"payload1", + _0: "p1" + }; + + const z = { + TAG: /* Also_payload */"payload2", + s: "p2" + }; + + exports.x = x; + exports.y = y; + exports.z = z; + /* No side effect */ + diff --git a/test/blackbox-tests/variants-as-strings.t b/test/blackbox-tests/variants-as-strings.t index c1bfdcba41..29b84f5dec 100644 --- a/test/blackbox-tests/variants-as-strings.t +++ b/test/blackbox-tests/variants-as-strings.t @@ -79,3 +79,24 @@ exports.f = f; /* No side effect */ + $ cat > x.ml < type x = A [@mel.as "A"] | B + > let f x = match x with A -> "a" | B -> "b" + > EOF + + $ dune build @melange + $ cat ./_build/default/js-out/x.js + // Generated by Melange + 'use strict'; + + + function f(x) { + if (x === "A") { + return "a"; + } else { + return "b"; + } + } + + exports.f = f; + /* No side effect */ diff --git a/vendor/melange-compiler-libs b/vendor/melange-compiler-libs index f6b64316ee..c83561201b 160000 --- a/vendor/melange-compiler-libs +++ b/vendor/melange-compiler-libs @@ -1 +1 @@ -Subproject commit f6b64316eea601f02ab48a5ec6e2d8e80dc9c604 +Subproject commit c83561201b7f4bac3906e2bc2aa76113a516e16e From 02345a62c534ea5049e45d117fd665ff86d0c1db Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Wed, 25 Sep 2024 14:27:52 +0100 Subject: [PATCH 06/19] wip --- flake.lock | 6 +++--- vendor/melange-compiler-libs | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/flake.lock b/flake.lock index 9781ef3cd1..e856cd0cd9 100644 --- a/flake.lock +++ b/flake.lock @@ -28,11 +28,11 @@ ] }, "locked": { - "lastModified": 1727222349, - "narHash": "sha256-vLpW0qEItoyyPO3XtPSIYQrgKl0XO3+U3/wBaGuCEWI=", + "lastModified": 1727270848, + "narHash": "sha256-xJmVyAQ4FQyPojnUiuGpwfCTpVnTEO4jhxGIMDys4Ps=", "owner": "melange-re", "repo": "melange-compiler-libs", - "rev": "c83561201b7f4bac3906e2bc2aa76113a516e16e", + "rev": "7170f7d2c8cead7d18c4872de661426a73aac6ce", "type": "github" }, "original": { diff --git a/vendor/melange-compiler-libs b/vendor/melange-compiler-libs index c83561201b..7170f7d2c8 160000 --- a/vendor/melange-compiler-libs +++ b/vendor/melange-compiler-libs @@ -1 +1 @@ -Subproject commit c83561201b7f4bac3906e2bc2aa76113a516e16e +Subproject commit 7170f7d2c8cead7d18c4872de661426a73aac6ce From 16be3eb2713a97252373c3cb80f3a79f4779c73e Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Wed, 25 Sep 2024 23:19:55 +0100 Subject: [PATCH 07/19] fix: print comments again --- flake.nix | 2 +- jscomp/core/js_dump.ml | 12 ++++++------ jscomp/core/js_exp_make.ml | 11 ++++++++--- jscomp/core/js_exp_make.mli | 2 +- jscomp/core/js_stmt_make.ml | 3 +-- jscomp/core/lam_compile.ml | 16 ++++++++-------- test/blackbox-tests/complex-constant-inline.t | 2 +- test/blackbox-tests/mel-as-inline-records.t | 3 ++- test/blackbox-tests/stdout.t | 3 ++- test/blackbox-tests/unicode-format-strings.t | 3 ++- 10 files changed, 32 insertions(+), 25 deletions(-) diff --git a/flake.nix b/flake.nix index 6c2896b172..2942f4791b 100644 --- a/flake.nix +++ b/flake.nix @@ -11,7 +11,7 @@ melange-compiler-libs = { # this changes rarely, and it's better than having to rely on nix's poor # support for submodules - url = "github:melange-re/melange-compiler-libs"; + url = "github:melange-re/melange-compiler-libs/anmonteiro/mel-as-variants"; inputs.flake-utils.follows = "flake-utils"; inputs.nixpkgs.follows = "nixpkgs"; }; diff --git a/jscomp/core/js_dump.ml b/jscomp/core/js_dump.ml index 96e7c7a2fa..6004ab0e8b 100644 --- a/jscomp/core/js_dump.ml +++ b/jscomp/core/js_dump.ml @@ -795,9 +795,9 @@ and expression_desc cxt ~(level : int) x : cxt = in ( Js_op.Lit L.tag, { - (Option.value - (Option.map E.as_value as_value.as_modifier) - ~default:tag) + (match as_value.as_modifier with + | Some modifier -> E.as_value modifier + | None -> tag) with comment = Some as_value.name; } ) @@ -824,9 +824,9 @@ and expression_desc cxt ~(level : int) x : cxt = in ( Js_op.Lit L.tag, { - (Option.value - (Option.map E.as_value as_value.as_modifier) - ~default:tag) + (match as_value.as_modifier with + | Some modifier -> E.as_value modifier + | None -> tag) with comment = Some as_value.name; } ) diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 65b1673e24..e607e2c961 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -305,9 +305,14 @@ let true_ : t = make_expression (Bool true) let false_ : t = make_expression (Bool false) let bool v = if v then true_ else false_ -let as_value = function - | Lambda.String s -> str s (* ~delim:DStarJ *) - | Int i -> small_int i +let as_value ?comment modifier = + { + (match modifier with + | Lambda.String s -> str s (* ~delim:DStarJ *) + | Int i -> small_int i) + with + comment; + } let array_index ?loc ?comment (e0 : t) (e1 : t) : t = match (e0.expression_desc, e1.expression_desc) with diff --git a/jscomp/core/js_exp_make.mli b/jscomp/core/js_exp_make.mli index da1a2b11b5..496a422c6b 100644 --- a/jscomp/core/js_exp_make.mli +++ b/jscomp/core/js_exp_make.mli @@ -175,7 +175,7 @@ val assign_by_int : ?loc:Location.t -> ?comment:string -> t -> int32 -> t -> t val assign_by_exp : t -> t -> t -> t val assign : ?loc:Location.t -> ?comment:string -> t -> t -> t -val as_value : Import.Lambda.as_modifier -> t +val as_value : ?comment:string -> Import.Lambda.as_modifier -> t val triple_equal : ?loc:Location.t -> ?comment:string -> t -> t -> t (* TODO: reduce [triple_equal] use *) diff --git a/jscomp/core/js_stmt_make.ml b/jscomp/core/js_stmt_make.ml index 576849596e..dd9c053430 100644 --- a/jscomp/core/js_stmt_make.ml +++ b/jscomp/core/js_stmt_make.ml @@ -131,8 +131,7 @@ let int_switch ?(comment : string option) let string_switch ?(comment : string option) ?(declaration : (J.property * Ident.t) option) ?(default : J.block option) - (e : J.expression) (clauses : (Lambda.as_modifier * J.case_clause) list) : t - = + (e : J.expression) (clauses : J.string_clause list) : t = match e.expression_desc with | Str (_, txt) | Unicode txt -> ( let continuation = diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index aa88942ad9..d065ec3239 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -665,13 +665,7 @@ and compile_cases cxt (switch_exp : E.t) table default ~get_cstr_name = (fun i -> match get_cstr_name i with | Some { name; as_modifier = Some modifier } -> - { - (match modifier with - | Int modifier -> E.small_int modifier - | String s -> E.str s) - with - comment = Some name; - } + E.as_value ~comment:name modifier | Some { name; as_modifier = None } -> { (E.small_int i) with comment = Some name } | None -> E.small_int i) @@ -757,7 +751,13 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch) | EffectCall _ | Assign _ -> Js_output.make (compile_whole lambda_cxt) and compile_string_cases ~get_cstr_name cxt switch_exp table default = - compile_general_cases ~get_cstr_name E.as_value E.string_equal cxt + compile_general_cases ~get_cstr_name + (fun as_value -> + let comment = + get_cstr_name as_value |> Option.map (fun x -> x.Lambda.name) + in + E.as_value ?comment as_value) + E.string_equal cxt (fun ?default ?declaration e clauses -> S.string_switch ?default ?declaration e clauses) switch_exp table default diff --git a/test/blackbox-tests/complex-constant-inline.t b/test/blackbox-tests/complex-constant-inline.t index 05545c4d39..44ca6f5c24 100644 --- a/test/blackbox-tests/complex-constant-inline.t +++ b/test/blackbox-tests/complex-constant-inline.t @@ -43,7 +43,7 @@ message = "b"; } else { let tmp = 12345; - message = typeof tmp === "number" || tmp.TAG === /* Vacations */0 ? "a" : "b"; + message = /* tag */typeof tmp === "number" || typeof tmp === "string" || tmp.TAG === /* Vacations */0 ? "a" : "b"; } const Test1 = { diff --git a/test/blackbox-tests/mel-as-inline-records.t b/test/blackbox-tests/mel-as-inline-records.t index 127271e7e8..5ca6ea0379 100644 --- a/test/blackbox-tests/mel-as-inline-records.t +++ b/test/blackbox-tests/mel-as-inline-records.t @@ -42,7 +42,8 @@ Test `@mel.as` in inline records / record extensions renamed: "Corentin" }; - const user2 = /* User */{ + const user2 = { + TAG: /* User */0, renamed: "Corentin" }; diff --git a/test/blackbox-tests/stdout.t b/test/blackbox-tests/stdout.t index c1b308c438..53d458a908 100644 --- a/test/blackbox-tests/stdout.t +++ b/test/blackbox-tests/stdout.t @@ -8,7 +8,8 @@ const Stdlib__Format = require("melange/format.js"); - Stdlib__Format.eprintf(/* Format */{ + Stdlib__Format.eprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "hello, world", diff --git a/test/blackbox-tests/unicode-format-strings.t b/test/blackbox-tests/unicode-format-strings.t index b93ede7977..dd05fd0ef8 100644 --- a/test/blackbox-tests/unicode-format-strings.t +++ b/test/blackbox-tests/unicode-format-strings.t @@ -23,7 +23,8 @@ const Curry = require("melange.js/curry.js"); const Stdlib__Format = require("melange/format.js"); - console.log(Curry._1(Stdlib__Format.sprintf(/* Format */{ + console.log(Curry._1(Stdlib__Format.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "ä½  ", From ae8d54e93fc5aff6511a1e99674174c32625d743 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Wed, 25 Sep 2024 23:23:56 +0100 Subject: [PATCH 08/19] promote variants as strings tests --- test/blackbox-tests/mel-as-variants.t | 6 +++--- test/blackbox-tests/variants-as-strings.t | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/test/blackbox-tests/mel-as-variants.t b/test/blackbox-tests/mel-as-variants.t index 4fdef9227c..3374bff59c 100644 --- a/test/blackbox-tests/mel-as-variants.t +++ b/test/blackbox-tests/mel-as-variants.t @@ -35,7 +35,7 @@ Test `@mel.as` in variant constructors function f(param) { if (/* tag */typeof param === "number" || typeof param === "string") { - if (param === 0) { + if (param === /* No_payload */0) { return "payload1"; } else { return "nopaylod2"; @@ -83,12 +83,12 @@ Test `@mel.as` in variant constructors function f(param) { if (/* tag */typeof param === "number" || typeof param === "string") { - if (param === 0) { + if (param === /* No_payload */0) { return "nopayload1"; } else { return "nopaylod2"; } - } else if (param.TAG === "payload1") { + } else if (param.TAG === /* Has_payload */"payload1") { return "payload1"; } else { return "payload2"; diff --git a/test/blackbox-tests/variants-as-strings.t b/test/blackbox-tests/variants-as-strings.t index 29b84f5dec..524bebe484 100644 --- a/test/blackbox-tests/variants-as-strings.t +++ b/test/blackbox-tests/variants-as-strings.t @@ -91,7 +91,7 @@ function f(x) { - if (x === "A") { + if (x === /* A */"A") { return "a"; } else { return "b"; From 2b6a6e1ad6441889e4a9399ee80e35f0f36976dd Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Thu, 26 Sep 2024 00:00:43 +0100 Subject: [PATCH 09/19] no jsConverter for variants --- jscomp/test/ast_abstract_test.ml | 49 +------------------ jscomp/test/ast_js_mapper_poly_test.ml | 62 ------------------------ jscomp/test/ast_js_mapper_test.ml | 3 +- jscomp/test/ast_js_mapper_test.mli | 3 +- jscomp/test/ast_mapper_defensive_test.ml | 13 +---- 5 files changed, 7 insertions(+), 123 deletions(-) diff --git a/jscomp/test/ast_abstract_test.ml b/jscomp/test/ast_abstract_test.ml index 34e20cfdf5..bc8a3f9988 100644 --- a/jscomp/test/ast_abstract_test.ml +++ b/jscomp/test/ast_abstract_test.ml @@ -38,60 +38,15 @@ let () = idx `b; idx `c - -type a = - | A - | B [@mel.as 3] - | C -[@@deriving jsConverter { newType }] - -let id x = - eq __LOC__ (aFromJs (aToJs x )) x -let a0 = aToJs A -let a1 = aToJs B - -let () = - id A ; - id B ; - id C - - -type b = - | D0 - | D1 - | D2 - | D3 -[@@deriving jsConverter { newType }] - - -let b0 = bToJs D0 -let b1 = bToJs D1 - -let idb v = - eq __LOC__ (bFromJs (bToJs v )) v - -let () = idb D0; idb D1; idb D2 ; idb D3 -type c = - | D0 [@mel.as 3] - | D1 - | D2 - | D3 -[@@deriving jsConverter {newType }] - -let c0 = cToJs D0 - -let idc v = eq __LOC__ (cFromJs (cToJs v)) v - -let () = idc D0; idc D1 ; idc D2; idc D3 type h = | JsMapperEraseType - | B [@@deriving accessors, jsConverter { newType } ] + | B [@@deriving accessors] type z = | ZFromJs | ZToJs | ZXx (* not overridden *) - [@@deriving accessors, jsConverter ] + [@@deriving accessors] ;; Mt.from_pair_suites __MODULE__ !suites diff --git a/jscomp/test/ast_js_mapper_poly_test.ml b/jscomp/test/ast_js_mapper_poly_test.ml index 77913dded5..c01c45229f 100644 --- a/jscomp/test/ast_js_mapper_poly_test.ml +++ b/jscomp/test/ast_js_mapper_poly_test.ml @@ -29,68 +29,6 @@ let () = -type v = - | A0 - | A1 [@mel.as 3] - | A2 - | A3 -[@@deriving jsConverter] - -let eqV (x : v) (y : v) = x = y -let eqVOpt (x : v option) y= - match x,y with - | Some x, Some y -> x = y - | None, None -> true - | _, _ -> false - -let s = function - | A0 -> "A0" - | A1 -> "A1" - | A2 -> "A2" - | A3 -> "A3" - -let () = - eq __LOC__ (Array.map vToJs [|A0;A1;A2;A3|]) [|0;3;4;5|]; - eq __LOC__ (Array.map vFromJs [|0;1;2;3;4;5;6|]) - [|Some A0; None; None; Some A1; Some A2; Some A3; None|] - - -type v1 = - | B0 - | B1 - | B2 - | B3 - | B4 - | B5 -[@@deriving jsConverter] -let () = - eq __LOC__ (Array.map v1ToJs [|B0;B1;B2;B3;B4;B5|]) [|0;1;2;3;4;5|]; - eq __LOC__ (Array.map v1FromJs [|-1;0;1;2;3;4;5;6|]) - [|None;Some B0; Some B1; Some B2; Some B3; Some B4; Some B5; None|] - -(** TODO: add newType support *) -type v2 = - | C0 [@mel.as 2 ] - | C1 - | C2 - | C3 - | C4 - | C5 -[@@deriving jsConverter ] - - ;; let (+>) = Array.append -let () = - eq __LOC__ - (Array.map v2ToJs [|C0; C1; C2 ; C3 ; C4; C5 |]) - [|2;3;4;5;6;7|]; - eq __LOC__ - (Array.map v2FromJs [|0;1;2;3;4;5;6;7;8|]) - ( - [|None;None|]+> - (Array.map (fun x -> Some x) [|C0; C1; C2 ; C3 ; C4; C5 |]) +> - [|None|] - ) - ;; Mt.from_pair_suites __MODULE__ !suites diff --git a/jscomp/test/ast_js_mapper_test.ml b/jscomp/test/ast_js_mapper_test.ml index d5b0b10e89..7a67dab937 100644 --- a/jscomp/test/ast_js_mapper_test.ml +++ b/jscomp/test/ast_js_mapper_test.ml @@ -34,7 +34,8 @@ type a = | A1 [@mel.as 3] | A2 | A3 -and b = + +type b = [ `b0 | `b1 | `b2 diff --git a/jscomp/test/ast_js_mapper_test.mli b/jscomp/test/ast_js_mapper_test.mli index 386bc05868..ea8b483a17 100644 --- a/jscomp/test/ast_js_mapper_test.mli +++ b/jscomp/test/ast_js_mapper_test.mli @@ -12,7 +12,8 @@ type a = | A1 | A2 | A3 -and b = + +type b = [ `b0 | `b1 | `b2 diff --git a/jscomp/test/ast_mapper_defensive_test.ml b/jscomp/test/ast_mapper_defensive_test.ml index 996d322fbb..86a4abec4c 100644 --- a/jscomp/test/ast_mapper_defensive_test.ml +++ b/jscomp/test/ast_mapper_defensive_test.ml @@ -8,15 +8,7 @@ let throw loc x = -type a = - | A0 - | A1 - | A2 -and b = - | B0 - | B1 [@mel.as 3] - | B2 -and c = [ +type c = [ | `c0 | `c1 | `c2 @@ -24,9 +16,6 @@ and c = [ [@@deriving jsConverter { newType } ] -(* ;; aFromJs (Obj.magic 3) *) -let () = throw __LOC__ (fun _ -> ignore @@ aFromJs (Obj.magic 3)) -let () = throw __LOC__ (fun _ -> ignore @@ bFromJs (Obj.magic 2)) let () = throw __LOC__ (fun _ -> ignore @@ cFromJs (Obj.magic 33)) (* ;; Js.log2 *) From c5b0c97942de62b5c5d0c9cc36b2944c7cff0ac3 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 29 Sep 2024 22:21:50 +0100 Subject: [PATCH 10/19] chore: snapshot runtime tests --- flake.lock | 14 +- jscomp/test/dist-es6/jscomp/test/mt.mjs | 4 +- .../dist/jscomp/test/406_primitive_test.js | 6 +- .../test/dist/jscomp/test/a_recursive_type.js | 6 +- .../dist/jscomp/test/adt_optimize_test.js | 72 +- jscomp/test/dist/jscomp/test/arith_lexer.js | 2 +- jscomp/test/dist/jscomp/test/arith_syntax.js | 2 +- .../dist/jscomp/test/ast_abstract_test.js | 148 +- .../jscomp/test/ast_js_mapper_poly_test.js | 183 - .../dist/jscomp/test/ast_js_mapper_test.js | 17 - .../jscomp/test/ast_mapper_defensive_test.js | 47 +- jscomp/test/dist/jscomp/test/bal_set_mini.js | 53 +- jscomp/test/dist/jscomp/test/bdd.js | 126 +- jscomp/test/dist/jscomp/test/big_enum.js | 604 +- .../test/dist/jscomp/test/bs_ignore_test.js | 8 +- .../jscomp/test/bs_node_string_buffer_test.js | 12 +- .../test/dist/jscomp/test/caml_format_test.js | 213 +- jscomp/test/dist/jscomp/test/class_repr.js | 12 +- jscomp/test/dist/jscomp/test/compare_test.js | 29 +- jscomp/test/dist/jscomp/test/const_test.js | 2 +- .../test/dist/jscomp/test/debug_mode_value.js | 3 +- .../dist/jscomp/test/defunctor_make_test.js | 70 +- jscomp/test/dist/jscomp/test/demo_int_map.js | 90 +- jscomp/test/dist/jscomp/test/demo_page.js | 9 +- .../dist/jscomp/test/derive_projector_test.js | 6 +- jscomp/test/dist/jscomp/test/digest_test.js | 3 +- .../dist/jscomp/test/exception_repr_test.js | 3 +- .../dist/jscomp/test/ext_filename_test.js | 9 +- jscomp/test/dist/jscomp/test/ext_log_test.js | 33 +- .../dist/jscomp/test/flexible_array_test.js | 193 +- .../dist/jscomp/test/float_of_bits_test.js | 6 +- jscomp/test/dist/jscomp/test/float_test.js | 3 +- .../dist/jscomp/test/flow_parser_reg_test.js | 5369 +++++----- jscomp/test/dist/jscomp/test/format_test.js | 24 +- .../dist/jscomp/test/fun_pattern_match.js | 70 +- jscomp/test/dist/jscomp/test/gpr_1285_test.js | 6 +- jscomp/test/dist/jscomp/test/gpr_1658_test.js | 2 +- jscomp/test/dist/jscomp/test/gpr_1698_test.js | 14 +- jscomp/test/dist/jscomp/test/gpr_1946_test.js | 2 +- jscomp/test/dist/jscomp/test/gpr_2250_test.js | 3 +- jscomp/test/dist/jscomp/test/gpr_2413_test.js | 2 +- jscomp/test/dist/jscomp/test/gpr_2642_test.js | 2 +- jscomp/test/dist/jscomp/test/gpr_3209_test.js | 4 +- jscomp/test/dist/jscomp/test/gpr_3536_test.js | 3 +- jscomp/test/dist/jscomp/test/gpr_3546_test.js | 3 +- jscomp/test/dist/jscomp/test/gpr_3609_test.js | 2 +- jscomp/test/dist/jscomp/test/gpr_3697_test.js | 3 +- jscomp/test/dist/jscomp/test/gpr_4407_test.js | 3 +- jscomp/test/dist/jscomp/test/gpr_4519_test.js | 8 +- jscomp/test/dist/jscomp/test/gpr_4900_test.js | 10 +- jscomp/test/dist/jscomp/test/gpr_4924_test.js | 22 +- jscomp/test/dist/jscomp/test/gpr_5169_test.js | 6 +- .../jscomp/test/gpr_5280_optimize_test.js | 9 +- jscomp/test/dist/jscomp/test/hamming_test.js | 21 +- .../test/dist/jscomp/test/inline_map2_test.js | 878 +- .../test/dist/jscomp/test/inline_map_test.js | 90 +- .../dist/jscomp/test/inline_record_test.js | 15 +- jscomp/test/dist/jscomp/test/int32_test.js | 9 +- .../dist/jscomp/test/int64_mul_div_test.js | 18 +- jscomp/test/dist/jscomp/test/int64_test.js | 11 +- jscomp/test/dist/jscomp/test/int_map.js | 556 +- jscomp/test/dist/jscomp/test/js_json_test.js | 76 +- jscomp/test/dist/jscomp/test/js_obj_test.js | 3 +- .../test/large_record_duplication_test.js | 10 +- jscomp/test/dist/jscomp/test/libarg_test.js | 30 +- jscomp/test/dist/jscomp/test/map_find_test.js | 180 +- jscomp/test/dist/jscomp/test/map_test.js | 191 +- jscomp/test/dist/jscomp/test/mario_game.js | 866 +- .../test/dist/jscomp/test/miss_colon_test.js | 6 +- jscomp/test/dist/jscomp/test/mock_mt.js | 2 +- jscomp/test/dist/jscomp/test/mt.js | 4 +- .../jscomp/test/mutual_non_recursive_type.js | 3 +- .../dist/jscomp/test/ocaml_parsetree_test.js | 1040 +- .../test/dist/jscomp/test/ocaml_proto_test.js | 1340 ++- jscomp/test/dist/jscomp/test/ocaml_re_test.js | 349 +- .../dist/jscomp/test/ocaml_typedtree_test.js | 9451 ++++++++++------- jscomp/test/dist/jscomp/test/offset.js | 477 +- jscomp/test/dist/jscomp/test/opr_3576_test.js | 6 +- jscomp/test/dist/jscomp/test/opr_4560_test.js | 6 +- .../test/dist/jscomp/test/option_repr_test.js | 6 +- jscomp/test/dist/jscomp/test/parser_api.js | 1122 +- .../test/dist/jscomp/test/parser_api_test.js | 20 +- jscomp/test/dist/jscomp/test/pq_test.js | 74 +- jscomp/test/dist/jscomp/test/printf_sim.js | 18 +- jscomp/test/dist/jscomp/test/printf_test.js | 15 +- jscomp/test/dist/jscomp/test/qcc.js | 55 +- jscomp/test/dist/jscomp/test/random_test.js | 3 +- jscomp/test/dist/jscomp/test/rbset.js | 447 +- .../dist/jscomp/test/re_or_res/reasonReact.js | 10 +- .../test/dist/jscomp/test/rec_module_test.js | 477 +- .../dist/jscomp/test/record_extension_test.js | 4 +- .../jscomp/test/recursive_records_test.js | 11 +- jscomp/test/dist/jscomp/test/scanf_io.js | 18 +- .../scanf_reference_error_regression_test.js | 15 +- jscomp/test/dist/jscomp/test/scanf_test.js | 6 +- jscomp/test/dist/jscomp/test/set_gen.js | 263 +- jscomp/test/dist/jscomp/test/sexpm.js | 87 +- jscomp/test/dist/jscomp/test/sexpm_test.js | 15 +- .../dist/jscomp/test/simplify_lambda_632o.js | 24 +- .../test/dist/jscomp/test/sprintf_reg_test.js | 12 +- .../jscomp/test/stdlib_bytes_utf8_test.js | 3 +- jscomp/test/dist/jscomp/test/string_set.js | 65 +- jscomp/test/dist/jscomp/test/test_demo.js | 12 +- jscomp/test/dist/jscomp/test/test_fib.js | 18 +- jscomp/test/dist/jscomp/test/test_for_map.js | 556 +- jscomp/test/dist/jscomp/test/test_format.js | 3 +- .../test/dist/jscomp/test/test_formatter.js | 3 +- .../jscomp/test/test_functor_dead_code.js | 6 +- .../test/dist/jscomp/test/test_incomplete.js | 2 +- .../dist/jscomp/test/test_int_map_find.js | 70 +- .../test/dist/jscomp/test/test_internalOO.js | 1682 +-- jscomp/test/dist/jscomp/test/test_per.js | 3 +- jscomp/test/dist/jscomp/test/test_set.js | 294 +- jscomp/test/dist/jscomp/test/test_sprintf.js | 3 +- .../test/dist/jscomp/test/test_string_map.js | 90 +- jscomp/test/dist/jscomp/test/test_switch.js | 4 +- jscomp/test/dist/jscomp/test/test_trywith.js | 2 +- jscomp/test/dist/jscomp/test/testing.js | 9 +- .../dist/jscomp/test/tfloat_record_test.js | 6 +- jscomp/test/dist/jscomp/test/ticker.js | 691 +- jscomp/test/dist/jscomp/test/topsort_test.js | 477 +- jscomp/test/dist/jscomp/test/tscanf_test.js | 711 +- jscomp/test/dist/jscomp/test/typeof_test.js | 4 +- jscomp/test/dist/jscomp/test/variant.js | 10 +- 124 files changed, 16876 insertions(+), 13743 deletions(-) diff --git a/flake.lock b/flake.lock index e856cd0cd9..38f8609133 100644 --- a/flake.lock +++ b/flake.lock @@ -65,11 +65,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1727261331, - "narHash": "sha256-8bOk8r2sRmJnshj4LtwPIlske+9SVcLQrGOdBNesPYc=", + "lastModified": 1727565345, + "narHash": "sha256-Jiga8utNl57DxigI2/vyhQwKVpmfthf9TNTXCDu5uhw=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "c105c75672194247d87027f263ba4f640f9ae960", + "rev": "c175754cfb3e8c2fdc2bb7a6b989426313f0665c", "type": "github" }, "original": { @@ -80,17 +80,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1727234896, - "narHash": "sha256-UYfPGgxulnDXzHeKCmMoPdvyUd7uktMaEzljVHB3vOk=", + "lastModified": 1727506465, + "narHash": "sha256-3kTzEJ3X+RmNB9hamk+HnRj4MVLuZ2nzGaT1IeKuHZg=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "84bd184f8179ff6999d6d10e6b0ca575b4118674", + "rev": "0c839cfcda894af2030d5731414542a92a7af207", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "84bd184f8179ff6999d6d10e6b0ca575b4118674", + "rev": "0c839cfcda894af2030d5731414542a92a7af207", "type": "github" } }, diff --git a/jscomp/test/dist-es6/jscomp/test/mt.mjs b/jscomp/test/dist-es6/jscomp/test/mt.mjs index 86fcf1b555..84774da219 100644 --- a/jscomp/test/dist-es6/jscomp/test/mt.mjs +++ b/jscomp/test/dist-es6/jscomp/test/mt.mjs @@ -50,7 +50,7 @@ function close_enough(thresholdOpt, a, b) { } function handleCode(spec) { - switch (spec.TAG | 0) { + switch (spec.TAG) { case /* Eq */0 : Assert.deepEqual(spec._0, spec._1); return ; @@ -116,7 +116,7 @@ function from_pair_suites(name, suites) { return Stdlib__List.iter((function (param) { const name = param[0]; const _fn = Curry._1(param[1], undefined); - switch (_fn.TAG | 0) { + switch (_fn.TAG) { case /* Eq */0 : console.log([ name, diff --git a/jscomp/test/dist/jscomp/test/406_primitive_test.js b/jscomp/test/dist/jscomp/test/406_primitive_test.js index b6e0034541..7e51900351 100644 --- a/jscomp/test/dist/jscomp/test/406_primitive_test.js +++ b/jscomp/test/dist/jscomp/test/406_primitive_test.js @@ -19,11 +19,13 @@ function eq(loc, x, y) { eq("File \"jscomp/test/406_primitive_test.ml\", line 13, characters 6-13", 32, 32); -const backend_type = /* Other */{ +const backend_type = { + TAG: /* Other */0, _0: "Melange" }; -eq("File \"jscomp/test/406_primitive_test.ml\", line 24, characters 6-13", backend_type, /* Other */{ +eq("File \"jscomp/test/406_primitive_test.ml\", line 24, characters 6-13", backend_type, { + TAG: /* Other */0, _0: "Melange" }); diff --git a/jscomp/test/dist/jscomp/test/a_recursive_type.js b/jscomp/test/dist/jscomp/test/a_recursive_type.js index b6e1571107..df4f784937 100644 --- a/jscomp/test/dist/jscomp/test/a_recursive_type.js +++ b/jscomp/test/dist/jscomp/test/a_recursive_type.js @@ -7,11 +7,13 @@ function g(x) { return Curry._1(x._0, x); } -const loop = g(/* A */{ +const loop = g({ + TAG: /* A */0, _0: g }); -const x = /* A */{ +const x = { + TAG: /* A */0, _0: g }; diff --git a/jscomp/test/dist/jscomp/test/adt_optimize_test.js b/jscomp/test/dist/jscomp/test/adt_optimize_test.js index 4967b91cf4..8543c4dc4a 100644 --- a/jscomp/test/dist/jscomp/test/adt_optimize_test.js +++ b/jscomp/test/dist/jscomp/test/adt_optimize_test.js @@ -4,11 +4,27 @@ const Caml_js_exceptions = require("melange.js/caml_js_exceptions.js"); function f(x) { - return x + 1 | 0; + switch (x) { + case /* A */0 : + return 1; + case /* B */1 : + return 2; + case /* C */2 : + return 3; + + } } function f_0(x) { - return x - 1 | 0; + switch (x) { + case /* A */0 : + return -1; + case /* B */1 : + return 0; + case /* C */2 : + return 1; + + } } function f2(param) { @@ -20,7 +36,19 @@ function f2(param) { } function f3(param) { - return param; + switch (param) { + case /* X0 */0 : + return /* Y0 */0; + case /* X1 */1 : + return /* Y1 */1; + case /* X2 */2 : + return /* Y2 */2; + case /* X3 */3 : + return /* Y3 */3; + case /* X4 */4 : + return /* Y4 */4; + + } } function f4(param) { @@ -28,7 +56,7 @@ function f4(param) { } function f5(param) { - if (typeof param === "number") { + if (/* tag */typeof param === "number" || typeof param === "string") { switch (param) { case /* A */0 : return 1; @@ -39,7 +67,7 @@ function f5(param) { } } else { - switch (param.TAG | 0) { + switch (param.TAG) { case /* C */0 : case /* D */1 : return 1; @@ -51,19 +79,21 @@ function f5(param) { } function f6(param) { - if (typeof param === "number") { - if (param >= 2) { - return 2; - } else { - return 0; - } - } else { + if (!/* tag */(typeof param === "number" || typeof param === "string")) { return 1; } + switch (param) { + case /* A */0 : + case /* B */1 : + return 0; + case /* F */2 : + return 2; + + } } function f7(param) { - if (typeof param === "number") { + if (/* tag */typeof param === "number" || typeof param === "string") { switch (param) { case /* A */0 : return 1; @@ -74,7 +104,7 @@ function f7(param) { } } else { - switch (param.TAG | 0) { + switch (param.TAG) { case /* C */0 : return 3; case /* D */1 : @@ -87,7 +117,7 @@ function f7(param) { } function f8(param) { - if (typeof param === "number") { + if (/* tag */typeof param === "number" || typeof param === "string") { switch (param) { case /* T60 */0 : case /* T61 */1 : @@ -96,7 +126,7 @@ function f8(param) { return 3; } } else { - switch (param.TAG | 0) { + switch (param.TAG) { case /* T64 */0 : case /* T65 */1 : return 2; @@ -107,7 +137,7 @@ function f8(param) { } function f9(param) { - if (typeof param === "number") { + if (/* tag */typeof param === "number" || typeof param === "string") { switch (param) { case /* T60 */0 : case /* T61 */1 : @@ -117,7 +147,7 @@ function f9(param) { return 3; } } else { - switch (param.TAG | 0) { + switch (param.TAG) { case /* T64 */0 : case /* T65 */1 : return 2; @@ -128,7 +158,7 @@ function f9(param) { } function f10(param) { - if (typeof param === "number") { + if (/* tag */typeof param === "number" || typeof param === "string") { switch (param) { case /* T60 */0 : return 0; @@ -141,7 +171,7 @@ function f10(param) { } } else { - switch (param.TAG | 0) { + switch (param.TAG) { case /* T64 */0 : case /* T65 */1 : return 2; @@ -154,7 +184,7 @@ function f10(param) { } function f11(x) { - if (typeof x === "number") { + if (/* tag */typeof x === "number" || typeof x === "string") { return 2; } if (x.TAG === /* D */0) { diff --git a/jscomp/test/dist/jscomp/test/arith_lexer.js b/jscomp/test/dist/jscomp/test/arith_lexer.js index 610b1e95fe..7c8a6e68e4 100644 --- a/jscomp/test/dist/jscomp/test/arith_lexer.js +++ b/jscomp/test/dist/jscomp/test/arith_lexer.js @@ -65,7 +65,7 @@ function lexeme(lexbuf) { } function str(e) { - switch (e.TAG | 0) { + switch (e.TAG) { case /* Numeral */0 : return Stdlib.string_of_float(e._0); case /* Plus */1 : diff --git a/jscomp/test/dist/jscomp/test/arith_syntax.js b/jscomp/test/dist/jscomp/test/arith_syntax.js index 4944d3d635..85e14da3e6 100644 --- a/jscomp/test/dist/jscomp/test/arith_syntax.js +++ b/jscomp/test/dist/jscomp/test/arith_syntax.js @@ -4,7 +4,7 @@ const Stdlib = require("melange/stdlib.js"); function str(e) { - switch (e.TAG | 0) { + switch (e.TAG) { case /* Numeral */0 : return Stdlib.string_of_float(e._0); case /* Plus */1 : diff --git a/jscomp/test/dist/jscomp/test/ast_abstract_test.js b/jscomp/test/dist/jscomp/test/ast_abstract_test.js index dac1cde8d6..1acc24d674 100644 --- a/jscomp/test/dist/jscomp/test/ast_abstract_test.js +++ b/jscomp/test/dist/jscomp/test/ast_abstract_test.js @@ -1,7 +1,6 @@ // Generated by Melange 'use strict'; -const Caml_js_exceptions = require("melange.js/caml_js_exceptions.js"); const Js__Js_mapper_runtime = require("melange.js/js_mapper_runtime.js"); const Mt = require("./mt.js"); @@ -78,139 +77,20 @@ idx("b"); idx("c"); -const jsMapperConstantArray = [ - 0, - 3, - 4 -]; - -function aToJs(param) { - return jsMapperConstantArray[param]; -} - -function aFromJs(param) { - return Js__Js_mapper_runtime.fromIntAssert(3, jsMapperConstantArray, param); -} - -function id(x) { - eq("File \"jscomp/test/ast_abstract_test.ml\", line 49, characters 8-15", aFromJs(aToJs(x)), x); -} - -const a0 = aToJs(/* A */0); - -const a1 = aToJs(/* B */1); - -id(/* A */0); - -id(/* B */1); - -id(/* C */2); - -function bToJs(param) { - return param + 0 | 0; -} - -function bFromJs(param) { - if (!(param <= 3 && 0 <= param)) { - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "_none_", - 0, - -1 - ] - }); - } - return param - 0 | 0; -} - -function idb(v) { - eq("File \"jscomp/test/ast_abstract_test.ml\", line 71, characters 5-12", bFromJs(v + 0 | 0), v); -} - -idb(/* D0 */0); - -idb(/* D1 */1); - -idb(/* D2 */2); - -idb(/* D3 */3); - -function cToJs(param) { - return param + 3 | 0; -} - -function cFromJs(param) { - if (!(param <= 6 && 3 <= param)) { - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "_none_", - 0, - -1 - ] - }); - } - return param - 3 | 0; -} - -function idc(v) { - eq("File \"jscomp/test/ast_abstract_test.ml\", line 83, characters 15-22", cFromJs(v + 3 | 0), v); -} - -idc(/* D0 */0); - -idc(/* D1 */1); - -idc(/* D2 */2); - -idc(/* D3 */3); - -function hToJs(param) { - return param + 0 | 0; -} - -function hFromJs(param) { - if (!(param <= 1 && 0 <= param)) { - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "_none_", - 0, - -1 - ] - }); - } - return param - 0 | 0; -} - -function zToJs(param) { - return param + 0 | 0; -} - -function zFromJs(param) { - if (param <= 2 && 0 <= param) { - return param - 0 | 0; - } - -} - Mt.from_pair_suites("Ast_abstract_test", suites.contents); const x0 = "a"; const x1 = "b"; -const b0 = 0; - -const b1 = 1; - -const c0 = 3; - const jsMapperEraseType = /* JsMapperEraseType */0; const b = /* B */1; +const zFromJs = /* ZFromJs */0; + +const zToJs = /* ZToJs */1; + const zXx = /* ZXx */2; exports.suites = suites; @@ -225,25 +105,9 @@ exports.xFromJs = xFromJs; exports.idx = idx; exports.x0 = x0; exports.x1 = x1; -exports.aToJs = aToJs; -exports.aFromJs = aFromJs; -exports.id = id; -exports.a0 = a0; -exports.a1 = a1; -exports.bToJs = bToJs; -exports.bFromJs = bFromJs; -exports.b0 = b0; -exports.b1 = b1; -exports.idb = idb; -exports.cToJs = cToJs; -exports.cFromJs = cFromJs; -exports.c0 = c0; -exports.idc = idc; exports.jsMapperEraseType = jsMapperEraseType; exports.b = b; -exports.hToJs = hToJs; -exports.hFromJs = hFromJs; -exports.zXx = zXx; -exports.zToJs = zToJs; exports.zFromJs = zFromJs; +exports.zToJs = zToJs; +exports.zXx = zXx; /* Not a pure module */ diff --git a/jscomp/test/dist/jscomp/test/ast_js_mapper_poly_test.js b/jscomp/test/dist/jscomp/test/ast_js_mapper_poly_test.js index 38b0de9151..0da4706fbd 100644 --- a/jscomp/test/dist/jscomp/test/ast_js_mapper_poly_test.js +++ b/jscomp/test/dist/jscomp/test/ast_js_mapper_poly_test.js @@ -1,7 +1,6 @@ // Generated by Melange 'use strict'; -const Js__Js_mapper_runtime = require("melange.js/js_mapper_runtime.js"); const Mt = require("./mt.js"); const Stdlib__Array = require("melange/array.js"); @@ -76,179 +75,6 @@ eq("File \"jscomp/test/ast_js_mapper_poly_test.ml\", line 28, characters 5-12", "x" ]); -const jsMapperConstantArray = [ - 0, - 3, - 4, - 5 -]; - -function vToJs(param) { - return jsMapperConstantArray[param]; -} - -function vFromJs(param) { - return Js__Js_mapper_runtime.fromInt(4, jsMapperConstantArray, param); -} - -function eqV(x, y) { - return x === y; -} - -function eqVOpt(x, y) { - if (x !== undefined) { - if (y !== undefined) { - return x === y; - } else { - return false; - } - } else { - return y === undefined; - } -} - -function s(param) { - switch (param) { - case /* A0 */0 : - return "A0"; - case /* A1 */1 : - return "A1"; - case /* A2 */2 : - return "A2"; - case /* A3 */3 : - return "A3"; - - } -} - -eq("File \"jscomp/test/ast_js_mapper_poly_test.ml\", line 53, characters 5-12", Stdlib__Array.map(vToJs, [ - /* A0 */0, - /* A1 */1, - /* A2 */2, - /* A3 */3 - ]), [ - 0, - 3, - 4, - 5 - ]); - -eq("File \"jscomp/test/ast_js_mapper_poly_test.ml\", line 54, characters 5-12", Stdlib__Array.map(vFromJs, [ - 0, - 1, - 2, - 3, - 4, - 5, - 6 - ]), [ - /* A0 */0, - undefined, - undefined, - /* A1 */1, - /* A2 */2, - /* A3 */3, - undefined - ]); - -function v1ToJs(param) { - return param + 0 | 0; -} - -function v1FromJs(param) { - if (param <= 5 && 0 <= param) { - return param - 0 | 0; - } - -} - -eq("File \"jscomp/test/ast_js_mapper_poly_test.ml\", line 67, characters 5-12", Stdlib__Array.map(v1ToJs, [ - /* B0 */0, - /* B1 */1, - /* B2 */2, - /* B3 */3, - /* B4 */4, - /* B5 */5 - ]), [ - 0, - 1, - 2, - 3, - 4, - 5 - ]); - -eq("File \"jscomp/test/ast_js_mapper_poly_test.ml\", line 68, characters 5-12", Stdlib__Array.map(v1FromJs, [ - -1, - 0, - 1, - 2, - 3, - 4, - 5, - 6 - ]), [ - undefined, - /* B0 */0, - /* B1 */1, - /* B2 */2, - /* B3 */3, - /* B4 */4, - /* B5 */5, - undefined - ]); - -function v2ToJs(param) { - return param + 2 | 0; -} - -function v2FromJs(param) { - if (param <= 7 && 2 <= param) { - return param - 2 | 0; - } - -} - -eq("File \"jscomp/test/ast_js_mapper_poly_test.ml\", line 85, characters 5-12", Stdlib__Array.map(v2ToJs, [ - /* C0 */0, - /* C1 */1, - /* C2 */2, - /* C3 */3, - /* C4 */4, - /* C5 */5 - ]), [ - 2, - 3, - 4, - 5, - 6, - 7 - ]); - -eq("File \"jscomp/test/ast_js_mapper_poly_test.ml\", line 88, characters 5-12", Stdlib__Array.map(v2FromJs, [ - 0, - 1, - 2, - 3, - 4, - 5, - 6, - 7, - 8 - ]), Stdlib__Array.append(Stdlib__Array.append([ - undefined, - undefined - ], Stdlib__Array.map((function (x) { - return x; - }), [ - /* C0 */0, - /* C1 */1, - /* C2 */2, - /* C3 */3, - /* C4 */4, - /* C5 */5 - ])), [undefined])); - Mt.from_pair_suites("Ast_js_mapper_poly_test", suites.contents); const $plus$great = Stdlib__Array.append; @@ -260,14 +86,5 @@ exports.uToJs = uToJs; exports.uFromJs = uFromJs; exports.eqU = eqU; exports.eqUOpt = eqUOpt; -exports.vToJs = vToJs; -exports.vFromJs = vFromJs; -exports.eqV = eqV; -exports.eqVOpt = eqVOpt; -exports.s = s; -exports.v1ToJs = v1ToJs; -exports.v1FromJs = v1FromJs; -exports.v2ToJs = v2ToJs; -exports.v2FromJs = v2FromJs; exports.$plus$great = $plus$great; /* Not a pure module */ diff --git a/jscomp/test/dist/jscomp/test/ast_js_mapper_test.js b/jscomp/test/dist/jscomp/test/ast_js_mapper_test.js index 4193156703..af7be90c3f 100644 --- a/jscomp/test/dist/jscomp/test/ast_js_mapper_test.js +++ b/jscomp/test/dist/jscomp/test/ast_js_mapper_test.js @@ -53,21 +53,6 @@ function searchForSureExists(xs, k) { }; } -const jsMapperConstantArray = [ - 0, - 3, - 4, - 5 -]; - -function aToJs(param) { - return jsMapperConstantArray[param]; -} - -function aFromJs(param) { - return Js__Js_mapper_runtime.fromIntAssert(4, jsMapperConstantArray, param); -} - const _map = {"b0":"b0","b1":"b1","b2":"b2","b3":"b3"}; function bToJs(param) { @@ -81,8 +66,6 @@ function bFromJs(param) { exports.tToJs = tToJs; exports.tFromJs = tFromJs; exports.searchForSureExists = searchForSureExists; -exports.aToJs = aToJs; -exports.aFromJs = aFromJs; exports.bToJs = bToJs; exports.bFromJs = bFromJs; /* u Not a pure module */ diff --git a/jscomp/test/dist/jscomp/test/ast_mapper_defensive_test.js b/jscomp/test/dist/jscomp/test/ast_mapper_defensive_test.js index 1e1215ef32..b3723124bb 100644 --- a/jscomp/test/dist/jscomp/test/ast_mapper_defensive_test.js +++ b/jscomp/test/dist/jscomp/test/ast_mapper_defensive_test.js @@ -1,7 +1,6 @@ // Generated by Melange 'use strict'; -const Caml_js_exceptions = require("melange.js/caml_js_exceptions.js"); const Js__Js_mapper_runtime = require("melange.js/js_mapper_runtime.js"); const Mt = require("./mt.js"); @@ -29,38 +28,6 @@ function $$throw(loc, x) { }; } -function aToJs(param) { - return param + 0 | 0; -} - -function aFromJs(param) { - if (!(param <= 2 && 0 <= param)) { - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "_none_", - 0, - -1 - ] - }); - } - return param - 0 | 0; -} - -const jsMapperConstantArray = [ - 0, - 3, - 4 -]; - -function bToJs(param) { - return jsMapperConstantArray[param]; -} - -function bFromJs(param) { - return Js__Js_mapper_runtime.fromIntAssert(3, jsMapperConstantArray, param); -} - const _map = {"c0":"c0","c1":"c1","c2":"c2"}; function cToJs(param) { @@ -71,15 +38,7 @@ function cFromJs(param) { return Js__Js_mapper_runtime.raiseWhenNotFound(_map[param]); } -$$throw("File \"jscomp/test/ast_mapper_defensive_test.ml\", line 28, characters 16-23", (function (param) { - aFromJs(3); - })); - -$$throw("File \"jscomp/test/ast_mapper_defensive_test.ml\", line 29, characters 15-22", (function (param) { - bFromJs(2); - })); - -$$throw("File \"jscomp/test/ast_mapper_defensive_test.ml\", line 30, characters 15-22", (function (param) { +$$throw("File \"jscomp/test/ast_mapper_defensive_test.ml\", line 19, characters 15-22", (function (param) { cFromJs(33); })); @@ -88,10 +47,6 @@ Mt.from_pair_suites("Ast_mapper_defensive_test", suites.contents); exports.suites = suites; exports.test_id = test_id; exports.$$throw = $$throw; -exports.aToJs = aToJs; -exports.aFromJs = aFromJs; -exports.bToJs = bToJs; -exports.bFromJs = bFromJs; exports.cToJs = cToJs; exports.cFromJs = cFromJs; /* Not a pure module */ diff --git a/jscomp/test/dist/jscomp/test/bal_set_mini.js b/jscomp/test/dist/jscomp/test/bal_set_mini.js index dd172bc64d..bab4f0e33c 100644 --- a/jscomp/test/dist/jscomp/test/bal_set_mini.js +++ b/jscomp/test/dist/jscomp/test/bal_set_mini.js @@ -3,17 +3,18 @@ function height(param) { - if (param) { - return param._3; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param._3; } } function create(l, v, r) { const hl = height(l); const hr = height(r); - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: v, _2: r, @@ -25,7 +26,7 @@ function bal(l, v, r) { const hl = height(l); const hr = height(r); if (hl > (hr + 2 | 0)) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return /* Empty */0; } const lr = l._2; @@ -33,21 +34,22 @@ function bal(l, v, r) { const ll = l._0; if (height(ll) >= height(lr)) { return create(ll, lv, create(lr, v, r)); - } else if (lr) { - return create(create(ll, lv, lr._0), lr._1, create(lr._2, v, r)); - } else { + } else if (/* tag */typeof lr === "number" || typeof lr === "string") { return /* Empty */0; + } else { + return create(create(ll, lv, lr._0), lr._1, create(lr._2, v, r)); } } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: v, _2: r, _3: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (!r) { + if (/* tag */typeof r === "number" || typeof r === "string") { return /* Empty */0; } const rr = r._2; @@ -55,10 +57,10 @@ function bal(l, v, r) { const rl = r._0; if (height(rr) >= height(rl)) { return create(create(l, v, rl), rv, rr); - } else if (rl) { - return create(create(l, v, rl._0), rl._1, create(rl._2, rv, rr)); - } else { + } else if (/* tag */typeof rl === "number" || typeof rl === "string") { return /* Empty */0; + } else { + return create(create(l, v, rl._0), rl._1, create(rl._2, rv, rr)); } } @@ -73,8 +75,9 @@ function compare_int(x, y) { } function add(x, t) { - if (!t) { - return /* Node */{ + if (/* tag */typeof t === "number" || typeof t === "string") { + return { + TAG: /* Node */0, _0: /* Empty */0, _1: x, _2: /* Empty */0, @@ -98,11 +101,11 @@ function min_elt(_def, _param) { while(true) { const param = _param; const def = _def; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return def; } const l = param._0; - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return param._1; } _param = l; @@ -112,18 +115,18 @@ function min_elt(_def, _param) { } function remove_min_elt(l, v, r) { - if (l) { - return bal(remove_min_elt(l._0, l._1, l._2), v, r); - } else { + if (/* tag */typeof l === "number" || typeof l === "string") { return r; + } else { + return bal(remove_min_elt(l._0, l._1, l._2), v, r); } } function internal_merge(l, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return r; } - if (!r) { + if (/* tag */typeof r === "number" || typeof r === "string") { return l; } const rv = r._1; @@ -131,7 +134,7 @@ function internal_merge(l, r) { } function remove(x, tree) { - if (!tree) { + if (/* tag */typeof tree === "number" || typeof tree === "string") { return /* Empty */0; } const r = tree._2; @@ -150,7 +153,7 @@ function remove(x, tree) { function mem(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = compare_int(x, param._1); @@ -181,7 +184,7 @@ for(let i$2 = 0; i$2 <= 100000; ++i$2){ const match = v; -if (match) { +if (!/* tag */(typeof match === "number" || typeof match === "string")) { console.log("impossible"); } diff --git a/jscomp/test/dist/jscomp/test/bdd.js b/jscomp/test/dist/jscomp/test/bdd.js index 1e33f95511..d192a82dd5 100644 --- a/jscomp/test/dist/jscomp/test/bdd.js +++ b/jscomp/test/dist/jscomp/test/bdd.js @@ -7,11 +7,11 @@ const Caml_js_exceptions = require("melange.js/caml_js_exceptions.js"); function $$eval(_bdd, vars) { while(true) { const bdd = _bdd; - if (typeof bdd === "number") { - if (bdd) { - return false; - } else { + if (/* tag */typeof bdd === "number" || typeof bdd === "string") { + if (bdd === /* One */0) { return true; + } else { + return false; } } if (Caml_array.get(vars, bdd._1)) { @@ -24,11 +24,11 @@ function $$eval(_bdd, vars) { } function getId(bdd) { - if (typeof bdd === "number") { - if (bdd) { - return 0; - } else { + if (/* tag */typeof bdd === "number" || typeof bdd === "string") { + if (bdd === /* One */0) { return 1; + } else { + return 0; } } else { return bdd._2; @@ -66,7 +66,17 @@ function resize(newSize) { return ; } const n = bucket.hd; - if (typeof n === "number") { + if (/* tag */typeof n === "number" || typeof n === "string") { + if (n === /* One */0) { + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/test/bdd.ml", + 54, + 27 + ] + }); + } throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -75,14 +85,15 @@ function resize(newSize) { 27 ] }); + } else { + const ind = hashVal(getId(n._0), getId(n._3), n._1) & newSz_1; + Caml_array.set(newArr, ind, { + hd: n, + tl: Caml_array.get(newArr, ind) + }); + _bucket = bucket.tl; + continue ; } - const ind = hashVal(getId(n._0), getId(n._3), n._1) & newSz_1; - Caml_array.set(newArr, ind, { - hd: n, - tl: Caml_array.get(newArr, ind) - }); - _bucket = bucket.tl; - continue ; }; }; for(let n = 0 ,n_finish = sz_1.contents; n <= n_finish; ++n){ @@ -129,7 +140,17 @@ function mkNode(low, v, high) { const b = _b; if (b) { const n = b.hd; - if (typeof n === "number") { + if (/* tag */typeof n === "number" || typeof n === "string") { + if (n === /* One */0) { + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/test/bdd.ml", + 99, + 31 + ] + }); + } throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -138,22 +159,25 @@ function mkNode(low, v, high) { 31 ] }); + } else { + if (v === n._1 && idl === getId(n._0) && idh === getId(n._3)) { + return n; + } + _b = b.tl; + continue ; } - if (v === n._1 && idl === getId(n._0) && idh === getId(n._3)) { - return n; - } - _b = b.tl; - continue ; + } else { + const n_2 = (nodeC.contents = nodeC.contents + 1 | 0, nodeC.contents); + const n$1 = { + TAG: /* Node */0, + _0: low, + _1: v, + _2: n_2, + _3: high + }; + insert(getId(low), getId(high), v, ind, bucket, n$1); + return n$1; } - const n_2 = (nodeC.contents = nodeC.contents + 1 | 0, nodeC.contents); - const n$1 = /* Node */{ - _0: low, - _1: v, - _2: n_2, - _3: high - }; - insert(getId(low), getId(high), v, ind, bucket, n$1); - return n$1; }; } @@ -192,11 +216,11 @@ function hash(x, y) { } function not(n) { - if (typeof n === "number") { - if (n) { - return /* One */0; - } else { + if (/* tag */typeof n === "number" || typeof n === "string") { + if (n === /* One */0) { return /* Zero */1; + } else { + return /* One */0; } } const id = n._2; @@ -211,22 +235,22 @@ function not(n) { } function and2(n1, n2) { - if (typeof n1 === "number") { - if (n1) { - return /* Zero */1; - } else { + if (/* tag */typeof n1 === "number" || typeof n1 === "string") { + if (n1 === /* One */0) { return n2; + } else { + return /* Zero */1; } } const r1 = n1._3; const i1 = n1._2; const v1 = n1._1; const l1 = n1._0; - if (typeof n2 === "number") { - if (n2) { - return /* Zero */1; - } else { + if (/* tag */typeof n2 === "number" || typeof n2 === "string") { + if (n2 === /* One */0) { return n1; + } else { + return /* Zero */1; } } const r2 = n2._3; @@ -258,22 +282,22 @@ function and2(n1, n2) { } function xor(n1, n2) { - if (typeof n1 === "number") { - if (n1) { - return n2; - } else { + if (/* tag */typeof n1 === "number" || typeof n1 === "string") { + if (n1 === /* One */0) { return not(n2); + } else { + return n2; } } const r1 = n1._3; const i1 = n1._2; const v1 = n1._1; const l1 = n1._0; - if (typeof n2 === "number") { - if (n2) { - return n1; - } else { + if (/* tag */typeof n2 === "number" || typeof n2 === "string") { + if (n2 === /* One */0) { return not(n1); + } else { + return n1; } } const r2 = n2._3; diff --git a/jscomp/test/dist/jscomp/test/big_enum.js b/jscomp/test/dist/jscomp/test/big_enum.js index 55c214237c..de044b4c2a 100644 --- a/jscomp/test/dist/jscomp/test/big_enum.js +++ b/jscomp/test/dist/jscomp/test/big_enum.js @@ -3,7 +3,609 @@ function to_enum(param) { - return param; + switch (param) { + case /* A0 */0 : + return 0; + case /* A1 */1 : + return 1; + case /* A2 */2 : + return 2; + case /* A3 */3 : + return 3; + case /* A4 */4 : + return 4; + case /* A5 */5 : + return 5; + case /* A6 */6 : + return 6; + case /* A7 */7 : + return 7; + case /* A8 */8 : + return 8; + case /* A9 */9 : + return 9; + case /* A10 */10 : + return 10; + case /* A11 */11 : + return 11; + case /* A12 */12 : + return 12; + case /* A13 */13 : + return 13; + case /* A14 */14 : + return 14; + case /* A15 */15 : + return 15; + case /* A16 */16 : + return 16; + case /* A17 */17 : + return 17; + case /* A18 */18 : + return 18; + case /* A19 */19 : + return 19; + case /* A20 */20 : + return 20; + case /* A21 */21 : + return 21; + case /* A22 */22 : + return 22; + case /* A23 */23 : + return 23; + case /* A24 */24 : + return 24; + case /* A25 */25 : + return 25; + case /* A26 */26 : + return 26; + case /* A27 */27 : + return 27; + case /* A28 */28 : + return 28; + case /* A29 */29 : + return 29; + case /* A30 */30 : + return 30; + case /* A31 */31 : + return 31; + case /* A32 */32 : + return 32; + case /* A33 */33 : + return 33; + case /* A34 */34 : + return 34; + case /* A35 */35 : + return 35; + case /* A36 */36 : + return 36; + case /* A37 */37 : + return 37; + case /* A38 */38 : + return 38; + case /* A39 */39 : + return 39; + case /* A40 */40 : + return 40; + case /* A41 */41 : + return 41; + case /* A42 */42 : + return 42; + case /* A43 */43 : + return 43; + case /* A44 */44 : + return 44; + case /* A45 */45 : + return 45; + case /* A46 */46 : + return 46; + case /* A47 */47 : + return 47; + case /* A48 */48 : + return 48; + case /* A49 */49 : + return 49; + case /* A50 */50 : + return 50; + case /* A51 */51 : + return 51; + case /* A52 */52 : + return 52; + case /* A53 */53 : + return 53; + case /* A54 */54 : + return 54; + case /* A55 */55 : + return 55; + case /* A56 */56 : + return 56; + case /* A57 */57 : + return 57; + case /* A58 */58 : + return 58; + case /* A59 */59 : + return 59; + case /* A60 */60 : + return 60; + case /* A61 */61 : + return 61; + case /* A62 */62 : + return 62; + case /* A63 */63 : + return 63; + case /* A64 */64 : + return 64; + case /* A65 */65 : + return 65; + case /* A66 */66 : + return 66; + case /* A67 */67 : + return 67; + case /* A68 */68 : + return 68; + case /* A69 */69 : + return 69; + case /* A70 */70 : + return 70; + case /* A71 */71 : + return 71; + case /* A72 */72 : + return 72; + case /* A73 */73 : + return 73; + case /* A74 */74 : + return 74; + case /* A75 */75 : + return 75; + case /* A76 */76 : + return 76; + case /* A77 */77 : + return 77; + case /* A78 */78 : + return 78; + case /* A79 */79 : + return 79; + case /* A80 */80 : + return 80; + case /* A81 */81 : + return 81; + case /* A82 */82 : + return 82; + case /* A83 */83 : + return 83; + case /* A84 */84 : + return 84; + case /* A85 */85 : + return 85; + case /* A86 */86 : + return 86; + case /* A87 */87 : + return 87; + case /* A88 */88 : + return 88; + case /* A89 */89 : + return 89; + case /* A90 */90 : + return 90; + case /* A91 */91 : + return 91; + case /* A92 */92 : + return 92; + case /* A93 */93 : + return 93; + case /* A94 */94 : + return 94; + case /* A95 */95 : + return 95; + case /* A96 */96 : + return 96; + case /* A97 */97 : + return 97; + case /* A98 */98 : + return 98; + case /* A99 */99 : + return 99; + case /* A100 */100 : + return 100; + case /* A101 */101 : + return 101; + case /* A102 */102 : + return 102; + case /* A103 */103 : + return 103; + case /* A104 */104 : + return 104; + case /* A105 */105 : + return 105; + case /* A106 */106 : + return 106; + case /* A107 */107 : + return 107; + case /* A108 */108 : + return 108; + case /* A109 */109 : + return 109; + case /* A110 */110 : + return 110; + case /* A111 */111 : + return 111; + case /* A112 */112 : + return 112; + case /* A113 */113 : + return 113; + case /* A114 */114 : + return 114; + case /* A115 */115 : + return 115; + case /* A116 */116 : + return 116; + case /* A117 */117 : + return 117; + case /* A118 */118 : + return 118; + case /* A119 */119 : + return 119; + case /* A120 */120 : + return 120; + case /* A121 */121 : + return 121; + case /* A122 */122 : + return 122; + case /* A123 */123 : + return 123; + case /* A124 */124 : + return 124; + case /* A125 */125 : + return 125; + case /* A126 */126 : + return 126; + case /* A127 */127 : + return 127; + case /* A128 */128 : + return 128; + case /* A129 */129 : + return 129; + case /* A130 */130 : + return 130; + case /* A131 */131 : + return 131; + case /* A132 */132 : + return 132; + case /* A133 */133 : + return 133; + case /* A134 */134 : + return 134; + case /* A135 */135 : + return 135; + case /* A136 */136 : + return 136; + case /* A137 */137 : + return 137; + case /* A138 */138 : + return 138; + case /* A139 */139 : + return 139; + case /* A140 */140 : + return 140; + case /* A141 */141 : + return 141; + case /* A142 */142 : + return 142; + case /* A143 */143 : + return 143; + case /* A144 */144 : + return 144; + case /* A145 */145 : + return 145; + case /* A146 */146 : + return 146; + case /* A147 */147 : + return 147; + case /* A148 */148 : + return 148; + case /* A149 */149 : + return 149; + case /* A150 */150 : + return 150; + case /* A151 */151 : + return 151; + case /* A152 */152 : + return 152; + case /* A153 */153 : + return 153; + case /* A154 */154 : + return 154; + case /* A155 */155 : + return 155; + case /* A156 */156 : + return 156; + case /* A157 */157 : + return 157; + case /* A158 */158 : + return 158; + case /* A159 */159 : + return 159; + case /* A160 */160 : + return 160; + case /* A161 */161 : + return 161; + case /* A162 */162 : + return 162; + case /* A163 */163 : + return 163; + case /* A164 */164 : + return 164; + case /* A165 */165 : + return 165; + case /* A166 */166 : + return 166; + case /* A167 */167 : + return 167; + case /* A168 */168 : + return 168; + case /* A169 */169 : + return 169; + case /* A170 */170 : + return 170; + case /* A171 */171 : + return 171; + case /* A172 */172 : + return 172; + case /* A173 */173 : + return 173; + case /* A174 */174 : + return 174; + case /* A175 */175 : + return 175; + case /* A176 */176 : + return 176; + case /* A177 */177 : + return 177; + case /* A178 */178 : + return 178; + case /* A179 */179 : + return 179; + case /* A180 */180 : + return 180; + case /* A181 */181 : + return 181; + case /* A182 */182 : + return 182; + case /* A183 */183 : + return 183; + case /* A184 */184 : + return 184; + case /* A185 */185 : + return 185; + case /* A186 */186 : + return 186; + case /* A187 */187 : + return 187; + case /* A188 */188 : + return 188; + case /* A189 */189 : + return 189; + case /* A190 */190 : + return 190; + case /* A191 */191 : + return 191; + case /* A192 */192 : + return 192; + case /* A193 */193 : + return 193; + case /* A194 */194 : + return 194; + case /* A195 */195 : + return 195; + case /* A196 */196 : + return 196; + case /* A197 */197 : + return 197; + case /* A198 */198 : + return 198; + case /* A199 */199 : + return 199; + case /* A200 */200 : + return 200; + case /* A201 */201 : + return 201; + case /* A202 */202 : + return 202; + case /* A203 */203 : + return 203; + case /* A204 */204 : + return 204; + case /* A205 */205 : + return 205; + case /* A206 */206 : + return 206; + case /* A207 */207 : + return 207; + case /* A208 */208 : + return 208; + case /* A209 */209 : + return 209; + case /* A210 */210 : + return 210; + case /* A211 */211 : + return 211; + case /* A212 */212 : + return 212; + case /* A213 */213 : + return 213; + case /* A214 */214 : + return 214; + case /* A215 */215 : + return 215; + case /* A216 */216 : + return 216; + case /* A217 */217 : + return 217; + case /* A218 */218 : + return 218; + case /* A219 */219 : + return 219; + case /* A220 */220 : + return 220; + case /* A221 */221 : + return 221; + case /* A222 */222 : + return 222; + case /* A223 */223 : + return 223; + case /* A224 */224 : + return 224; + case /* A225 */225 : + return 225; + case /* A226 */226 : + return 226; + case /* A227 */227 : + return 227; + case /* A228 */228 : + return 228; + case /* A229 */229 : + return 229; + case /* A230 */230 : + return 230; + case /* A231 */231 : + return 231; + case /* A232 */232 : + return 232; + case /* A233 */233 : + return 233; + case /* A234 */234 : + return 234; + case /* A235 */235 : + return 235; + case /* A236 */236 : + return 236; + case /* A237 */237 : + return 237; + case /* A238 */238 : + return 238; + case /* A239 */239 : + return 239; + case /* A240 */240 : + return 240; + case /* A241 */241 : + return 241; + case /* A242 */242 : + return 242; + case /* A243 */243 : + return 243; + case /* A244 */244 : + return 244; + case /* A245 */245 : + return 245; + case /* A246 */246 : + return 246; + case /* A247 */247 : + return 247; + case /* A248 */248 : + return 248; + case /* A249 */249 : + return 249; + case /* A250 */250 : + return 250; + case /* A251 */251 : + return 251; + case /* A252 */252 : + return 252; + case /* A253 */253 : + return 253; + case /* A254 */254 : + return 254; + case /* A255 */255 : + return 255; + case /* A256 */256 : + return 256; + case /* A257 */257 : + return 257; + case /* A258 */258 : + return 258; + case /* A259 */259 : + return 259; + case /* A260 */260 : + return 260; + case /* A261 */261 : + return 261; + case /* A262 */262 : + return 262; + case /* A263 */263 : + return 263; + case /* A264 */264 : + return 264; + case /* A265 */265 : + return 265; + case /* A266 */266 : + return 266; + case /* A267 */267 : + return 267; + case /* A268 */268 : + return 268; + case /* A269 */269 : + return 269; + case /* A270 */270 : + return 270; + case /* A271 */271 : + return 271; + case /* A272 */272 : + return 272; + case /* A273 */273 : + return 273; + case /* A274 */274 : + return 274; + case /* A275 */275 : + return 275; + case /* A276 */276 : + return 276; + case /* A277 */277 : + return 277; + case /* A278 */278 : + return 278; + case /* A279 */279 : + return 279; + case /* A280 */280 : + return 280; + case /* A281 */281 : + return 281; + case /* A282 */282 : + return 282; + case /* A283 */283 : + return 283; + case /* A284 */284 : + return 284; + case /* A285 */285 : + return 285; + case /* A286 */286 : + return 286; + case /* A287 */287 : + return 287; + case /* A288 */288 : + return 288; + case /* A289 */289 : + return 289; + case /* A290 */290 : + return 290; + case /* A291 */291 : + return 291; + case /* A292 */292 : + return 292; + case /* A293 */293 : + return 293; + case /* A294 */294 : + return 294; + case /* A295 */295 : + return 295; + case /* A296 */296 : + return 296; + case /* A297 */297 : + return 297; + case /* A298 */298 : + return 298; + case /* A299 */299 : + return 299; + + } } function to_string(param) { diff --git a/jscomp/test/dist/jscomp/test/bs_ignore_test.js b/jscomp/test/dist/jscomp/test/bs_ignore_test.js index d94ef2b93f..869e9dd902 100644 --- a/jscomp/test/dist/jscomp/test/bs_ignore_test.js +++ b/jscomp/test/dist/jscomp/test/bs_ignore_test.js @@ -20,15 +20,15 @@ function add_dyn(kind,x,y){ ; function string_of_kind(kind) { - if (kind) { - return "string"; - } else { + if (kind === /* Float */0) { return "float"; + } else { + return "string"; } } function add2(k, x, y) { - return add_dyn(k ? "string" : "float", x, y); + return add_dyn(string_of_kind(k), x, y); } console.log(add2(/* Float */0, 3.0, 2.0)); diff --git a/jscomp/test/dist/jscomp/test/bs_node_string_buffer_test.js b/jscomp/test/dist/jscomp/test/bs_node_string_buffer_test.js index 551ec42897..9f8161f0e6 100644 --- a/jscomp/test/dist/jscomp/test/bs_node_string_buffer_test.js +++ b/jscomp/test/dist/jscomp/test/bs_node_string_buffer_test.js @@ -5,17 +5,17 @@ const $$Node = require("melange.node/node.js"); function f(str) { const match = $$Node.test(str); - if (match[0]) { - console.log([ - "buffer", - Buffer.isBuffer(match[1]) - ]); - } else { + if (match[0] === /* String */0) { console.log([ "string", match[1] ]); + return ; } + console.log([ + "buffer", + Buffer.isBuffer(match[1]) + ]); } f("xx"); diff --git a/jscomp/test/dist/jscomp/test/caml_format_test.js b/jscomp/test/dist/jscomp/test/caml_format_test.js index b27bada2d4..98e059cdce 100644 --- a/jscomp/test/dist/jscomp/test/caml_format_test.js +++ b/jscomp/test/dist/jscomp/test/caml_format_test.js @@ -95,7 +95,8 @@ function from_of_string(xs) { const b = param[1]; const a = param[0]; return [ - Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "of_string ", @@ -119,7 +120,8 @@ function from_of_string(xs) { } function u(v) { - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -137,7 +139,8 @@ function u(v) { const to_str = Caml_format.caml_int_of_string; -const v = Curry._1(Stdlib__Printf.sprintf(/* Format */{ +const v = Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -206,7 +209,8 @@ const suites = Stdlib.$at(from_of_string(of_string), Stdlib.$at({ const b = param[1]; const a = param[0]; return [ - Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "infinity_of_string ", @@ -257,7 +261,8 @@ const suites = Stdlib.$at(from_of_string(of_string), Stdlib.$at({ const b = param[1]; const a = param[0]; return [ - Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "normal_float_of_string ", @@ -282,7 +287,8 @@ const suites = Stdlib.$at(from_of_string(of_string), Stdlib.$at({ }), pairs$1)))))); function $caret$caret(param, param$1) { - return /* Format */{ + return { + TAG: /* Format */0, _0: CamlinternalFormatBasics.concat_fmt(param._0, param$1._0), _1: param._1 + ("%," + param$1._1) }; @@ -297,7 +303,8 @@ const formatter_suites_0 = [ (function (param) { return { TAG: /* Eq */0, - _0: Curry._6(Stdlib__Format.asprintf($caret$caret(/* Format */{ + _0: Curry._6(Stdlib__Format.asprintf($caret$caret({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -326,7 +333,8 @@ const formatter_suites_0 = [ } }, _1: "%s %03d %L" - }, /* Format */{ + }, { + TAG: /* Format */0, _0: { TAG: /* Caml_string */3, _0: /* No_padding */0, @@ -367,7 +375,8 @@ const formatter_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._8(Stdlib__Format.asprintf($caret$caret(/* Format */{ + _0: Curry._8(Stdlib__Format.asprintf($caret$caret({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -396,7 +405,8 @@ const formatter_suites_1 = { } }, _1: "%s %03d %L" - }, /* Format */{ + }, { + TAG: /* Format */0, _0: { TAG: /* Caml_string */3, _0: /* No_padding */0, @@ -454,7 +464,8 @@ const formatter_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry.app(Stdlib__Format.asprintf(/* Format */{ + _0: Curry.app(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -839,12 +850,14 @@ const formatter_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry.app(Stdlib__Format.asprintf(/* Format */{ + _0: Curry.app(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -1278,7 +1291,8 @@ const formatter_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -1302,7 +1316,8 @@ const formatter_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -1314,7 +1329,8 @@ const formatter_suites_1 = { _0: /* Right */1, _1: 10 }, - _2: /* Lit_precision */{ + _2: { + TAG: /* Lit_precision */0, _0: 3 }, _3: /* End_of_format */0 @@ -1331,7 +1347,8 @@ const formatter_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_x */6, @@ -1355,7 +1372,8 @@ const formatter_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_Cx */7, @@ -1380,7 +1398,8 @@ const formatter_suites_1 = { return { TAG: /* Eq */0, _0: [ - Curry._1(Stdlib__Format.asprintf(/* Format */{ + Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_Co */11, @@ -1390,7 +1409,8 @@ const formatter_suites_1 = { }, _1: "%#o" }), 32), - Curry._1(Stdlib__Format.asprintf(/* Format */{ + Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_o */10, @@ -1425,7 +1445,8 @@ const formatter_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_pd */1, @@ -1449,7 +1470,8 @@ const formatter_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_sd */2, @@ -1473,7 +1495,8 @@ const formatter_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int32 */5, _0: /* Int_u */12, @@ -1493,7 +1516,8 @@ const formatter_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int32 */5, _0: /* Int_d */0, @@ -1524,12 +1548,14 @@ const formatter_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, _1: /* No_padding */0, - _2: /* Lit_precision */{ + _2: { + TAG: /* Lit_precision */0, _0: 10 }, _3: /* End_of_format */0 @@ -1707,7 +1733,8 @@ const float_data = [ ]; function ident(ppf, s) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1718,7 +1745,8 @@ function ident(ppf, s) { } function kwd(ppf, s) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1729,9 +1757,10 @@ function kwd(ppf, s) { } function pr_exp0(ppf, s) { - switch (s.TAG | 0) { + switch (s.TAG) { case /* Var */1 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: /* End_of_format */0 @@ -1743,12 +1772,14 @@ function pr_exp0(ppf, s) { break; } - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<1>", @@ -1779,12 +1810,14 @@ function pr_exp0(ppf, s) { } function pr_app(ppf, e) { - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -1807,12 +1840,13 @@ function pr_app(ppf, e) { } function pr_other_applications(ppf, f) { - switch (f.TAG | 0) { + switch (f.TAG) { case /* Lambda */0 : case /* Var */1 : return pr_exp0(ppf, f); case /* Apply */2 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -1836,14 +1870,16 @@ function pr_other_applications(ppf, f) { } function pr_lambda(ppf, e) { - switch (e.TAG | 0) { + switch (e.TAG) { case /* Lambda */0 : - return Curry._8(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._8(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<1>", @@ -1888,7 +1924,8 @@ function pr_lambda(ppf, e) { } } -const string_of_lambda = Curry._1(Stdlib__Format.asprintf(/* Format */{ +const string_of_lambda = Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: /* End_of_format */0 @@ -1975,7 +2012,8 @@ function from_lambda_pairs(p) { const b = param[1]; const a = param[0]; return [ - Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "lambda_print ", @@ -2010,7 +2048,8 @@ const ksprintf_suites_0 = [ }; return { TAG: /* Eq */0, - _0: Curry._2(f(/* Format */{ + _0: Curry._2(f({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -2041,7 +2080,8 @@ const ksprintf_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._2(Stdlib__Format.sprintf(/* Format */{ + _0: Curry._2(Stdlib__Format.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -2074,7 +2114,8 @@ const int64_suites_0 = [ (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_x */6, @@ -2095,7 +2136,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_o */10, @@ -2115,7 +2157,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_d */0, @@ -2138,7 +2181,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_x */6, @@ -2161,7 +2205,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_i */3, @@ -2184,7 +2229,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_X */8, @@ -2207,7 +2253,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_x */6, @@ -2230,7 +2277,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._2(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._2(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_x */6, @@ -2270,7 +2318,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._2(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._2(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_d */0, @@ -2306,7 +2355,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._2(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._2(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_d */0, @@ -2339,7 +2389,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_x */6, @@ -2359,7 +2410,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_d */0, @@ -2379,7 +2431,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_d */0, @@ -2402,7 +2455,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_X */8, @@ -2422,7 +2476,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_x */6, @@ -2442,7 +2497,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_X */8, @@ -2462,7 +2518,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_X */8, @@ -2482,7 +2539,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_u */12, @@ -2502,7 +2560,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_u */12, @@ -2525,7 +2584,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_u */12, @@ -2545,7 +2605,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_u */12, @@ -2568,7 +2629,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_o */10, @@ -2588,7 +2650,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_X */8, @@ -2608,7 +2671,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_x */6, @@ -2635,7 +2699,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_X */8, @@ -2658,7 +2723,8 @@ const int64_suites_1 = { (function (param) { return { TAG: /* Eq */0, - _0: Curry._1(Stdlib__Format.asprintf(/* Format */{ + _0: Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_d */0, @@ -2686,7 +2752,8 @@ const int64_suites_1 = { const buf = Stdlib__Buffer.create(30); return { TAG: /* Eq */0, - _0: (Curry._1(Stdlib__Printf.bprintf(buf, /* Format */{ + _0: (Curry._1(Stdlib__Printf.bprintf(buf, { + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_d */0, @@ -2803,7 +2870,8 @@ Mt.from_pair_suites("Caml_format_test", Stdlib.$at(suites, Stdlib.$at(formatter_ const f = param[1]; const fmt = param[0]; return [ - Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "float_format ", @@ -2829,7 +2897,8 @@ Mt.from_pair_suites("Caml_format_test", Stdlib.$at(suites, Stdlib.$at(formatter_ const b = param[1]; const a = param[0]; return [ - Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "int64_of_string ", diff --git a/jscomp/test/dist/jscomp/test/class_repr.js b/jscomp/test/dist/jscomp/test/class_repr.js index 14075b1046..fa7c69f3d5 100644 --- a/jscomp/test/dist/jscomp/test/class_repr.js +++ b/jscomp/test/dist/jscomp/test/class_repr.js @@ -114,14 +114,16 @@ if (Caml_oo_curry.js1(-804710761, 4, v1) !== 3) { }); } -if (typeof Stdlib__Sys.backend_type !== "number" && Stdlib__Sys.backend_type._0 === "Melange") { +if (/* tag */typeof Stdlib__Sys.backend_type === "number" || typeof Stdlib__Sys.backend_type === "string") { + Stdlib__Sys.backend_type === /* Native */0; +} else if (Stdlib__Sys.backend_type._0 === "Melange") { console.log([ - Caml_oo_curry.js1(-804710761, 7, v1), - Caml_oo_curry.js1(-804710761, 8, v2) + Caml_oo_curry.js1(-804710761, 5, v1), + Caml_oo_curry.js1(-804710761, 6, v2) ]); } -if (Caml_oo_curry.js1(-804710761, 9, v2) !== 9) { +if (Caml_oo_curry.js1(-804710761, 7, v2) !== 9) { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -164,7 +166,7 @@ const point = CamlinternalOO.make_class([ const v$1 = Curry._1(point[0], undefined); -if (Caml_oo_curry.js1(590348294, 10, v$1) !== 5) { +if (Caml_oo_curry.js1(590348294, 8, v$1) !== 5) { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ diff --git a/jscomp/test/dist/jscomp/test/compare_test.js b/jscomp/test/dist/jscomp/test/compare_test.js index 7dff60d96c..bc1e26fade 100644 --- a/jscomp/test/dist/jscomp/test/compare_test.js +++ b/jscomp/test/dist/jscomp/test/compare_test.js @@ -17,15 +17,32 @@ function compare(x, y) { function compare2(x, y) { switch (x) { case /* A */0 : - if (y) { - return false; - } else { - return true; + switch (y) { + case /* A */0 : + return true; + case /* B */1 : + case /* C */2 : + return false; + } case /* B */1 : - return y === 1; + switch (y) { + case /* B */1 : + return true; + case /* A */0 : + case /* C */2 : + return false; + + } case /* C */2 : - return y >= 2; + switch (y) { + case /* A */0 : + case /* B */1 : + return false; + case /* C */2 : + return true; + + } } } diff --git a/jscomp/test/dist/jscomp/test/const_test.js b/jscomp/test/dist/jscomp/test/const_test.js index b9076adc71..ce67d05e06 100644 --- a/jscomp/test/dist/jscomp/test/const_test.js +++ b/jscomp/test/dist/jscomp/test/const_test.js @@ -15,7 +15,7 @@ function fff(x) { TAG: /* A */0, _0: x }; - switch (x$1.TAG | 0) { + switch (x$1.TAG) { case /* A */0 : return x; case /* B */1 : diff --git a/jscomp/test/dist/jscomp/test/debug_mode_value.js b/jscomp/test/dist/jscomp/test/debug_mode_value.js index 8ff47b99d8..623d01502a 100644 --- a/jscomp/test/dist/jscomp/test/debug_mode_value.js +++ b/jscomp/test/dist/jscomp/test/debug_mode_value.js @@ -2,7 +2,8 @@ 'use strict'; -const u = /* A */{ +const u = { + TAG: /* A */0, _0: 1, _1: 2 }; diff --git a/jscomp/test/dist/jscomp/test/defunctor_make_test.js b/jscomp/test/dist/jscomp/test/defunctor_make_test.js index e9f8dfe4c4..ddc491f7db 100644 --- a/jscomp/test/dist/jscomp/test/defunctor_make_test.js +++ b/jscomp/test/dist/jscomp/test/defunctor_make_test.js @@ -18,17 +18,18 @@ const Comparable = { }; function height(param) { - if (param) { - return param._4; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param._4; } } function create(l, x, d, r) { const hl = height(l); const hr = height(r); - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: x, _2: d, @@ -38,32 +39,35 @@ function create(l, x, d, r) { } function bal(l, x, d, r) { - const hl = l ? l._4 : 0; - const hr = r ? r._4 : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l._4; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r._4; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l._3; - const ld = l._2; - const lv = l._1; - const ll = l._0; - if (height(ll) >= height(lr)) { - return create(ll, lv, ld, create(lr, x, d, r)); - } - if (lr) { - return create(create(ll, lv, ld, lr._0), lr._1, lr._2, create(lr._3, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l._3; + const ld = l._2; + const lv = l._1; + const ll = l._0; + if (height(ll) >= height(lr)) { + return create(ll, lv, ld, create(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, ld, lr._0), lr._1, lr._2, create(lr._3, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: x, _2: d, @@ -71,22 +75,22 @@ function bal(l, x, d, r) { _4: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r._3; - const rd = r._2; - const rv = r._1; - const rl = r._0; - if (height(rr) >= height(rl)) { - return create(create(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create(create(l, x, d, rl._0), rl._1, rl._2, create(rl._3, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r._3; + const rd = r._2; + const rv = r._1; + const rl = r._0; + if (height(rr) >= height(rl)) { + return create(create(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, x, d, rl._0), rl._1, rl._2, create(rl._3, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -94,8 +98,9 @@ function bal(l, x, d, r) { } function add(x, data, compare, param) { - if (!param) { - return /* Node */{ + if (/* tag */typeof param === "number" || typeof param === "string") { + return { + TAG: /* Node */0, _0: /* Empty */0, _1: x, _2: data, @@ -109,7 +114,8 @@ function add(x, data, compare, param) { const l = param._0; const c = compare(x, v); if (c === 0) { - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: x, _2: data, diff --git a/jscomp/test/dist/jscomp/test/demo_int_map.js b/jscomp/test/dist/jscomp/test/demo_int_map.js index 7c3cf94e55..85502b407a 100644 --- a/jscomp/test/dist/jscomp/test/demo_int_map.js +++ b/jscomp/test/dist/jscomp/test/demo_int_map.js @@ -14,17 +14,18 @@ const funarg = { }; function height(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create(l, x, d, r) { const hl = height(l); const hr = height(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -34,32 +35,35 @@ function create(l, x, d, r) { } function bal(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height(ll) >= height(lr)) { - return create(ll, lv, ld, create(lr, x, d, r)); - } - if (lr) { - return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height(ll) >= height(lr)) { + return create(ll, lv, ld, create(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -67,22 +71,22 @@ function bal(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height(rr) >= height(rl)) { - return create(create(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height(rr) >= height(rl)) { + return create(create(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -90,8 +94,9 @@ function bal(l, x, d, r) { } function add(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -108,7 +113,8 @@ function add(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -136,17 +142,17 @@ function add(x, data, m) { function find(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(funarg.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(funarg.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } diff --git a/jscomp/test/dist/jscomp/test/demo_page.js b/jscomp/test/dist/jscomp/test/demo_page.js index 191abadd87..b25b4505ea 100644 --- a/jscomp/test/dist/jscomp/test/demo_page.js +++ b/jscomp/test/dist/jscomp/test/demo_page.js @@ -22,13 +22,14 @@ function sum(n) { } function map(f, param) { - if (param) { - return /* Cons */{ + if (/* tag */typeof param === "number" || typeof param === "string") { + return /* Nil */0; + } else { + return { + TAG: /* Cons */0, _0: Curry._1(f, param._0), _1: map(f, param._1) }; - } else { - return /* Nil */0; } } diff --git a/jscomp/test/dist/jscomp/test/derive_projector_test.js b/jscomp/test/dist/jscomp/test/derive_projector_test.js index d21abfef1e..93178b89d4 100644 --- a/jscomp/test/dist/jscomp/test/derive_projector_test.js +++ b/jscomp/test/dist/jscomp/test/derive_projector_test.js @@ -92,13 +92,15 @@ const h = { }; function xx(param_0) { - return /* Xx */{ + return { + TAG: /* Xx */0, _0: param_0 }; } function a(param_0) { - return /* A */{ + return { + TAG: /* A */0, _0: param_0 }; } diff --git a/jscomp/test/dist/jscomp/test/digest_test.js b/jscomp/test/dist/jscomp/test/digest_test.js index ee2d56a4a3..caf838dc3a 100644 --- a/jscomp/test/dist/jscomp/test/digest_test.js +++ b/jscomp/test/dist/jscomp/test/digest_test.js @@ -223,7 +223,8 @@ Mt.from_pair_suites("Digest_test", Stdlib.$at({ } }, Stdlib__Array.to_list(Stdlib__Array.map((function (i) { return [ - Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, diff --git a/jscomp/test/dist/jscomp/test/exception_repr_test.js b/jscomp/test/dist/jscomp/test/exception_repr_test.js index e4442e5802..5744b17122 100644 --- a/jscomp/test/dist/jscomp/test/exception_repr_test.js +++ b/jscomp/test/dist/jscomp/test/exception_repr_test.js @@ -43,7 +43,8 @@ Stdlib__Printexc.register_printer(function (s) { if (s.MEL_EXN_ID === Hi) { return "hey"; } else if (s.MEL_EXN_ID === A) { - return Curry._1(Stdlib__Format.asprintf(/* Format */{ + return Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "A(", diff --git a/jscomp/test/dist/jscomp/test/ext_filename_test.js b/jscomp/test/dist/jscomp/test/ext_filename_test.js index 1681fa42d1..e71ce11510 100644 --- a/jscomp/test/dist/jscomp/test/ext_filename_test.js +++ b/jscomp/test/dist/jscomp/test/ext_filename_test.js @@ -71,7 +71,8 @@ function chop_extension(locOpt, name) { catch (raw_exn){ const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); if (exn.MEL_EXN_ID === Stdlib.Invalid_argument) { - return Curry._2(Stdlib__Format.ksprintf(Stdlib.invalid_arg, /* Format */{ + return Curry._2(Stdlib__Format.ksprintf(Stdlib.invalid_arg, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Filename.chop_extension ( ", @@ -168,7 +169,8 @@ function node_relative_path(node_modules_shorten, file1, dep_file) { while(true) { const i = _i; if (i >= len) { - return Curry._1(Ext_pervasives_test.failwithf("File \"jscomp/test/ext_filename_test.ml\", line 162, characters 43-50", /* Format */{ + return Curry._1(Ext_pervasives_test.failwithf("File \"jscomp/test/ext_filename_test.ml\", line 162, characters 43-50", { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "invalid path: ", @@ -200,7 +202,8 @@ function find_root_filename(_cwd, filename) { } const cwd$p = Curry._1(Stdlib__Filename.dirname, cwd); if (cwd$p.length >= cwd.length) { - return Curry._2(Ext_pervasives_test.failwithf("File \"jscomp/test/ext_filename_test.ml\", line 205, characters 13-20", /* Format */{ + return Curry._2(Ext_pervasives_test.failwithf("File \"jscomp/test/ext_filename_test.ml\", line 205, characters 13-20", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, diff --git a/jscomp/test/dist/jscomp/test/ext_log_test.js b/jscomp/test/dist/jscomp/test/ext_log_test.js index 6b5fb38714..0572b1ddb7 100644 --- a/jscomp/test/dist/jscomp/test/ext_log_test.js +++ b/jscomp/test/dist/jscomp/test/ext_log_test.js @@ -6,14 +6,16 @@ const Curry = require("melange.js/curry.js"); const Stdlib__Format = require("melange/format.js"); function $caret$caret(param, param$1) { - return /* Format */{ + return { + TAG: /* Format */0, _0: CamlinternalFormatBasics.concat_fmt(param._0, param$1._0), _1: param._1 + ("%," + param$1._1) }; } function err(str, f) { - return Curry._1(Stdlib__Format.fprintf(Stdlib__Format.err_formatter)($caret$caret(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(Stdlib__Format.err_formatter)($caret$caret({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -24,7 +26,8 @@ function err(str, f) { } }, _1: "%s " - }, $caret$caret(f, /* Format */{ + }, $caret$caret(f, { + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: /* Flush_newline */4, @@ -36,7 +39,8 @@ function err(str, f) { function ierr(b, str, f) { if (b) { - return Curry._1(Stdlib__Format.fprintf(Stdlib__Format.err_formatter)($caret$caret(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(Stdlib__Format.err_formatter)($caret$caret({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -49,7 +53,8 @@ function ierr(b, str, f) { _1: "%s " }, f)), str); } else { - return Stdlib__Format.ifprintf(Stdlib__Format.err_formatter, $caret$caret(/* Format */{ + return Stdlib__Format.ifprintf(Stdlib__Format.err_formatter, $caret$caret({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -65,7 +70,8 @@ function ierr(b, str, f) { } function warn(str, f) { - return Curry._1(Stdlib__Format.fprintf(Stdlib__Format.err_formatter)($caret$caret(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(Stdlib__Format.err_formatter)($caret$caret({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "WARN: ", @@ -80,7 +86,8 @@ function warn(str, f) { } }, _1: "WARN: %s " - }, $caret$caret(f, /* Format */{ + }, $caret$caret(f, { + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: /* Flush_newline */4, @@ -92,7 +99,8 @@ function warn(str, f) { function iwarn(b, str, f) { if (b) { - return Curry._1(Stdlib__Format.fprintf(Stdlib__Format.err_formatter)($caret$caret(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(Stdlib__Format.err_formatter)($caret$caret({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "WARN: ", @@ -109,7 +117,8 @@ function iwarn(b, str, f) { _1: "WARN: %s " }, f)), str); } else { - return Stdlib__Format.ifprintf(Stdlib__Format.err_formatter, $caret$caret(/* Format */{ + return Stdlib__Format.ifprintf(Stdlib__Format.err_formatter, $caret$caret({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "WARN: ", @@ -129,7 +138,8 @@ function iwarn(b, str, f) { } function info(str, f) { - return Curry._1(Stdlib__Format.fprintf(Stdlib__Format.err_formatter)($caret$caret(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(Stdlib__Format.err_formatter)($caret$caret({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "INFO: ", @@ -148,7 +158,8 @@ function info(str, f) { } function iinfo(b, str, f) { - return Curry._1(Stdlib__Format.fprintf(Stdlib__Format.err_formatter)($caret$caret(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(Stdlib__Format.err_formatter)($caret$caret({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "INFO: ", diff --git a/jscomp/test/dist/jscomp/test/flexible_array_test.js b/jscomp/test/dist/jscomp/test/flexible_array_test.js index 66181dd53d..c7b33a704e 100644 --- a/jscomp/test/dist/jscomp/test/flexible_array_test.js +++ b/jscomp/test/dist/jscomp/test/flexible_array_test.js @@ -13,130 +13,140 @@ function sub(_tr, _k) { while(true) { const k = _k; const tr = _tr; - if (tr) { - if (k === 1) { - return tr._0; - } - if (k % 2 === 0) { - _k = k / 2 | 0; - _tr = tr._1; - continue ; - } + if (/* tag */typeof tr === "number" || typeof tr === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + if (k === 1) { + return tr._0; + } + if (k % 2 === 0) { _k = k / 2 | 0; - _tr = tr._2; + _tr = tr._1; continue ; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _k = k / 2 | 0; + _tr = tr._2; + continue ; }; } function update(tr, k, w) { - if (tr) { - const r = tr._2; - const l = tr._1; + if (/* tag */typeof tr === "number" || typeof tr === "string") { if (k === 1) { - return /* Br */{ + return { + TAG: /* Br */0, _0: w, - _1: l, - _2: r - }; - } - const v = tr._0; - if (k % 2 === 0) { - return /* Br */{ - _0: v, - _1: update(l, k / 2 | 0, w), - _2: r - }; - } else { - return /* Br */{ - _0: v, - _1: l, - _2: update(r, k / 2 | 0, w) + _1: /* Lf */0, + _2: /* Lf */0 }; } + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } + const r = tr._2; + const l = tr._1; if (k === 1) { - return /* Br */{ + return { + TAG: /* Br */0, _0: w, - _1: /* Lf */0, - _2: /* Lf */0 + _1: l, + _2: r + }; + } + const v = tr._0; + if (k % 2 === 0) { + return { + TAG: /* Br */0, + _0: v, + _1: update(l, k / 2 | 0, w), + _2: r + }; + } else { + return { + TAG: /* Br */0, + _0: v, + _1: l, + _2: update(r, k / 2 | 0, w) }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); } function $$delete(tr, n) { - if (tr) { - if (n === 1) { - return /* Lf */0; - } - const r = tr._2; - const l = tr._1; - const v = tr._0; - if (n % 2 === 0) { - return /* Br */{ - _0: v, - _1: $$delete(l, n / 2 | 0), - _2: r - }; - } else { - return /* Br */{ - _0: v, - _1: l, - _2: $$delete(r, n / 2 | 0) - }; - } + if (/* tag */typeof tr === "number" || typeof tr === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + if (n === 1) { + return /* Lf */0; + } + const r = tr._2; + const l = tr._1; + const v = tr._0; + if (n % 2 === 0) { + return { + TAG: /* Br */0, + _0: v, + _1: $$delete(l, n / 2 | 0), + _2: r + }; + } else { + return { + TAG: /* Br */0, + _0: v, + _1: l, + _2: $$delete(r, n / 2 | 0) + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); } function loext(tr, w) { - if (tr) { - return /* Br */{ + if (/* tag */typeof tr === "number" || typeof tr === "string") { + return { + TAG: /* Br */0, _0: w, - _1: loext(tr._2, tr._0), - _2: tr._1 + _1: /* Lf */0, + _2: /* Lf */0 }; } else { - return /* Br */{ + return { + TAG: /* Br */0, _0: w, - _1: /* Lf */0, - _2: /* Lf */0 + _1: loext(tr._2, tr._0), + _2: tr._1 }; } } function lorem(tr) { - if (tr) { - const l = tr._1; - if (l) { - return /* Br */{ - _0: l._0, - _1: tr._2, - _2: lorem(l) - }; - } - if (!tr._2) { - return /* Lf */0; - } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/test/flexible_array_test.ml", - 66, - 9 - ] + if (/* tag */typeof tr === "number" || typeof tr === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found + const l = tr._1; + if (!/* tag */(typeof l === "number" || typeof l === "string")) { + return { + TAG: /* Br */0, + _0: l._0, + _1: tr._2, + _2: lorem(l) + }; + } + let tmp = tr._2; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return /* Lf */0; + } + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/test/flexible_array_test.ml", + 66, + 9 + ] }); } @@ -222,7 +232,8 @@ function pp(fmt, s) { v = v + (", " + String(get(s, i))); } v = v + "]"; - Curry._1(Stdlib__Format.fprintf(fmt)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(fmt)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, diff --git a/jscomp/test/dist/jscomp/test/float_of_bits_test.js b/jscomp/test/dist/jscomp/test/float_of_bits_test.js index 7e1e6ac0fc..d9f075ccd0 100644 --- a/jscomp/test/dist/jscomp/test/float_of_bits_test.js +++ b/jscomp/test/dist/jscomp/test/float_of_bits_test.js @@ -32,7 +32,8 @@ function from_pairs(pair) { const i32 = param[0]; return { hd: [ - Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "int32_float_of_bits ", @@ -56,7 +57,8 @@ function from_pairs(pair) { ], tl: { hd: [ - Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "int32_bits_of_float ", diff --git a/jscomp/test/dist/jscomp/test/float_test.js b/jscomp/test/dist/jscomp/test/float_test.js index e2c357028b..58927aaf62 100644 --- a/jscomp/test/dist/jscomp/test/float_test.js +++ b/jscomp/test/dist/jscomp/test/float_test.js @@ -129,7 +129,8 @@ function from_pairs(ps) { const b = param[1]; const a = param[0]; return [ - Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "pair ", diff --git a/jscomp/test/dist/jscomp/test/flow_parser_reg_test.js b/jscomp/test/dist/jscomp/test/flow_parser_reg_test.js index 62021010c3..dfd5b47f94 100644 --- a/jscomp/test/dist/jscomp/test/flow_parser_reg_test.js +++ b/jscomp/test/dist/jscomp/test/flow_parser_reg_test.js @@ -85,7 +85,7 @@ function btwn_exclusive(loc1, loc2) { } function string_of_filename(param) { - if (typeof param === "number") { + if (/* tag */typeof param === "number" || typeof param === "string") { return "(global)"; } else { return param._0; @@ -93,10 +93,10 @@ function string_of_filename(param) { } function order_of_filename(param) { - if (typeof param === "number") { + if (/* tag */typeof param === "number" || typeof param === "string") { return 1; } - switch (param.TAG | 0) { + switch (param.TAG) { case /* LibFile */0 : return 2; case /* SourceFile */1 : @@ -151,7 +151,7 @@ function compare(loc1, loc2) { const $$Error = /* @__PURE__ */Caml_exceptions.create("Flow_parser_reg_test.Parse_error.Error"); function error(str) { - if (typeof str === "number") { + if (/* tag */typeof str === "number" || typeof str === "string") { switch (str) { case /* UnexpectedNumber */0 : return "Unexpected number"; @@ -280,13 +280,14 @@ function error(str) { } } else { - switch (str.TAG | 0) { + switch (str.TAG) { case /* Assertion */0 : return "Unexpected parser state: " + str._0; case /* UnexpectedToken */1 : return "Unexpected token " + str._0; case /* UnexpectedTokenWithSuggestion */2 : - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unexpected token `", @@ -319,7 +320,8 @@ function error(str) { case /* ExpectedJSXClosingTag */6 : return "Expected corresponding JSX closing tag for " + str._0; case /* DuplicateExport */7 : - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Duplicate export for `", @@ -1691,7 +1693,7 @@ Caml_module.update_mod({ }, Class, Class); function token_to_string(param) { - if (typeof param === "number") { + if (/* tag */typeof param === "number" || typeof param === "string") { switch (param) { case /* T_IDENTIFIER */0 : return "T_IDENTIFIER"; @@ -1920,7 +1922,7 @@ function token_to_string(param) { } } else { - switch (param.TAG | 0) { + switch (param.TAG) { case /* T_NUMBER */0 : return "T_NUMBER"; case /* T_STRING */1 : @@ -2015,10 +2017,10 @@ function get_result_and_clear_state(param) { const env = match[0]; let match$1; let exit = 0; - if (typeof lex_token === "number") { + if (/* tag */typeof lex_token === "number" || typeof lex_token === "string") { exit = 2; } else { - switch (lex_token.TAG | 0) { + switch (lex_token.TAG) { case /* T_TEMPLATE_PART */2 : const match$2 = lex_token._0; match$1 = [ @@ -2483,21 +2485,18 @@ function utf16to8(code) { function mk_num_singleton(number_type, num, neg) { let value; - if (number_type) { - switch (number_type) { - case /* LEGACY_OCTAL */1 : - value = Caml_format.caml_int_of_string("0o" + num); - break; - case /* OCTAL */2 : - value = Caml_format.caml_int_of_string(num); - break; - case /* NORMAL */3 : - value = float_of_string(num); - break; - - } - } else { - value = Caml_format.caml_int_of_string(num); + switch (number_type) { + case /* LEGACY_OCTAL */1 : + value = Caml_format.caml_int_of_string("0o" + num); + break; + case /* BINARY */0 : + case /* OCTAL */2 : + value = Caml_format.caml_int_of_string(num); + break; + case /* NORMAL */3 : + value = float_of_string(num); + break; + } const value$1 = neg === "" ? value : - value; return { @@ -5457,17 +5456,20 @@ const funarg = { }; function height(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; - return /* Node */{ + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; + return { + TAG: /* Node */0, l: l, v: v, r: r, @@ -5476,52 +5478,55 @@ function create(l, v, r) { } function bal(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const lv = l.v; - const ll = l.l; - if (height(ll) >= height(lr)) { - return create(ll, lv, create(lr, v, r)); - } - if (lr) { - return create(create(ll, lv, lr.l), lr.v, create(lr.r, v, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const lr = l.r; + const lv = l.v; + const ll = l.l; + if (height(ll) >= height(lr)) { + return create(ll, lv, create(lr, v, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, lr.l), lr.v, create(lr.r, v, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: v, r: r, h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rv = r.v; - const rl = r.l; - if (height(rr) >= height(rl)) { - return create(create(l, v, rl), rv, rr); - } - if (rl) { - return create(create(l, v, rl.l), rl.v, create(rl.r, rv, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const rr = r.r; + const rv = r.v; + const rl = r.l; + if (height(rr) >= height(rl)) { + return create(create(l, v, rl), rv, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, v, rl.l), rl.v, create(rl.r, rv, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" @@ -5529,8 +5534,9 @@ function bal(l, v, r) { } function add(x, t) { - if (!t) { - return /* Node */{ + if (/* tag */typeof t === "number" || typeof t === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -5563,7 +5569,7 @@ function add(x, t) { function mem(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(funarg.compare, x, param.v); @@ -5698,7 +5704,7 @@ function init_env(token_sinkOpt, parse_optionsOpt, source, content) { const token_sink = token_sinkOpt !== undefined ? Caml_option.valFromOption(token_sinkOpt) : undefined; const parse_options = parse_optionsOpt !== undefined ? Caml_option.valFromOption(parse_optionsOpt) : undefined; const lb = Stdlib__Lexing.from_string(undefined, content); - if (source !== undefined && typeof source !== "number") { + if (source !== undefined && !/* tag */(typeof source === "number" || typeof source === "string")) { const init = lb.lex_curr_p; lb.lex_curr_p = { pos_fname: source._0, @@ -5998,20 +6004,17 @@ function is_line_terminator(env) { function is_implicit_semicolon(env) { const match = token$2(undefined, env); - if (typeof match === "number") { - if (match > 104 || match < 3) { - if (match > 105 || match < 2) { - return is_line_terminator(env); - } else { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + return is_line_terminator(env); + } + switch (match) { + case /* T_SEMICOLON */7 : + return false; + case /* T_RCURLY */2 : + case /* T_EOF */105 : return true; - } - } else if (match !== 7) { + default: return is_line_terminator(env); - } else { - return false; - } - } else { - return is_line_terminator(env); } } @@ -6029,15 +6032,22 @@ function is_identifier(iOpt, env) { const match = token$2(i, env); if (is_strict_reserved(name) || is_restricted(name) || is_future_reserved(name)) { return true; - } else if (typeof match === "number") { - if (match > 57 || match < 1) { - return match < 63; - } else { - return match === 26; - } - } else { + } + if (!/* tag */(typeof match === "number" || typeof match === "string")) { return false; } + switch (match) { + case /* T_IDENTIFIER */0 : + case /* T_LET */26 : + case /* T_DECLARE */58 : + case /* T_TYPE */59 : + case /* T_OF */60 : + case /* T_ASYNC */61 : + case /* T_AWAIT */62 : + return true; + default: + return false; + } } function is_function(iOpt, env) { @@ -6054,15 +6064,16 @@ function is_function(iOpt, env) { function is_class(iOpt, env) { const i = iOpt !== undefined ? iOpt : 0; const match = token$2(i, env); - if (typeof match === "number") { - if (match !== 12) { - return match === 38; - } else { - return true; - } - } else { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { return false; } + switch (match) { + case /* T_AT */12 : + case /* T_CLASS */38 : + return true; + default: + return false; + } } function error$1(env, e) { @@ -6075,7 +6086,7 @@ function error$1(env, e) { function get_unexpected_error(param) { let tmp = param[0]; - if (typeof tmp === "number") { + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { switch (tmp) { case /* T_IDENTIFIER */0 : return /* UnexpectedIdentifier */2; @@ -6085,7 +6096,7 @@ function get_unexpected_error(param) { } } else { - switch (tmp.TAG | 0) { + switch (tmp.TAG) { case /* T_NUMBER */0 : return /* UnexpectedNumber */0; case /* T_STRING */1 : @@ -6298,7 +6309,8 @@ function to_parse(env, parse) { try { let result = Curry._1(parse, env); reset_token_sink(true, env, saved_state.token_buffer); - return /* ParsedSuccessfully */{ + return { + TAG: /* ParsedSuccessfully */0, _0: result }; } @@ -6342,17 +6354,20 @@ const funarg$1 = { }; function height$1(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$2(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; - return /* Node */{ + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; + return { + TAG: /* Node */0, l: l, v: v, r: r, @@ -6361,52 +6376,55 @@ function create$2(l, v, r) { } function bal$1(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const lv = l.v; - const ll = l.l; - if (height$1(ll) >= height$1(lr)) { - return create$2(ll, lv, create$2(lr, v, r)); - } - if (lr) { - return create$2(create$2(ll, lv, lr.l), lr.v, create$2(lr.r, v, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const lr = l.r; + const lv = l.v; + const ll = l.l; + if (height$1(ll) >= height$1(lr)) { + return create$2(ll, lv, create$2(lr, v, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$2(create$2(ll, lv, lr.l), lr.v, create$2(lr.r, v, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: v, r: r, h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rv = r.v; - const rl = r.l; - if (height$1(rr) >= height$1(rl)) { - return create$2(create$2(l, v, rl), rv, rr); - } - if (rl) { - return create$2(create$2(l, v, rl.l), rl.v, create$2(rl.r, rv, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const rr = r.r; + const rv = r.v; + const rl = r.l; + if (height$1(rr) >= height$1(rl)) { + return create$2(create$2(l, v, rl), rv, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$2(create$2(l, v, rl.l), rl.v, create$2(rl.r, rv, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" @@ -6414,8 +6432,9 @@ function bal$1(l, v, r) { } function add$1(x, t) { - if (!t) { - return /* Node */{ + if (/* tag */typeof t === "number" || typeof t === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -6448,7 +6467,7 @@ function add$1(x, t) { function mem$1(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(funarg$1.compare, x, param.v); @@ -6465,17 +6484,18 @@ const funarg$2 = { }; function height$2(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$3(l, x, d, r) { const hl = height$2(l); const hr = height$2(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -6485,32 +6505,35 @@ function create$3(l, x, d, r) { } function bal$2(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height$2(ll) >= height$2(lr)) { - return create$3(ll, lv, ld, create$3(lr, x, d, r)); - } - if (lr) { - return create$3(create$3(ll, lv, ld, lr.l), lr.v, lr.d, create$3(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height$2(ll) >= height$2(lr)) { + return create$3(ll, lv, ld, create$3(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$3(create$3(ll, lv, ld, lr.l), lr.v, lr.d, create$3(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -6518,22 +6541,22 @@ function bal$2(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height$2(rr) >= height$2(rl)) { - return create$3(create$3(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create$3(create$3(l, x, d, rl.l), rl.v, rl.d, create$3(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height$2(rr) >= height$2(rl)) { + return create$3(create$3(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$3(create$3(l, x, d, rl.l), rl.v, rl.d, create$3(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -6541,8 +6564,9 @@ function bal$2(l, x, d, r) { } function add$2(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -6559,7 +6583,8 @@ function add$2(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -6587,17 +6612,17 @@ function add$2(x, data, m) { function find(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(funarg$2.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(funarg$2.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } @@ -6615,17 +6640,20 @@ const funarg$3 = { }; function height$3(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$4(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; - return /* Node */{ + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; + return { + TAG: /* Node */0, l: l, v: v, r: r, @@ -6634,52 +6662,55 @@ function create$4(l, v, r) { } function bal$3(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const lv = l.v; - const ll = l.l; - if (height$3(ll) >= height$3(lr)) { - return create$4(ll, lv, create$4(lr, v, r)); - } - if (lr) { - return create$4(create$4(ll, lv, lr.l), lr.v, create$4(lr.r, v, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const lr = l.r; + const lv = l.v; + const ll = l.l; + if (height$3(ll) >= height$3(lr)) { + return create$4(ll, lv, create$4(lr, v, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$4(create$4(ll, lv, lr.l), lr.v, create$4(lr.r, v, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: v, r: r, h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rv = r.v; - const rl = r.l; - if (height$3(rr) >= height$3(rl)) { - return create$4(create$4(l, v, rl), rv, rr); - } - if (rl) { - return create$4(create$4(l, v, rl.l), rl.v, create$4(rl.r, rv, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const rr = r.r; + const rv = r.v; + const rl = r.l; + if (height$3(rr) >= height$3(rl)) { + return create$4(create$4(l, v, rl), rv, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$4(create$4(l, v, rl.l), rl.v, create$4(rl.r, rv, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" @@ -6687,8 +6718,9 @@ function bal$3(l, v, r) { } function add$3(x, t) { - if (!t) { - return /* Node */{ + if (/* tag */typeof t === "number" || typeof t === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -6721,7 +6753,7 @@ function add$3(x, t) { function mem$2(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(funarg$3.compare, x, param.v); @@ -6917,18 +6949,20 @@ function rev_nonempty_acc(acc) { function prefix(env) { const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match !== 76) { - const t = primary(env); - return postfix_with(env, t); + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + return postfix(env); + } + if (match !== /* T_PLING */76) { + return postfix(env); } const loc = Curry._2(Parser_env_Peek.loc, undefined, env); token$4(env, /* T_PLING */76); - const t$1 = prefix(env); + const t = prefix(env); return [ - btwn(loc, t$1[0]), + btwn(loc, t[0]), { TAG: /* Nullable */0, - _0: t$1 + _0: t } ]; } @@ -6978,17 +7012,18 @@ function function_param_with_id(env, name) { ]; } +function postfix(env) { + const t = primary(env); + return postfix_with(env, t); +} + function primitive(param) { - if (typeof param !== "number") { - return ; - } - if (param === 27) { - return /* Null */2; - } - if (param < 107) { + if (!/* tag */(typeof param === "number" || typeof param === "string")) { return ; } switch (param) { + case /* T_NULL */27 : + return /* Null */2; case /* T_ANY_TYPE */107 : return /* Any */0; case /* T_BOOLEAN_TYPE */108 : @@ -6999,28 +7034,45 @@ function primitive(param) { return /* String */4; case /* T_VOID_TYPE */111 : return /* Void */1; - + default: + return ; } } function function_param_or_generic_type(env) { const id = Curry._2(Parse.identifier, undefined, env); const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number" && (match === 77 || match === 76)) { - const param = function_param_with_id(env, id); - maybe(env, /* T_COMMA */8); - return { - TAG: /* ParamList */0, - _0: Curry._2(function_param_list_without_parens, env, { - hd: param, - tl: /* [] */0 - }) - }; + let exit = 0; + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_PLING */76 : + case /* T_COLON */77 : + exit = 2; + break; + default: + exit = 1; + } + } else { + exit = 1; + } + switch (exit) { + case 1 : + return { + TAG: /* Type */1, + _0: Curry._2(union_with, env, Curry._2(intersection_with, env, postfix_with(env, generic_type_with_identifier(env, id)))) + }; + case 2 : + const param = function_param_with_id(env, id); + maybe(env, /* T_COMMA */8); + return { + TAG: /* ParamList */0, + _0: Curry._2(function_param_list_without_parens, env, { + hd: param, + tl: /* [] */0 + }) + }; + } - return { - TAG: /* Type */1, - _0: Curry._2(union_with, env, Curry._2(intersection_with, env, postfix_with(env, generic_type_with_identifier(env, id)))) - }; } function function_param_list(env) { @@ -7035,49 +7087,29 @@ function param_list_or_type(env) { const token$5 = Curry._2(Parser_env_Peek.token, undefined, env); let ret; let exit = 0; - if (typeof token$5 === "number") { - if (token$5 !== 105) { - if (token$5 >= 12) { + if (/* tag */typeof token$5 === "number" || typeof token$5 === "string") { + switch (token$5) { + case /* T_IDENTIFIER */0 : + ret = function_param_or_generic_type(env); + break; + case /* T_RPAREN */4 : + ret = { + TAG: /* ParamList */0, + _0: [ + undefined, + /* [] */0 + ] + }; + break; + case /* T_ELLIPSIS */11 : + case /* T_EOF */105 : + ret = { + TAG: /* ParamList */0, + _0: Curry._2(function_param_list_without_parens, env, /* [] */0) + }; + break; + default: exit = 1; - } else { - switch (token$5) { - case /* T_IDENTIFIER */0 : - ret = function_param_or_generic_type(env); - break; - case /* T_RPAREN */4 : - ret = { - TAG: /* ParamList */0, - _0: [ - undefined, - /* [] */0 - ] - }; - break; - case /* T_LCURLY */1 : - case /* T_RCURLY */2 : - case /* T_LPAREN */3 : - case /* T_LBRACKET */5 : - case /* T_RBRACKET */6 : - case /* T_SEMICOLON */7 : - case /* T_COMMA */8 : - case /* T_PERIOD */9 : - case /* T_ARROW */10 : - exit = 1; - break; - case /* T_ELLIPSIS */11 : - ret = { - TAG: /* ParamList */0, - _0: Curry._2(function_param_list_without_parens, env, /* [] */0) - }; - break; - - } - } - } else { - ret = { - TAG: /* ParamList */0, - _0: Curry._2(function_param_list_without_parens, env, /* [] */0) - }; } } else { exit = 1; @@ -7086,7 +7118,26 @@ function param_list_or_type(env) { const match = primitive(token$5); if (match !== undefined) { const match$1 = Curry._2(Parser_env_Peek.token, 1, env); - if (typeof match$1 === "number" && (match$1 === 77 || match$1 === 76)) { + let exit$1 = 0; + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { + switch (match$1) { + case /* T_PLING */76 : + case /* T_COLON */77 : + exit$1 = 2; + break; + default: + ret = { + TAG: /* Type */1, + _0: union(env) + }; + } + } else { + ret = { + TAG: /* Type */1, + _0: union(env) + }; + } + if (exit$1 === 2) { const match$2 = Curry._1(Parse.identifier_or_reserved_keyword, env); const name = match$2[0]; if (!env.parse_options.types) { @@ -7115,12 +7166,8 @@ function param_list_or_type(env) { tl: /* [] */0 }) }; - } else { - ret = { - TAG: /* Type */1, - _0: union(env) - }; } + } else { ret = { TAG: /* Type */1, @@ -7147,7 +7194,7 @@ function primary(env) { const loc = Curry._2(Parser_env_Peek.loc, undefined, env); const token$5 = Curry._2(Parser_env_Peek.token, undefined, env); let exit = 0; - if (typeof token$5 === "number") { + if (/* tag */typeof token$5 === "number" || typeof token$5 === "string") { switch (token$5) { case /* T_IDENTIFIER */0 : const match = generic(env); @@ -7246,7 +7293,7 @@ function primary(env) { exit = 1; } } else { - switch (token$5.TAG | 0) { + switch (token$5.TAG) { case /* T_STRING */1 : const match$4 = token$5._0; const octal = match$4[3]; @@ -7348,7 +7395,7 @@ function union_with(env, left) { while(true) { const acc = _acc; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match === 80) { + if (/* tag */(typeof match === "number" || typeof match === "string") && match === /* T_BIT_OR */80) { token$4(env, /* T_BIT_OR */80); _acc = { hd: intersection(env), @@ -7434,7 +7481,7 @@ function intersection_with(env, left) { while(true) { const acc = _acc; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match === 82) { + if (/* tag */(typeof match === "number" || typeof match === "string") && match === /* T_BIT_AND */82) { token$4(env, /* T_BIT_AND */82); _acc = { hd: prefix(env), @@ -7468,13 +7515,19 @@ function function_param_list_without_parens(env) { const acc = _acc; const t = Curry._2(Parser_env_Peek.token, undefined, env); let exit = 0; - exit = typeof t === "number" ? ( - t > 11 || t < 4 ? ( - t !== 105 ? 1 : 2 - ) : ( - t > 10 || t < 5 ? 2 : 1 - ) - ) : 1; + if (/* tag */typeof t === "number" || typeof t === "string") { + switch (t) { + case /* T_RPAREN */4 : + case /* T_ELLIPSIS */11 : + case /* T_EOF */105 : + exit = 2; + break; + default: + exit = 1; + } + } else { + exit = 1; + } switch (exit) { case 1 : const acc_0 = param(env); @@ -7503,14 +7556,14 @@ function params(env, _acc) { while(true) { const acc = _acc; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number") { - if (match === 90) { - return Stdlib__List.rev(acc); - } - if (match === 105) { - return Stdlib__List.rev(acc); + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_GREATER_THAN */90 : + case /* T_EOF */105 : + return Stdlib__List.rev(acc); + default: + } - } const acc_0 = union(env); const acc$1 = { @@ -7547,30 +7600,58 @@ function params$1(env, allow_default, _require_default, _acc) { const acc = _acc; const require_default = _require_default; const match = Curry._2(Parser_env_Peek.token, undefined, env); - const variance = typeof match === "number" ? ( - match !== 94 ? ( - match !== 95 ? undefined : (token$3(env), /* Minus */1) - ) : (token$3(env), /* Plus */0) - ) : undefined; + let variance; + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_PLUS */94 : + token$3(env); + variance = /* Plus */0; + break; + case /* T_MINUS */95 : + token$3(env); + variance = /* Minus */1; + break; + default: + variance = undefined; + } + } else { + variance = undefined; + } const match$1 = Curry._2(Parse.identifier_with_type, env, /* StrictParamName */28); const id = match$1[1]; const loc = match$1[0]; const match$2 = Curry._2(Parser_env_Peek.token, undefined, env); - const match$3 = allow_default ? ( - match$2 === 75 ? (token$3(env), [ - union(env), - true - ]) : (require_default ? error_at(env, [ - loc, - /* MissingTypeParamDefault */58 - ]) : undefined, [ - undefined, - require_default - ]) - ) : [ + let match$3; + if (allow_default) { + let exit = 0; + if (/* tag */(typeof match$2 === "number" || typeof match$2 === "string") && match$2 === /* T_ASSIGN */75) { + token$3(env); + match$3 = [ + union(env), + true + ]; + } else { + exit = 1; + } + if (exit === 1) { + if (require_default) { + error_at(env, [ + loc, + /* MissingTypeParamDefault */58 + ]); + } + match$3 = [ + undefined, + require_default + ]; + } + + } else { + match$3 = [ undefined, false ]; + } const param_1 = { name: id.name, bound: id.typeAnnotation, @@ -7586,14 +7667,14 @@ function params$1(env, allow_default, _require_default, _acc) { tl: acc }; const match$4 = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match$4 === "number") { - if (match$4 === 90) { - return Stdlib__List.rev(acc$1); - } - if (match$4 === 105) { - return Stdlib__List.rev(acc$1); - } - + if (/* tag */typeof match$4 === "number" || typeof match$4 === "string") { + switch (match$4) { + case /* T_GREATER_THAN */90 : + case /* T_EOF */105 : + return Stdlib__List.rev(acc$1); + default: + + } } token$4(env, /* T_COMMA */8); if (Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_GREATER_THAN */90)) { @@ -7629,14 +7710,14 @@ function types(env, _acc) { while(true) { const acc = _acc; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number") { - if (match === 6) { - return Stdlib__List.rev(acc); - } - if (match === 105) { - return Stdlib__List.rev(acc); + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_RBRACKET */6 : + case /* T_EOF */105 : + return Stdlib__List.rev(acc); + default: + } - } const acc_0 = union(env); const acc$1 = { @@ -7742,20 +7823,17 @@ function indexer_property(env, start_loc, $$static) { function semicolon$1(env) { const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number") { - if (match >= 7) { - if (match >= 9) { - return error_unexpected(env); - } else { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + return error_unexpected(env); + } + switch (match) { + case /* T_RCURLY */2 : + return ; + case /* T_SEMICOLON */7 : + case /* T_COMMA */8 : return token$3(env); - } - } else if (match !== 2) { + default: return error_unexpected(env); - } else { - return ; - } - } else { - return error_unexpected(env); } } @@ -7769,44 +7847,30 @@ function properties(allow_static, env, _param) { const $$static = allow_static && maybe(env, /* T_STATIC */40); const match = Curry._2(Parser_env_Peek.token, undefined, env); let exit = 0; - if (typeof match === "number") { - if (match !== 89) { - if (match !== 105) { - if (match >= 6) { - exit = 1; - } else { - switch (match) { - case /* T_RCURLY */2 : - exit = 2; - break; - case /* T_LPAREN */3 : - exit = 3; - break; - case /* T_IDENTIFIER */0 : - case /* T_LCURLY */1 : - case /* T_RPAREN */4 : - exit = 1; - break; - case /* T_LBRACKET */5 : - const indexer = indexer_property(env, start_loc, $$static); - semicolon$1(env); - _param = [ - acc, - { - hd: indexer, - tl: indexers - }, - callProperties - ]; - continue ; - - } - } - } else { - exit = 2; - } - } else { - exit = 3; + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_LBRACKET */5 : + const indexer = indexer_property(env, start_loc, $$static); + semicolon$1(env); + _param = [ + acc, + { + hd: indexer, + tl: indexers + }, + callProperties + ]; + continue ; + case /* T_LPAREN */3 : + case /* T_LESS_THAN */89 : + exit = 3; + break; + case /* T_RCURLY */2 : + case /* T_EOF */105 : + exit = 2; + break; + default: + exit = 1; } } else { exit = 1; @@ -7816,7 +7880,7 @@ function properties(allow_static, env, _param) { const match$1 = Curry._2(Parser_env_Peek.token, undefined, env); let match$2; let exit$1 = 0; - if ($$static && match$1 === 77) { + if ($$static && /* tag */(typeof match$1 === "number" || typeof match$1 === "string") && match$1 === /* T_COLON */77) { strict_error_at(env, [ start_loc, /* StrictReservedWord */39 @@ -7855,7 +7919,19 @@ function properties(allow_static, env, _param) { const key$1 = match$2[1][1]; const $$static$1 = match$2[0]; const match$3 = Curry._2(Parser_env_Peek.token, undefined, env); - const property$1 = typeof match$3 === "number" && !(match$3 !== 3 && match$3 !== 89) ? method_property(env, start_loc, $$static$1, key$1) : property(env, start_loc, $$static$1, key$1); + let property$1; + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { + switch (match$3) { + case /* T_LPAREN */3 : + case /* T_LESS_THAN */89 : + property$1 = method_property(env, start_loc, $$static$1, key$1); + break; + default: + property$1 = property(env, start_loc, $$static$1, key$1); + } + } else { + property$1 = property(env, start_loc, $$static$1, key$1); + } semicolon$1(env); _param = [ { @@ -7941,7 +8017,7 @@ function annotation(env) { function annotation_opt(env) { const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match === 77) { + if (/* tag */(typeof match === "number" || typeof match === "string") && match === /* T_COLON */77) { return annotation(env); } @@ -7976,7 +8052,7 @@ function pattern(check_env, _param) { while(true) { const param = _param; const p = param[1]; - switch (p.TAG | 0) { + switch (p.TAG) { case /* Object */0 : let o = p._0; return Stdlib__List.fold_left(object_property, check_env, o.properties); @@ -8024,7 +8100,7 @@ function object_property(check_env) { const property = param._0[1]; const id = property.key; let check_env$1; - switch (id.TAG | 0) { + switch (id.TAG) { case /* Identifier */1 : check_env$1 = identifier_no_dupe_check(check_env, id._0); break; @@ -8126,13 +8202,19 @@ function param_list(env, _param) { const params = param$2[0]; const t = Curry._2(Parser_env_Peek.token, undefined, env); let exit = 0; - exit = typeof t === "number" ? ( - t > 11 || t < 4 ? ( - t !== 105 ? 1 : 2 - ) : ( - t > 10 || t < 5 ? 2 : 1 - ) - ) : 1; + if (/* tag */typeof t === "number" || typeof t === "string") { + switch (t) { + case /* T_RPAREN */4 : + case /* T_ELLIPSIS */11 : + case /* T_EOF */105 : + exit = 2; + break; + default: + exit = 1; + } + } else { + exit = 1; + } switch (exit) { case 1 : const match = param$1(env); @@ -8235,23 +8317,24 @@ function _function(env) { const match$1 = Curry._2(Parser_env_Peek.token, undefined, env); let match$2; let exit = 0; - if (match && typeof match$1 === "number") { - if (match$1 !== 3) { - if (match$1 !== 89) { + if (match && /* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1) { + case /* T_LPAREN */3 : + match$2 = [ + undefined, + undefined + ]; + break; + case /* T_LESS_THAN */89 : + const typeParams = Curry._1(type_parameter_declaration$1, env); + const id = Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_LPAREN */3) ? undefined : Curry._2(Parse.identifier, /* StrictFunctionName */30, env); + match$2 = [ + typeParams, + id + ]; + break; + default: exit = 1; - } else { - const typeParams = Curry._1(type_parameter_declaration$1, env); - const id = Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_LPAREN */3) ? undefined : Curry._2(Parse.identifier, /* StrictFunctionName */30, env); - match$2 = [ - typeParams, - id - ]; - } - } else { - match$2 = [ - undefined, - undefined - ]; } } else { exit = 1; @@ -8421,16 +8504,11 @@ function variable(env) { const start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); const match = Curry._2(Parser_env_Peek.token, undefined, env); let match$1; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { switch (match) { case /* T_VAR */22 : match$1 = declarations(/* T_VAR */22, /* Var */0, env); break; - case /* T_WHILE */23 : - case /* T_WITH */24 : - error_unexpected(env); - match$1 = declarations(/* T_VAR */22, /* Var */0, env); - break; case /* T_CONST */25 : match$1 = $$const(env); break; @@ -8466,10 +8544,10 @@ function is_tighter(a, b) { function is_lhs(param) { let tmp = param[1]; - if (typeof tmp === "number") { + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { return false; } - switch (tmp.TAG | 0) { + switch (tmp.TAG) { case /* Member */13 : case /* Identifier */18 : return true; @@ -8480,10 +8558,10 @@ function is_lhs(param) { function is_assignable_lhs(param) { let tmp = param[1]; - if (typeof tmp === "number") { + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { return false; } - switch (tmp.TAG | 0) { + switch (tmp.TAG) { case /* Array */0 : case /* Object */1 : case /* Member */13 : @@ -8497,7 +8575,7 @@ function is_assignable_lhs(param) { function assignment_op(env) { const match = Curry._2(Parser_env_Peek.token, undefined, env); let op; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { switch (match) { case /* T_RSHIFT3_ASSIGN */63 : op = /* RShift3Assign */9; @@ -8577,49 +8655,32 @@ function conditional(env) { function peek_unary_op(env) { const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match !== "number") { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { return ; } - if (match >= 46) { - if (match < 94) { - if (match !== 62 || !env.allow_await) { - return ; - } else { - return /* Await */7; - } - } - if (match >= 102) { - return ; - } - switch (match) { - case /* T_PLUS */94 : - return /* Plus */1; - case /* T_MINUS */95 : - return /* Minus */0; - case /* T_DIV */96 : - case /* T_MULT */97 : - case /* T_EXP */98 : - case /* T_MOD */99 : + switch (match) { + case /* T_DELETE */43 : + return /* Delete */6; + case /* T_TYPEOF */44 : + return /* Typeof */4; + case /* T_VOID */45 : + return /* Void */5; + case /* T_AWAIT */62 : + if (env.allow_await) { + return /* Await */7; + } else { return ; - case /* T_NOT */100 : - return /* Not */2; - case /* T_BIT_NOT */101 : - return /* BitNot */3; - - } - } else { - if (match < 43) { + } + case /* T_PLUS */94 : + return /* Plus */1; + case /* T_MINUS */95 : + return /* Minus */0; + case /* T_NOT */100 : + return /* Not */2; + case /* T_BIT_NOT */101 : + return /* BitNot */3; + default: return ; - } - switch (match) { - case /* T_DELETE */43 : - return /* Delete */6; - case /* T_TYPEOF */44 : - return /* Typeof */4; - case /* T_VOID */45 : - return /* Void */5; - - } } } @@ -8630,9 +8691,9 @@ function unary(env) { token$3(env); const argument = unary(env); const loc = btwn(begin_loc, argument[0]); - if (op === 6) { + if (op === /* Delete */6) { let tmp = argument[1]; - if (typeof tmp !== "number" && tmp.TAG === /* Identifier */18) { + if (!/* tag */(typeof tmp === "number" || typeof tmp === "string") && tmp.TAG === /* Identifier */18) { strict_error_at(env, [ loc, /* StrictDelete */32 @@ -8653,22 +8714,42 @@ function unary(env) { ]; } const match = Curry._2(Parser_env_Peek.token, undefined, env); - const op$1 = typeof match === "number" ? ( - match !== 102 ? ( - match !== 103 ? undefined : /* Decrement */1 - ) : /* Increment */0 - ) : undefined; + let op$1; + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_INCR */102 : + op$1 = /* Increment */0; + break; + case /* T_DECR */103 : + op$1 = /* Decrement */1; + break; + default: + op$1 = undefined; + } + } else { + op$1 = undefined; + } if (op$1 === undefined) { const argument$1 = left_hand_side(env); if (Curry._1(Parser_env_Peek.is_line_terminator, env)) { return argument$1; } const match$1 = Curry._2(Parser_env_Peek.token, undefined, env); - const op$2 = typeof match$1 === "number" ? ( - match$1 !== 102 ? ( - match$1 !== 103 ? undefined : /* Decrement */1 - ) : /* Increment */0 - ) : undefined; + let op$2; + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { + switch (match$1) { + case /* T_INCR */102 : + op$2 = /* Increment */0; + break; + case /* T_DECR */103 : + op$2 = /* Decrement */1; + break; + default: + op$2 = undefined; + } + } else { + op$2 = undefined; + } if (op$2 === undefined) { return argument$1; } @@ -8679,7 +8760,7 @@ function unary(env) { ]); } const match$2 = argument$1[1]; - if (typeof match$2 !== "number" && match$2.TAG === /* Identifier */18) { + if (!/* tag */(typeof match$2 === "number" || typeof match$2 === "string") && match$2.TAG === /* Identifier */18) { if (is_restricted(match$2._0[1].name)) { strict_error(env, /* StrictLHSPostfix */37); } @@ -8708,7 +8789,7 @@ function unary(env) { ]); } const match$3 = argument$2[1]; - if (typeof match$3 !== "number" && match$3.TAG === /* Identifier */18) { + if (!/* tag */(typeof match$3 === "number" || typeof match$3 === "string") && match$3.TAG === /* Identifier */18) { if (is_restricted(match$3._0[1].name)) { strict_error(env, /* StrictLHSPrefix */38); } @@ -8729,14 +8810,21 @@ function unary(env) { function left_hand_side(env) { const match = Curry._2(Parser_env_Peek.token, undefined, env); - const expr = match === 42 ? _new(env, (function (new_expr, _args) { + let expr; + let exit = 0; + if (/* tag */(typeof match === "number" || typeof match === "string") && match === /* T_NEW */42) { + expr = _new(env, (function (new_expr, _args) { return new_expr; - })) : ( - Curry._2(Parser_env_Peek.is_function, undefined, env) ? _function$1(env) : primary$1(env) - ); + })); + } else { + exit = 1; + } + if (exit === 1) { + expr = Curry._2(Parser_env_Peek.is_function, undefined, env) ? _function$1(env) : primary$1(env); + } const expr$1 = member(env, expr); const part = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof part === "number") { + if (/* tag */typeof part === "number" || typeof part === "string") { if (part === /* T_LPAREN */3) { return call(env, expr$1); } else { @@ -8753,7 +8841,7 @@ function call(env, _left) { while(true) { const left = _left; const part = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof part !== "number") { + if (!/* tag */(typeof part === "number" || typeof part === "string")) { if (part.TAG === /* T_TEMPLATE_PART */2) { return tagged_template(env, left, part._0); } else { @@ -8827,7 +8915,7 @@ function _new(env, _finish_fn) { while(true) { const finish_fn = _finish_fn; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match === 42) { + if (/* tag */(typeof match === "number" || typeof match === "string") && match === /* T_NEW */42) { const start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); token$4(env, /* T_NEW */42); const finish_fn$p = function (callee, args) { @@ -8860,58 +8948,60 @@ function _new(env, _finish_fn) { const callee = member(with_no_call(true, env), expr); const part = Curry._2(Parser_env_Peek.token, undefined, env); let callee$1; - callee$1 = typeof part === "number" || part.TAG !== /* T_TEMPLATE_PART */2 ? callee : tagged_template(env, callee, part._0); + callee$1 = /* tag */typeof part === "number" || typeof part === "string" || part.TAG !== /* T_TEMPLATE_PART */2 ? callee : tagged_template(env, callee, part._0); const match$1 = Curry._2(Parser_env_Peek.token, undefined, env); - const args = match$1 === 3 ? Curry._1($$arguments, env) : undefined; + let args; + args = /* tag */(typeof match$1 === "number" || typeof match$1 === "string") && match$1 === /* T_LPAREN */3 ? Curry._1($$arguments, env) : undefined; return Curry._2(finish_fn, callee$1, args); }; } function member(env, left) { const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match !== "number") { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { return left; } - if (match !== 5) { - if (match !== 9) { + switch (match) { + case /* T_LBRACKET */5 : + token$4(env, /* T_LBRACKET */5); + const expr = Curry._1(Parse.expression, with_no_call(false, env)); + const last_loc = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_RBRACKET */6); + return call(env, [ + btwn(left[0], last_loc), + { + TAG: /* Member */13, + _0: { + _object: left, + property: { + TAG: /* PropertyExpression */1, + _0: expr + }, + computed: true + } + } + ]); + case /* T_PERIOD */9 : + token$4(env, /* T_PERIOD */9); + const match$1 = identifier_or_reserved_keyword(env); + const id = match$1[0]; + return call(env, [ + btwn(left[0], id[0]), + { + TAG: /* Member */13, + _0: { + _object: left, + property: { + TAG: /* PropertyIdentifier */0, + _0: id + }, + computed: false + } + } + ]); + default: return left; - } - token$4(env, /* T_PERIOD */9); - const match$1 = identifier_or_reserved_keyword(env); - const id = match$1[0]; - return call(env, [ - btwn(left[0], id[0]), - { - TAG: /* Member */13, - _0: { - _object: left, - property: { - TAG: /* PropertyIdentifier */0, - _0: id - }, - computed: false - } - } - ]); } - token$4(env, /* T_LBRACKET */5); - const expr = Curry._1(Parse.expression, with_no_call(false, env)); - const last_loc = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_RBRACKET */6); - return call(env, [ - btwn(left[0], last_loc), - { - TAG: /* Member */13, - _0: { - _object: left, - property: { - TAG: /* PropertyExpression */1, - _0: expr - }, - computed: true - } - } - ]); } function _function$1(env) { @@ -8927,7 +9017,8 @@ function _function$1(env) { ]; } else { const match$1 = Curry._2(Parser_env_Peek.token, undefined, env); - const id = match$1 === 89 ? undefined : Curry._2(Parse.identifier, /* StrictFunctionName */30, env); + let id; + id = /* tag */(typeof match$1 === "number" || typeof match$1 === "string") && match$1 === /* T_LESS_THAN */89 ? undefined : Curry._2(Parse.identifier, /* StrictFunctionName */30, env); match = [ id, Curry._1(type_parameter_declaration$1, env) @@ -8970,32 +9061,29 @@ function _function$1(env) { function number(env, number_type) { const value = Curry._2(Parser_env_Peek.value, undefined, env); let value$1; - if (number_type) { - switch (number_type) { - case /* LEGACY_OCTAL */1 : - strict_error(env, /* StrictOctalLiteral */31); - value$1 = Caml_format.caml_int_of_string("0o" + value); - break; - case /* OCTAL */2 : - value$1 = Caml_format.caml_int_of_string(value); - break; - case /* NORMAL */3 : - try { - value$1 = float_of_string(value); - } - catch (exn){ - if (Stdlib__Sys.win32) { - error$1(env, /* WindowsFloatOfString */59); - value$1 = 789.0; - } else { - throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); - } + switch (number_type) { + case /* LEGACY_OCTAL */1 : + strict_error(env, /* StrictOctalLiteral */31); + value$1 = Caml_format.caml_int_of_string("0o" + value); + break; + case /* BINARY */0 : + case /* OCTAL */2 : + value$1 = Caml_format.caml_int_of_string(value); + break; + case /* NORMAL */3 : + try { + value$1 = float_of_string(value); + } + catch (exn){ + if (Stdlib__Sys.win32) { + error$1(env, /* WindowsFloatOfString */59); + value$1 = 789.0; + } else { + throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } - break; - - } - } else { - value$1 = Caml_format.caml_int_of_string(value); + } + break; + } token$4(env, { TAG: /* T_NUMBER */0, @@ -9008,7 +9096,7 @@ function primary$1(env) { const loc = Curry._2(Parser_env_Peek.loc, undefined, env); const number_type = Curry._2(Parser_env_Peek.token, undefined, env); let exit = 0; - if (typeof number_type === "number") { + if (/* tag */typeof number_type === "number" || typeof number_type === "string") { switch (number_type) { case /* T_LCURLY */1 : const match = Curry._1(Parse.object_initializer, env); @@ -9024,28 +9112,29 @@ function primary$1(env) { const expression = Curry._1(assignment, env); const match$1 = Curry._2(Parser_env_Peek.token, undefined, env); let ret; - if (typeof match$1 === "number") { - if (match$1 !== 8) { - if (match$1 !== 77) { - ret = expression; - } else { - const typeAnnotation = wrap(annotation, env); - ret = [ - btwn(expression[0], typeAnnotation[0]), - { - TAG: /* TypeCast */24, - _0: { - expression: expression, - typeAnnotation: typeAnnotation + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { + switch (match$1) { + case /* T_COMMA */8 : + ret = sequence(env, { + hd: expression, + tl: /* [] */0 + }); + break; + case /* T_COLON */77 : + const typeAnnotation = wrap(annotation, env); + ret = [ + btwn(expression[0], typeAnnotation[0]), + { + TAG: /* TypeCast */24, + _0: { + expression: expression, + typeAnnotation: typeAnnotation + } } - } - ]; - } - } else { - ret = sequence(env, { - hd: expression, - tl: /* [] */0 - }); + ]; + break; + default: + ret = expression; } } else { ret = expression; @@ -9120,7 +9209,7 @@ function primary$1(env) { const loc$2 = Curry._2(Parser_env_Peek.loc, undefined, env); const match$4 = Curry._2(Parser_env_Peek.token, undefined, env); let match$5; - if (typeof match$4 === "number") { + if (/* tag */typeof match$4 === "number" || typeof match$4 === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -9204,7 +9293,7 @@ function primary$1(env) { exit = 1; } } else { - switch (number_type.TAG | 0) { + switch (number_type.TAG) { case /* T_NUMBER */0 : const raw$2 = Curry._2(Parser_env_Peek.value, undefined, env); const value$1 = { @@ -9331,7 +9420,7 @@ function sequence(env, _acc) { while(true) { const acc = _acc; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match === 8) { + if (/* tag */(typeof match === "number" || typeof match === "string") && match === /* T_COMMA */8) { token$4(env, /* T_COMMA */8); const expr = Curry._1(assignment, env); _acc = { @@ -9360,71 +9449,116 @@ function identifier_or_reserved_keyword(env) { const lex_value = Curry._2(Parser_env_Peek.value, undefined, env); const lex_loc = Curry._2(Parser_env_Peek.loc, undefined, env); let exit = 0; - if (typeof lex_token === "number") { - if (lex_token >= 58) { - if (lex_token < 62) { - return [ - Curry._2(Parse.identifier, undefined, env), - undefined - ]; - } - exit = 1; - } else { - if (!lex_token) { - return [ - Curry._2(Parse.identifier, undefined, env), - undefined - ]; - } - exit = 1; + if (/* tag */typeof lex_token === "number" || typeof lex_token === "string") { + switch (lex_token) { + case /* T_IDENTIFIER */0 : + case /* T_DECLARE */58 : + case /* T_TYPE */59 : + case /* T_OF */60 : + case /* T_ASYNC */61 : + exit = 2; + break; + default: + exit = 1; } } else { exit = 1; } - if (exit === 1) { - let err; - let exit$1 = 0; - if (typeof lex_token === "number") { - if (lex_token > 106 || lex_token < 58) { - if (lex_token >= 13) { - exit$1 = 2; - } else { - error_unexpected(env); - err = undefined; - } - } else if (lex_token !== 62) { - error_unexpected(env); - err = undefined; - } else { - exit$1 = 2; - } - } else { - error_unexpected(env); - err = undefined; - } - if (exit$1 === 2) { - err = [ - lex_loc, - get_unexpected_error([ - lex_token, - lex_value - ]) - ]; - } - token$3(env); - return [ - [ - lex_loc, - { - name: lex_value, - typeAnnotation: undefined, - optional: false - } - ], - err - ]; + switch (exit) { + case 1 : + let err; + let exit$1 = 0; + if (/* tag */typeof lex_token === "number" || typeof lex_token === "string") { + switch (lex_token) { + case /* T_FUNCTION */13 : + case /* T_IF */14 : + case /* T_IN */15 : + case /* T_INSTANCEOF */16 : + case /* T_RETURN */17 : + case /* T_SWITCH */18 : + case /* T_THIS */19 : + case /* T_THROW */20 : + case /* T_TRY */21 : + case /* T_VAR */22 : + case /* T_WHILE */23 : + case /* T_WITH */24 : + case /* T_CONST */25 : + case /* T_LET */26 : + case /* T_NULL */27 : + case /* T_FALSE */28 : + case /* T_TRUE */29 : + case /* T_BREAK */30 : + case /* T_CASE */31 : + case /* T_CATCH */32 : + case /* T_CONTINUE */33 : + case /* T_DEFAULT */34 : + case /* T_DO */35 : + case /* T_FINALLY */36 : + case /* T_FOR */37 : + case /* T_CLASS */38 : + case /* T_EXTENDS */39 : + case /* T_STATIC */40 : + case /* T_ELSE */41 : + case /* T_NEW */42 : + case /* T_DELETE */43 : + case /* T_TYPEOF */44 : + case /* T_VOID */45 : + case /* T_ENUM */46 : + case /* T_EXPORT */47 : + case /* T_IMPORT */48 : + case /* T_SUPER */49 : + case /* T_IMPLEMENTS */50 : + case /* T_INTERFACE */51 : + case /* T_PACKAGE */52 : + case /* T_PRIVATE */53 : + case /* T_PROTECTED */54 : + case /* T_PUBLIC */55 : + case /* T_YIELD */56 : + case /* T_DEBUGGER */57 : + case /* T_AWAIT */62 : + case /* T_ANY_TYPE */107 : + case /* T_BOOLEAN_TYPE */108 : + case /* T_NUMBER_TYPE */109 : + case /* T_STRING_TYPE */110 : + case /* T_VOID_TYPE */111 : + exit$1 = 3; + break; + default: + error_unexpected(env); + err = undefined; + } + } else { + error_unexpected(env); + err = undefined; + } + if (exit$1 === 3) { + err = [ + lex_loc, + get_unexpected_error([ + lex_token, + lex_value + ]) + ]; + } + token$3(env); + return [ + [ + lex_loc, + { + name: lex_value, + typeAnnotation: undefined, + optional: false + } + ], + err + ]; + case 2 : + return [ + Curry._2(Parse.identifier, undefined, env), + undefined + ]; + } - } function assignment_but_not_arrow_function(env) { @@ -9440,7 +9574,7 @@ function assignment_but_not_arrow_function(env) { ]); } const match = expr[1]; - if (typeof match !== "number" && match.TAG === /* Identifier */18) { + if (!/* tag */(typeof match === "number" || typeof match === "string") && match.TAG === /* Identifier */18) { if (is_restricted(match._0[1].name)) { strict_error_at(env, [ expr[0], @@ -9475,18 +9609,15 @@ function try_assignment_but_not_arrow_function(env) { const env$1 = with_error_callback(error_callback, env); const ret = assignment_but_not_arrow_function(env$1); const match = Curry._2(Parser_env_Peek.token, undefined, env$1); - if (typeof match === "number") { - if (match !== 10) { - if (match === 77) { - throw new Caml_js_exceptions.MelangeError(Parser_env_Try.Rollback, { - MEL_EXN_ID: Parser_env_Try.Rollback - }); - } - - } else { - throw new Caml_js_exceptions.MelangeError(Parser_env_Try.Rollback, { - MEL_EXN_ID: Parser_env_Try.Rollback - }); + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_ARROW */10 : + case /* T_COLON */77 : + throw new Caml_js_exceptions.MelangeError(Parser_env_Try.Rollback, { + MEL_EXN_ID: Parser_env_Try.Rollback + }); + default: + } } if (!Curry._2(Parser_env_Peek.is_identifier, undefined, env$1)) { @@ -9498,7 +9629,7 @@ function try_assignment_but_not_arrow_function(env) { }); } const match$1 = ret[1]; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return ret; } if (match$1.TAG !== /* Identifier */18) { @@ -9519,45 +9650,45 @@ function assignment(env) { const match = Curry._2(Parser_env_Peek.token, undefined, env); const match$1 = Curry._2(Parser_env_Peek.is_identifier, undefined, env); let exit = 0; - if (typeof match === "number") { - if (match > 88 || match < 4) { - if (match > 89 || match < 3) { + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_YIELD */56 : + if (env.allow_yield) { + const start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_YIELD */56); + if (!env.allow_yield) { + error$1(env, /* IllegalYield */24); + } + const delegate = maybe(env, /* T_MULT */97); + const has_argument = !(Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_SEMICOLON */7) || Curry._1(Parser_env_Peek.is_implicit_semicolon, env)); + const argument = delegate || has_argument ? Curry._1(assignment, env) : undefined; + let end_loc; + if (argument !== undefined) { + end_loc = argument[0]; + } else { + const loc = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); + const end_loc$1 = loc !== undefined ? loc : start_loc; + semicolon(env); + end_loc = end_loc$1; + } + return [ + btwn(start_loc, end_loc), + { + TAG: /* Yield */14, + _0: { + argument: argument, + delegate: delegate + } + } + ]; + } + exit = 2; + break; + case /* T_LPAREN */3 : + case /* T_LESS_THAN */89 : + break; + default: exit = 2; - } - - } else if (match !== 56) { - exit = 2; - } else { - if (env.allow_yield) { - const start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_YIELD */56); - if (!env.allow_yield) { - error$1(env, /* IllegalYield */24); - } - const delegate = maybe(env, /* T_MULT */97); - const has_argument = !(Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_SEMICOLON */7) || Curry._1(Parser_env_Peek.is_implicit_semicolon, env)); - const argument = delegate || has_argument ? Curry._1(assignment, env) : undefined; - let end_loc; - if (argument !== undefined) { - end_loc = argument[0]; - } else { - const loc = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); - const end_loc$1 = loc !== undefined ? loc : start_loc; - semicolon(env); - end_loc = end_loc$1; - } - return [ - btwn(start_loc, end_loc), - { - TAG: /* Yield */14, - _0: { - argument: argument, - delegate: delegate - } - } - ]; - } - exit = 2; } } else { exit = 2; @@ -9566,14 +9697,14 @@ function assignment(env) { return assignment_but_not_arrow_function(env); } const expr = Curry._2(Parser_env_Try.to_parse, env, try_assignment_but_not_arrow_function); - if (expr) { + if (!/* tag */(typeof expr === "number" || typeof expr === "string")) { return expr._0; } const expr$1 = Curry._2(Parser_env_Try.to_parse, env, try_arrow_function); - if (expr$1) { - return expr$1._0; - } else { + if (/* tag */typeof expr$1 === "number" || typeof expr$1 === "string") { return assignment_but_not_arrow_function(env); + } else { + return expr$1._0; } } @@ -9596,7 +9727,13 @@ function logical_and(env, _left, _lloc) { const lloc = _lloc; const left = _left; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match !== 79) { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + return [ + lloc, + left + ]; + } + if (match !== /* T_AND */79) { return [ lloc, left @@ -9616,7 +9753,13 @@ function logical_or(env, _left, _lloc) { const lloc = _lloc; const left = _left; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match !== 78) { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + return [ + lloc, + left + ]; + } + if (match !== /* T_OR */78) { return [ lloc, left @@ -9641,227 +9784,212 @@ function logical(env) { function binary_op(env) { const match = Curry._2(Parser_env_Peek.token, undefined, env); let ret; - if (typeof match === "number") { - if (match === 16 || match === 15) { - ret = match >= 16 ? [ - /* Instanceof */21, - { - TAG: /* Left_assoc */0, - _0: 6 - } - ] : ( - env.no_in ? undefined : [ + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_IN */15 : + ret = env.no_in ? undefined : [ /* In */20, { TAG: /* Left_assoc */0, _0: 6 } - ] - ); - } else if (match >= 80) { - switch (match) { - case /* T_BIT_OR */80 : - ret = [ - /* BitOr */17, - { - TAG: /* Left_assoc */0, - _0: 2 - } - ]; - break; - case /* T_BIT_XOR */81 : - ret = [ - /* Xor */18, - { - TAG: /* Left_assoc */0, - _0: 3 - } - ]; - break; - case /* T_BIT_AND */82 : - ret = [ - /* BitAnd */19, - { - TAG: /* Left_assoc */0, - _0: 4 - } - ]; - break; - case /* T_EQUAL */83 : - ret = [ - /* Equal */0, - { - TAG: /* Left_assoc */0, - _0: 5 - } - ]; - break; - case /* T_NOT_EQUAL */84 : - ret = [ - /* NotEqual */1, - { - TAG: /* Left_assoc */0, - _0: 5 - } - ]; - break; - case /* T_STRICT_EQUAL */85 : - ret = [ - /* StrictEqual */2, - { - TAG: /* Left_assoc */0, - _0: 5 - } - ]; - break; - case /* T_STRICT_NOT_EQUAL */86 : - ret = [ - /* StrictNotEqual */3, - { - TAG: /* Left_assoc */0, - _0: 5 - } - ]; - break; - case /* T_LESS_THAN_EQUAL */87 : - ret = [ - /* LessThanEqual */5, - { - TAG: /* Left_assoc */0, - _0: 6 - } - ]; - break; - case /* T_GREATER_THAN_EQUAL */88 : - ret = [ - /* GreaterThanEqual */7, - { - TAG: /* Left_assoc */0, - _0: 6 - } - ]; - break; - case /* T_LESS_THAN */89 : - ret = [ - /* LessThan */4, - { - TAG: /* Left_assoc */0, - _0: 6 - } - ]; - break; - case /* T_GREATER_THAN */90 : - ret = [ - /* GreaterThan */6, - { - TAG: /* Left_assoc */0, - _0: 6 - } - ]; - break; - case /* T_LSHIFT */91 : - ret = [ - /* LShift */8, - { - TAG: /* Left_assoc */0, - _0: 7 - } - ]; - break; - case /* T_RSHIFT */92 : - ret = [ - /* RShift */9, - { - TAG: /* Left_assoc */0, - _0: 7 - } - ]; - break; - case /* T_RSHIFT3 */93 : - ret = [ - /* RShift3 */10, - { - TAG: /* Left_assoc */0, - _0: 7 - } - ]; - break; - case /* T_PLUS */94 : - ret = [ - /* Plus */11, - { - TAG: /* Left_assoc */0, - _0: 8 - } - ]; - break; - case /* T_MINUS */95 : - ret = [ - /* Minus */12, - { - TAG: /* Left_assoc */0, - _0: 8 - } ]; - break; - case /* T_DIV */96 : - ret = [ - /* Div */15, - { - TAG: /* Left_assoc */0, - _0: 9 - } - ]; - break; - case /* T_MULT */97 : - ret = [ - /* Mult */13, - { - TAG: /* Left_assoc */0, - _0: 9 - } - ]; - break; - case /* T_EXP */98 : - ret = [ - /* Exp */14, - { - TAG: /* Right_assoc */1, - _0: 10 - } - ]; - break; - case /* T_MOD */99 : - ret = [ - /* Mod */16, - { - TAG: /* Left_assoc */0, - _0: 9 - } - ]; - break; - case /* T_NOT */100 : - case /* T_BIT_NOT */101 : - case /* T_INCR */102 : - case /* T_DECR */103 : - case /* T_ERROR */104 : - case /* T_EOF */105 : - case /* T_JSX_IDENTIFIER */106 : - case /* T_ANY_TYPE */107 : - case /* T_BOOLEAN_TYPE */108 : - case /* T_NUMBER_TYPE */109 : - case /* T_STRING_TYPE */110 : - case /* T_VOID_TYPE */111 : - ret = undefined; - break; - - } - } else { - ret = undefined; - } - } else { - ret = undefined; - } + break; + case /* T_INSTANCEOF */16 : + ret = [ + /* Instanceof */21, + { + TAG: /* Left_assoc */0, + _0: 6 + } + ]; + break; + case /* T_BIT_OR */80 : + ret = [ + /* BitOr */17, + { + TAG: /* Left_assoc */0, + _0: 2 + } + ]; + break; + case /* T_BIT_XOR */81 : + ret = [ + /* Xor */18, + { + TAG: /* Left_assoc */0, + _0: 3 + } + ]; + break; + case /* T_BIT_AND */82 : + ret = [ + /* BitAnd */19, + { + TAG: /* Left_assoc */0, + _0: 4 + } + ]; + break; + case /* T_EQUAL */83 : + ret = [ + /* Equal */0, + { + TAG: /* Left_assoc */0, + _0: 5 + } + ]; + break; + case /* T_NOT_EQUAL */84 : + ret = [ + /* NotEqual */1, + { + TAG: /* Left_assoc */0, + _0: 5 + } + ]; + break; + case /* T_STRICT_EQUAL */85 : + ret = [ + /* StrictEqual */2, + { + TAG: /* Left_assoc */0, + _0: 5 + } + ]; + break; + case /* T_STRICT_NOT_EQUAL */86 : + ret = [ + /* StrictNotEqual */3, + { + TAG: /* Left_assoc */0, + _0: 5 + } + ]; + break; + case /* T_LESS_THAN_EQUAL */87 : + ret = [ + /* LessThanEqual */5, + { + TAG: /* Left_assoc */0, + _0: 6 + } + ]; + break; + case /* T_GREATER_THAN_EQUAL */88 : + ret = [ + /* GreaterThanEqual */7, + { + TAG: /* Left_assoc */0, + _0: 6 + } + ]; + break; + case /* T_LESS_THAN */89 : + ret = [ + /* LessThan */4, + { + TAG: /* Left_assoc */0, + _0: 6 + } + ]; + break; + case /* T_GREATER_THAN */90 : + ret = [ + /* GreaterThan */6, + { + TAG: /* Left_assoc */0, + _0: 6 + } + ]; + break; + case /* T_LSHIFT */91 : + ret = [ + /* LShift */8, + { + TAG: /* Left_assoc */0, + _0: 7 + } + ]; + break; + case /* T_RSHIFT */92 : + ret = [ + /* RShift */9, + { + TAG: /* Left_assoc */0, + _0: 7 + } + ]; + break; + case /* T_RSHIFT3 */93 : + ret = [ + /* RShift3 */10, + { + TAG: /* Left_assoc */0, + _0: 7 + } + ]; + break; + case /* T_PLUS */94 : + ret = [ + /* Plus */11, + { + TAG: /* Left_assoc */0, + _0: 8 + } + ]; + break; + case /* T_MINUS */95 : + ret = [ + /* Minus */12, + { + TAG: /* Left_assoc */0, + _0: 8 + } + ]; + break; + case /* T_DIV */96 : + ret = [ + /* Div */15, + { + TAG: /* Left_assoc */0, + _0: 9 + } + ]; + break; + case /* T_MULT */97 : + ret = [ + /* Mult */13, + { + TAG: /* Left_assoc */0, + _0: 9 + } + ]; + break; + case /* T_EXP */98 : + ret = [ + /* Exp */14, + { + TAG: /* Right_assoc */1, + _0: 10 + } + ]; + break; + case /* T_MOD */99 : + ret = [ + /* Mod */16, + { + TAG: /* Left_assoc */0, + _0: 9 + } + ]; + break; + default: + ret = undefined; + } + } else { + ret = undefined; + } if (ret !== undefined) { token$3(env); } @@ -9933,7 +10061,7 @@ function binary(env) { const right_loc = btwn(start_loc, end_loc); if (Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_LESS_THAN */89)) { let tmp = right[1]; - if (typeof tmp !== "number" && tmp.TAG === /* JSXElement */22) { + if (!/* tag */(typeof tmp === "number" || typeof tmp === "string") && tmp.TAG === /* JSXElement */22) { error$1(env, /* AdjacentJSXElements */46); } @@ -9975,7 +10103,13 @@ function binary(env) { function argument(env) { const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match !== 11) { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + return { + TAG: /* Expression */0, + _0: Curry._1(assignment, env) + }; + } + if (match !== /* T_ELLIPSIS */11) { return { TAG: /* Expression */0, _0: Curry._1(assignment, env) @@ -10000,14 +10134,14 @@ function arguments$p(env, _acc) { while(true) { const acc = _acc; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number") { - if (match === 4) { - return Stdlib__List.rev(acc); - } - if (match === 105) { - return Stdlib__List.rev(acc); + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_RPAREN */4 : + case /* T_EOF */105 : + return Stdlib__List.rev(acc); + default: + } - } const acc_0 = argument(env); const acc$1 = { @@ -10044,11 +10178,11 @@ function template_parts(env, _quasis, _expressions) { tl: expressions }; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match === 2) { + if (/* tag */(typeof match === "number" || typeof match === "string") && match === /* T_RCURLY */2) { push_lex_mode(env, /* TEMPLATE */4); const match$1 = Curry._2(Parser_env_Peek.token, undefined, env); let match$2; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -10173,54 +10307,40 @@ function elements(env, _acc) { while(true) { const acc = _acc; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number") { - if (match === 105) { - return Stdlib__List.rev(acc); - } - if (match < 12) { - switch (match) { - case /* T_RBRACKET */6 : - return Stdlib__List.rev(acc); - case /* T_COMMA */8 : - token$4(env, /* T_COMMA */8); - _acc = { - hd: undefined, - tl: acc - }; - continue ; - case /* T_IDENTIFIER */0 : - case /* T_LCURLY */1 : - case /* T_RCURLY */2 : - case /* T_LPAREN */3 : - case /* T_RPAREN */4 : - case /* T_LBRACKET */5 : - case /* T_SEMICOLON */7 : - case /* T_PERIOD */9 : - case /* T_ARROW */10 : - break; - case /* T_ELLIPSIS */11 : - const start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_ELLIPSIS */11); - const argument = Curry._1(assignment, env); - const loc = btwn(start_loc, argument[0]); - const elem = { - TAG: /* Spread */1, - _0: [ - loc, - { - argument: argument - } - ] - }; - _acc = { - hd: elem, - tl: acc - }; - continue ; + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_COMMA */8 : + token$4(env, /* T_COMMA */8); + _acc = { + hd: undefined, + tl: acc + }; + continue ; + case /* T_ELLIPSIS */11 : + const start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_ELLIPSIS */11); + const argument = Curry._1(assignment, env); + const loc = btwn(start_loc, argument[0]); + const elem = { + TAG: /* Spread */1, + _0: [ + loc, + { + argument: argument + } + ] + }; + _acc = { + hd: elem, + tl: acc + }; + continue ; + case /* T_RBRACKET */6 : + case /* T_EOF */105 : + return Stdlib__List.rev(acc); + default: - } } - } const elem$1 = { TAG: /* Expression */0, @@ -10253,25 +10373,22 @@ function array_initializer(env) { function error_callback$1(param) { return function (param) { - if (typeof param === "number") { - if (param > 44 || param < 28) { - if (param === 47) { - return ; - } - throw new Caml_js_exceptions.MelangeError(Parser_env_Try.Rollback, { - MEL_EXN_ID: Parser_env_Try.Rollback - }); - } - if (param > 43 || param < 29) { - return ; + if (/* tag */typeof param === "number" || typeof param === "string") { + switch (param) { + case /* StrictParamName */28 : + case /* NewlineBeforeArrow */44 : + case /* ParameterAfterRestParameter */47 : + return ; + default: + throw new Caml_js_exceptions.MelangeError(Parser_env_Try.Rollback, { + MEL_EXN_ID: Parser_env_Try.Rollback + }); } + } else { throw new Caml_js_exceptions.MelangeError(Parser_env_Try.Rollback, { MEL_EXN_ID: Parser_env_Try.Rollback }); } - throw new Caml_js_exceptions.MelangeError(Parser_env_Try.Rollback, { - MEL_EXN_ID: Parser_env_Try.Rollback - }); }; } @@ -10324,7 +10441,7 @@ function try_arrow_function(env) { let generator = false; const env = with_in_function(true, param); const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match === 1) { + if (/* tag */(typeof match === "number" || typeof match === "string") && match === /* T_LCURLY */1) { const match$1 = function_body(env, async, generator); return [ match$1[1], @@ -10373,7 +10490,10 @@ function decorator_list_helper(env, _decorators) { while(true) { const decorators = _decorators; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match !== 12) { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + return decorators; + } + if (match !== /* T_AT */12) { return decorators; } token$3(env); @@ -10395,7 +10515,7 @@ function decorator_list(env) { function key(env) { const number_type = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof number_type === "number") { + if (/* tag */typeof number_type === "number" || typeof number_type === "string") { if (number_type === /* T_LBRACKET */5) { const start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); token$4(env, /* T_LBRACKET */5); @@ -10412,7 +10532,7 @@ function key(env) { } } else { - switch (number_type.TAG | 0) { + switch (number_type.TAG) { case /* T_NUMBER */0 : const raw = Curry._2(Parser_env_Peek.value, undefined, env); const loc = Curry._2(Parser_env_Peek.loc, undefined, env); @@ -10487,7 +10607,17 @@ function key(env) { function _method(env, kind) { const generator$1 = generator(env, false); const match = key(env); - const typeParameters = kind ? undefined : Curry._1(type_parameter_declaration$1, env); + let typeParameters; + switch (kind) { + case /* Init */0 : + typeParameters = Curry._1(type_parameter_declaration$1, env); + break; + case /* Get */1 : + case /* Set */2 : + typeParameters = undefined; + break; + + } token$4(env, /* T_LPAREN */3); let params; switch (kind) { @@ -10580,28 +10710,48 @@ function property$1(env) { exit = 1; } else { const key$1 = match$1[1]; - switch (key$1.TAG | 0) { + switch (key$1.TAG) { case /* Identifier */1 : switch (key$1._0[1].name) { case "get" : const match$2 = Curry._2(Parser_env_Peek.token, undefined, env); - tmp = typeof match$2 === "number" ? ( - match$2 > 77 || match$2 < 3 ? ( - match$2 !== 89 ? get(env, start_loc) : init(env, start_loc, key$1, false, false) - ) : ( - match$2 > 76 || match$2 < 4 ? init(env, start_loc, key$1, false, false) : get(env, start_loc) - ) - ) : get(env, start_loc); + let exit$1 = 0; + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string") { + switch (match$2) { + case /* T_LPAREN */3 : + case /* T_COLON */77 : + case /* T_LESS_THAN */89 : + exit$1 = 2; + break; + default: + tmp = get(env, start_loc); + } + } else { + tmp = get(env, start_loc); + } + if (exit$1 === 2) { + tmp = init(env, start_loc, key$1, false, false); + } break; case "set" : const match$3 = Curry._2(Parser_env_Peek.token, undefined, env); - tmp = typeof match$3 === "number" ? ( - match$3 > 77 || match$3 < 3 ? ( - match$3 !== 89 ? set(env, start_loc) : init(env, start_loc, key$1, false, false) - ) : ( - match$3 > 76 || match$3 < 4 ? init(env, start_loc, key$1, false, false) : set(env, start_loc) - ) - ) : set(env, start_loc); + let exit$2 = 0; + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { + switch (match$3) { + case /* T_LPAREN */3 : + case /* T_COLON */77 : + case /* T_LESS_THAN */89 : + exit$2 = 2; + break; + default: + tmp = set(env, start_loc); + } + } else { + tmp = set(env, start_loc); + } + if (exit$2 === 2) { + tmp = init(env, start_loc, key$1, false, false); + } break; default: exit = 1; @@ -10675,32 +10825,18 @@ function init(env, start_loc, key, async, generator) { const match = Curry._2(Parser_env_Peek.token, undefined, env); let match$1; let exit = 0; - if (typeof match === "number") { - if (match !== 89) { - if (match >= 9) { + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_RCURLY */2 : + case /* T_COMMA */8 : + exit = 2; + break; + case /* T_LPAREN */3 : + case /* T_LESS_THAN */89 : + exit = 3; + break; + default: exit = 1; - } else { - switch (match) { - case /* T_LPAREN */3 : - exit = 3; - break; - case /* T_IDENTIFIER */0 : - case /* T_LCURLY */1 : - case /* T_RPAREN */4 : - case /* T_LBRACKET */5 : - case /* T_RBRACKET */6 : - case /* T_SEMICOLON */7 : - exit = 1; - break; - case /* T_RCURLY */2 : - case /* T_COMMA */8 : - exit = 2; - break; - - } - } - } else { - exit = 3; } } else { exit = 1; @@ -10716,7 +10852,7 @@ function init(env, start_loc, key, async, generator) { break; case 2 : let tmp; - switch (key.TAG | 0) { + switch (key.TAG) { case /* Literal */0 : const lit = key._0; tmp = [ @@ -10817,7 +10953,7 @@ function check_property(env, prop_map, prop) { const prop$1 = match[1]; const prop_loc = match[0]; let exit = 0; - switch (prop$1.key.TAG | 0) { + switch (prop$1.key.TAG) { case /* Literal */0 : case /* Identifier */1 : exit = 1; @@ -10829,13 +10965,13 @@ function check_property(env, prop_map, prop) { if (exit === 1) { const match$1 = prop$1.key; let key; - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Literal */0 : const s = match$1._0[1].value; - if (typeof s === "number") { + if (/* tag */typeof s === "number" || typeof s === "string") { key = "null"; } else { - switch (s.TAG | 0) { + switch (s.TAG) { case /* String */0 : key = s._0; break; @@ -10942,14 +11078,14 @@ function properties$1(env, _param) { const param = _param; const acc = param[1]; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number") { - if (match === 2) { - return Stdlib__List.rev(acc); - } - if (match === 105) { - return Stdlib__List.rev(acc); + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_RCURLY */2 : + case /* T_EOF */105 : + return Stdlib__List.rev(acc); + default: + } - } const prop = property$1(env); const prop_map = check_property(env, param[0], prop); @@ -11003,7 +11139,10 @@ function class_implements(env, _acc) { tl: acc }; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match !== 8) { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + return Stdlib__List.rev(acc$1); + } + if (match !== /* T_COMMA */8) { return Stdlib__List.rev(acc$1); } token$4(env, /* T_COMMA */8); @@ -11012,29 +11151,65 @@ function class_implements(env, _acc) { }; } -function init$1(env, start_loc, decorators, key, async, generator, $$static) { - const match = Curry._2(Parser_env_Peek.token, undefined, env); - let exit = 0; - if (typeof match === "number") { - if (match > 77 || match < 75) { - if (match === 7) { - exit = 2; - } - - } else if (match !== 76) { - exit = 2; - } - - } - if (exit === 2 && !async && !generator) { - const typeAnnotation = wrap(annotation_opt, env); - const options = env.parse_options; - const value = Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_ASSIGN */75) && ($$static && options.esproposal_class_static_fields || !$$static && options.esproposal_class_instance_fields) ? (token$4(env, /* T_ASSIGN */75), Curry._1(Parse.expression, env)) : undefined; - const end_loc = Curry._2(Parser_env_Peek.loc, undefined, env); - if (maybe(env, /* T_SEMICOLON */7) || !(Curry._2(Parser_env_Peek.token, undefined, env) === /* T_LBRACKET */5 || Curry._2(Parser_env_Peek.token, undefined, env) === /* T_LPAREN */3)) { - - } else { - error_unexpected(env); +function get$1(env, start_loc, decorators, $$static) { + const match = _method(env, /* Get */1); + const value = match[1]; + return { + TAG: /* Method */0, + _0: [ + btwn(start_loc, value[0]), + { + kind: /* Get */2, + key: match[0], + value: value, + static: $$static, + decorators: decorators + } + ] + }; +} + +function set$1(env, start_loc, decorators, $$static) { + const match = _method(env, /* Set */2); + const value = match[1]; + return { + TAG: /* Method */0, + _0: [ + btwn(start_loc, value[0]), + { + kind: /* Set */3, + key: match[0], + value: value, + static: $$static, + decorators: decorators + } + ] + }; +} + +function init$1(env, start_loc, decorators, key, async, generator, $$static) { + const match = Curry._2(Parser_env_Peek.token, undefined, env); + let exit = 0; + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_SEMICOLON */7 : + case /* T_ASSIGN */75 : + case /* T_COLON */77 : + exit = 2; + break; + default: + + } + } + if (exit === 2 && !async && !generator) { + const typeAnnotation = wrap(annotation_opt, env); + const options = env.parse_options; + const value = Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_ASSIGN */75) && ($$static && options.esproposal_class_static_fields || !$$static && options.esproposal_class_instance_fields) ? (token$4(env, /* T_ASSIGN */75), Curry._1(Parse.expression, env)) : undefined; + const end_loc = Curry._2(Parser_env_Peek.loc, undefined, env); + if (maybe(env, /* T_SEMICOLON */7) || !(Curry._2(Parser_env_Peek.token, undefined, env) === /* T_LBRACKET */5 || Curry._2(Parser_env_Peek.token, undefined, env) === /* T_LPAREN */3)) { + + } else { + error_unexpected(env); } const loc = btwn(start_loc, end_loc); return { @@ -11087,10 +11262,10 @@ function init$1(env, start_loc, decorators, key, async, generator, $$static) { value_1 ]; let kind; - switch (key.TAG | 0) { + switch (key.TAG) { case /* Literal */0 : const match$4 = key._0[1].value; - kind = typeof match$4 === "number" || !(match$4.TAG === /* String */0 && match$4._0 === "constructor") ? /* Method */1 : /* Constructor */0; + kind = /* tag */typeof match$4 === "number" || typeof match$4 === "string" || !(match$4.TAG === /* String */0 && match$4._0 === "constructor") ? /* Method */1 : /* Constructor */0; break; case /* Identifier */1 : kind = key._0[1].name === "constructor" ? /* Constructor */0 : /* Method */1; @@ -11124,79 +11299,49 @@ function class_element(env) { const match = key(env); if (!async && !generator$1) { const key$1 = match[1]; - switch (key$1.TAG | 0) { + switch (key$1.TAG) { case /* Identifier */1 : switch (key$1._0[1].name) { case "get" : const match$1 = Curry._2(Parser_env_Peek.token, undefined, env); let exit = 0; - exit = typeof match$1 === "number" ? ( - match$1 >= 75 ? ( - match$1 >= 78 ? ( - match$1 !== 89 ? 2 : 3 - ) : ( - match$1 !== 76 ? 3 : 2 - ) - ) : ( - match$1 !== 3 && match$1 !== 7 ? 2 : 3 - ) - ) : 2; - switch (exit) { - case 2 : - const match$2 = _method(env, /* Get */1); - const value = match$2[1]; - return { - TAG: /* Method */0, - _0: [ - btwn(start_loc, value[0]), - { - kind: /* Get */2, - key: match$2[0], - value: value, - static: $$static, - decorators: decorators - } - ] - }; - case 3 : - return init$1(env, start_loc, decorators, key$1, async, generator$1, $$static); - + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + return get$1(env, start_loc, decorators, $$static); + } + switch (match$1) { + case /* T_LPAREN */3 : + case /* T_SEMICOLON */7 : + case /* T_ASSIGN */75 : + case /* T_COLON */77 : + case /* T_LESS_THAN */89 : + exit = 2; + break; + default: + return get$1(env, start_loc, decorators, $$static); + } + if (exit === 2) { + return init$1(env, start_loc, decorators, key$1, async, generator$1, $$static); } break; case "set" : - const match$3 = Curry._2(Parser_env_Peek.token, undefined, env); + const match$2 = Curry._2(Parser_env_Peek.token, undefined, env); let exit$1 = 0; - exit$1 = typeof match$3 === "number" ? ( - match$3 >= 75 ? ( - match$3 >= 78 ? ( - match$3 !== 89 ? 2 : 3 - ) : ( - match$3 !== 76 ? 3 : 2 - ) - ) : ( - match$3 !== 3 && match$3 !== 7 ? 2 : 3 - ) - ) : 2; - switch (exit$1) { - case 2 : - const match$4 = _method(env, /* Set */2); - const value$1 = match$4[1]; - return { - TAG: /* Method */0, - _0: [ - btwn(start_loc, value$1[0]), - { - kind: /* Set */3, - key: match$4[0], - value: value$1, - static: $$static, - decorators: decorators - } - ] - }; - case 3 : - return init$1(env, start_loc, decorators, key$1, async, generator$1, $$static); - + if (!/* tag */(typeof match$2 === "number" || typeof match$2 === "string")) { + return set$1(env, start_loc, decorators, $$static); + } + switch (match$2) { + case /* T_LPAREN */3 : + case /* T_SEMICOLON */7 : + case /* T_ASSIGN */75 : + case /* T_COLON */77 : + case /* T_LESS_THAN */89 : + exit$1 = 2; + break; + default: + return set$1(env, start_loc, decorators, $$static); + } + if (exit$1 === 2) { + return init$1(env, start_loc, decorators, key$1, async, generator$1, $$static); } break; default: @@ -11216,23 +11361,28 @@ function elements$1(env, _acc) { while(true) { const acc = _acc; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number") { - if (match > 104 || match < 3) { - if (!(match > 105 || match < 2)) { - return Stdlib__List.rev(acc); - } - - } else if (match === 7) { - token$4(env, /* T_SEMICOLON */7); - continue ; + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_SEMICOLON */7 : + token$4(env, /* T_SEMICOLON */7); + continue ; + case /* T_RCURLY */2 : + case /* T_EOF */105 : + return Stdlib__List.rev(acc); + default: + _acc = { + hd: Curry._1(class_element, env), + tl: acc + }; + continue ; } - + } else { + _acc = { + hd: Curry._1(class_element, env), + tl: acc + }; + continue ; } - _acc = { - hd: Curry._1(class_element, env), - tl: acc - }; - continue ; }; } @@ -11313,23 +11463,18 @@ function class_expression(env) { const match = Curry._2(Parser_env_Peek.token, undefined, env); let match$1; let exit = 0; - if (typeof match === "number") { - if (match > 39 || match < 1) { - if (match !== 89) { + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_LCURLY */1 : + case /* T_EXTENDS */39 : + case /* T_LESS_THAN */89 : + match$1 = [ + undefined, + undefined + ]; + break; + default: exit = 1; - } else { - match$1 = [ - undefined, - undefined - ]; - } - } else if (match > 38 || match < 2) { - match$1 = [ - undefined, - undefined - ]; - } else { - exit = 1; } } else { exit = 1; @@ -11456,28 +11601,142 @@ function declare_export_declaration(allow_export_typeOpt, env) { token$4(env$1, /* T_EXPORT */47); const match = Curry._2(Parser_env_Peek.token, undefined, env$1); let exit = 0; - if (typeof match === "number") { - if (match >= 52) { - if (match !== 59) { - if (match !== 97) { + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_DEFAULT */34 : + token$4(env$1, /* T_DEFAULT */34); + const match$1 = Curry._2(Parser_env_Peek.token, undefined, env$1); + let match$2; + let exit$1 = 0; + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { + switch (match$1) { + case /* T_FUNCTION */13 : + const fn = declare_function(env$1, start_loc); + match$2 = [ + fn[0], + { + TAG: /* Function */1, + _0: fn + } + ]; + break; + case /* T_CLASS */38 : + const _class = Curry._2(declare_class, env$1, start_loc); + match$2 = [ + _class[0], + { + TAG: /* Class */2, + _0: _class + } + ]; + break; + default: + exit$1 = 3; + } + } else { + exit$1 = 3; + } + if (exit$1 === 3) { + const _type$1 = wrap(_type, env$1); + const loc = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env$1); + const end_loc = loc !== undefined ? loc : _type$1[0]; + semicolon(env$1); + match$2 = [ + end_loc, + { + TAG: /* DefaultType */3, + _0: _type$1 + } + ]; + } + return [ + btwn(start_loc, match$2[0]), + { + TAG: /* DeclareExportDeclaration */27, + _0: { + default: true, + declaration: match$2[1], + specifiers: undefined, + source: undefined + } + } + ]; + case /* T_FUNCTION */13 : + case /* T_VAR */22 : + case /* T_CONST */25 : + case /* T_LET */26 : + case /* T_CLASS */38 : + exit = 2; + break; + case /* T_INTERFACE */51 : + if (allow_export_type) { + const match$3 = Curry._1(interface_helper, env$1); + const iface_loc = match$3[0]; + const loc$1 = btwn(start_loc, iface_loc); + return [ + loc$1, + { + TAG: /* DeclareExportDeclaration */27, + _0: { + default: false, + declaration: { + TAG: /* Interface */5, + _0: [ + iface_loc, + match$3[1] + ] + }, + specifiers: undefined, + source: undefined + } + } + ]; + } exit = 1; - } else { - const loc = Curry._2(Parser_env_Peek.loc, undefined, env$1); + break; + case /* T_TYPE */59 : + if (allow_export_type) { + const match$4 = type_alias_helper(env$1); + const alias_loc = match$4[0]; + const loc$2 = btwn(start_loc, alias_loc); + return [ + loc$2, + { + TAG: /* DeclareExportDeclaration */27, + _0: { + default: false, + declaration: { + TAG: /* NamedType */4, + _0: [ + alias_loc, + match$4[1] + ] + }, + specifiers: undefined, + source: undefined + } + } + ]; + } + exit = 1; + break; + case /* T_MULT */97 : + const loc$3 = Curry._2(Parser_env_Peek.loc, undefined, env$1); token$4(env$1, /* T_MULT */97); const parse_export_star_as = env$1.parse_options.esproposal_export_star_as; const local_name = Curry._2(Parser_env_Peek.value, undefined, env$1) === "as" ? (contextual(env$1, "as"), parse_export_star_as ? Curry._2(Parse.identifier, undefined, env$1) : (error$1(env$1, /* UnexpectedTypeDeclaration */7), undefined)) : undefined; const specifiers = { TAG: /* ExportBatchSpecifier */1, - _0: loc, + _0: loc$3, _1: local_name }; const source = export_source(env$1); - const loc$1 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env$1); - const end_loc = loc$1 !== undefined ? loc$1 : source[0]; + const loc$4 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env$1); + const end_loc$1 = loc$4 !== undefined ? loc$4 : source[0]; const source$1 = source; semicolon(env$1); return [ - btwn(start_loc, end_loc), + btwn(start_loc, end_loc$1), { TAG: /* DeclareExportDeclaration */27, _0: { @@ -11488,210 +11747,77 @@ function declare_export_declaration(allow_export_typeOpt, env) { } } ]; + default: + exit = 1; + } + } else { + exit = 1; + } + switch (exit) { + case 1 : + const match$5 = Curry._2(Parser_env_Peek.token, undefined, env$1); + if (/* tag */typeof match$5 === "number" || typeof match$5 === "string") { + switch (match$5) { + case /* T_INTERFACE */51 : + error$1(env$1, /* DeclareExportInterface */53); + break; + case /* T_TYPE */59 : + error$1(env$1, /* DeclareExportType */52); + break; + default: + + } } - } else { - if (allow_export_type) { - const match$1 = type_alias_helper(env$1); - const alias_loc = match$1[0]; - const loc$2 = btwn(start_loc, alias_loc); - return [ - loc$2, + token$4(env$1, /* T_LCURLY */1); + const match$6 = export_specifiers_and_errs(env$1, /* [] */0, /* [] */0); + const specifiers$1 = { + TAG: /* ExportSpecifiers */0, + _0: match$6[0] + }; + const end_loc$2 = Curry._2(Parser_env_Peek.loc, undefined, env$1); + token$4(env$1, /* T_RCURLY */2); + const source$2 = Curry._2(Parser_env_Peek.value, undefined, env$1) === "from" ? export_source(env$1) : (Stdlib__List.iter((function (param) { + return error_at(env$1, param); + }), match$6[1]), undefined); + const loc$5 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env$1); + const end_loc$3 = loc$5 !== undefined ? loc$5 : ( + source$2 !== undefined ? source$2[0] : end_loc$2 + ); + semicolon(env$1); + return [ + btwn(start_loc, end_loc$3), + { + TAG: /* DeclareExportDeclaration */27, + _0: { + default: false, + declaration: undefined, + specifiers: specifiers$1, + source: source$2 + } + } + ]; + case 2 : + const token$5 = Curry._2(Parser_env_Peek.token, undefined, env$1); + let match$7; + let exit$2 = 0; + if (/* tag */typeof token$5 === "number" || typeof token$5 === "string") { + switch (token$5) { + case /* T_FUNCTION */13 : + const fn$1 = declare_function(env$1, start_loc); + match$7 = [ + fn$1[0], { - TAG: /* DeclareExportDeclaration */27, - _0: { - default: false, - declaration: { - TAG: /* NamedType */4, - _0: [ - alias_loc, - match$1[1] - ] - }, - specifiers: undefined, - source: undefined - } + TAG: /* Function */1, + _0: fn$1 } ]; - } - exit = 1; - } - } else if (match >= 39) { - if (match >= 51) { - if (allow_export_type) { - const match$2 = Curry._1(interface_helper, env$1); - const iface_loc = match$2[0]; - const loc$3 = btwn(start_loc, iface_loc); - return [ - loc$3, - { - TAG: /* DeclareExportDeclaration */27, - _0: { - default: false, - declaration: { - TAG: /* Interface */5, - _0: [ - iface_loc, - match$2[1] - ] - }, - specifiers: undefined, - source: undefined - } - } - ]; - } - exit = 1; - } else { - exit = 1; - } - } else if (match >= 13) { - switch (match) { - case /* T_DEFAULT */34 : - token$4(env$1, /* T_DEFAULT */34); - const match$3 = Curry._2(Parser_env_Peek.token, undefined, env$1); - let match$4; - let exit$1 = 0; - if (typeof match$3 === "number") { - if (match$3 !== 13) { - if (match$3 !== 38) { - exit$1 = 3; - } else { - const _class = Curry._2(declare_class, env$1, start_loc); - match$4 = [ - _class[0], - { - TAG: /* Class */2, - _0: _class - } - ]; - } - } else { - const fn = declare_function(env$1, start_loc); - match$4 = [ - fn[0], - { - TAG: /* Function */1, - _0: fn - } - ]; - } - } else { - exit$1 = 3; - } - if (exit$1 === 3) { - const _type$1 = wrap(_type, env$1); - const loc$4 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env$1); - const end_loc$1 = loc$4 !== undefined ? loc$4 : _type$1[0]; - semicolon(env$1); - match$4 = [ - end_loc$1, - { - TAG: /* DefaultType */3, - _0: _type$1 - } - ]; - } - return [ - btwn(start_loc, match$4[0]), - { - TAG: /* DeclareExportDeclaration */27, - _0: { - default: true, - declaration: match$4[1], - specifiers: undefined, - source: undefined - } - } - ]; - case /* T_IF */14 : - case /* T_IN */15 : - case /* T_INSTANCEOF */16 : - case /* T_RETURN */17 : - case /* T_SWITCH */18 : - case /* T_THIS */19 : - case /* T_THROW */20 : - case /* T_TRY */21 : - case /* T_WHILE */23 : - case /* T_WITH */24 : - case /* T_NULL */27 : - case /* T_FALSE */28 : - case /* T_TRUE */29 : - case /* T_BREAK */30 : - case /* T_CASE */31 : - case /* T_CATCH */32 : - case /* T_CONTINUE */33 : - case /* T_DO */35 : - case /* T_FINALLY */36 : - case /* T_FOR */37 : - exit = 1; - break; - case /* T_FUNCTION */13 : - case /* T_VAR */22 : - case /* T_CONST */25 : - case /* T_LET */26 : - case /* T_CLASS */38 : - exit = 2; - break; - - } - } else { - exit = 1; - } - } else { - exit = 1; - } - switch (exit) { - case 1 : - const match$5 = Curry._2(Parser_env_Peek.token, undefined, env$1); - if (typeof match$5 === "number") { - if (match$5 !== 51) { - if (match$5 !== 59) { - - } else { - error$1(env$1, /* DeclareExportType */52); - } - } else { - error$1(env$1, /* DeclareExportInterface */53); - } - } - token$4(env$1, /* T_LCURLY */1); - const match$6 = export_specifiers_and_errs(env$1, /* [] */0, /* [] */0); - const specifiers$1 = { - TAG: /* ExportSpecifiers */0, - _0: match$6[0] - }; - const end_loc$2 = Curry._2(Parser_env_Peek.loc, undefined, env$1); - token$4(env$1, /* T_RCURLY */2); - const source$2 = Curry._2(Parser_env_Peek.value, undefined, env$1) === "from" ? export_source(env$1) : (Stdlib__List.iter((function (param) { - return error_at(env$1, param); - }), match$6[1]), undefined); - const loc$5 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env$1); - const end_loc$3 = loc$5 !== undefined ? loc$5 : ( - source$2 !== undefined ? source$2[0] : end_loc$2 - ); - semicolon(env$1); - return [ - btwn(start_loc, end_loc$3), - { - TAG: /* DeclareExportDeclaration */27, - _0: { - default: false, - declaration: undefined, - specifiers: specifiers$1, - source: source$2 - } - } - ]; - case 2 : - const token$5 = Curry._2(Parser_env_Peek.token, undefined, env$1); - let match$7; - let exit$2 = 0; - if (typeof token$5 === "number") { - if (token$5 >= 23) { - if (token$5 >= 27) { - if (token$5 !== 38) { + break; + case /* T_VAR */22 : + case /* T_CONST */25 : + case /* T_LET */26 : exit$2 = 3; - } else { + break; + case /* T_CLASS */38 : const _class$1 = Curry._2(declare_class, env$1, start_loc); match$7 = [ _class$1[0], @@ -11700,27 +11826,8 @@ function declare_export_declaration(allow_export_typeOpt, env) { _0: _class$1 } ]; - } - } else { - exit$2 = token$5 >= 25 ? 4 : 3; - } - } else if (token$5 !== 13) { - exit$2 = token$5 >= 22 ? 4 : 3; - } else { - const fn$1 = declare_function(env$1, start_loc); - match$7 = [ - fn$1[0], - { - TAG: /* Function */1, - _0: fn$1 - } - ]; - } - } else { - exit$2 = 3; - } - switch (exit$2) { - case 3 : + break; + default: throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -11729,28 +11836,38 @@ function declare_export_declaration(allow_export_typeOpt, env) { 17 ] }); - case 4 : - if (typeof token$5 === "number") { - if (token$5 !== 25) { - if (token$5 !== 26) { - - } else { - error$1(env$1, /* DeclareExportLet */50); - } - } else { + } + } else { + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "parser_flow.ml", + 3480, + 17 + ] + }); + } + if (exit$2 === 3) { + if (/* tag */typeof token$5 === "number" || typeof token$5 === "string") { + switch (token$5) { + case /* T_CONST */25 : error$1(env$1, /* DeclareExportConst */51); - } - } - const $$var = declare_var(env$1, start_loc); - match$7 = [ - $$var[0], - { - TAG: /* Variable */0, - _0: $$var - } - ]; - break; - + break; + case /* T_LET */26 : + error$1(env$1, /* DeclareExportLet */50); + break; + default: + + } + } + const $$var = declare_var(env$1, start_loc); + match$7 = [ + $$var[0], + { + TAG: /* Variable */0, + _0: $$var + } + ]; } return [ btwn(start_loc, match$7[0]), @@ -11825,162 +11942,135 @@ function declare(in_moduleOpt, env) { } const start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); const match = Curry._2(Parser_env_Peek.token, 1, env); - if (typeof match === "number") { - if (match >= 22) { - if (match >= 38) { - if (match < 62) { - switch (match) { - case /* T_CLASS */38 : - token$4(env, /* T_DECLARE */58); - const match$1 = Curry._2(declare_class, env, start_loc); - return [ - match$1[0], - { - TAG: /* DeclareClass */24, - _0: match$1[1] - } - ]; - case /* T_EXPORT */47 : - if (in_module) { - return declare_export_declaration(in_module, env); + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_IDENTIFIER */0 : + if (Curry._2(Parser_env_Peek.value, 1, env) === "module") { + token$4(env, /* T_DECLARE */58); + contextual(env, "module"); + if (in_module || Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_PERIOD */9)) { + token$4(env, /* T_PERIOD */9); + contextual(env, "exports"); + const type_annot = wrap(annotation, env); + const loc = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); + const end_loc = loc !== undefined ? loc : type_annot[0]; + semicolon(env); + const loc$1 = btwn(start_loc, end_loc); + return [ + loc$1, + { + TAG: /* DeclareModuleExports */26, + _0: type_annot + } + ]; + } else { + const match$1 = Curry._2(Parser_env_Peek.token, undefined, env); + let id; + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* T_STRING */1) { + id = { + TAG: /* Identifier */0, + _0: Curry._2(Parse.identifier, undefined, env) + }; + } else { + const match$2 = match$1._0; + const octal = match$2[3]; + const raw = match$2[2]; + const value = match$2[1]; + const loc$2 = match$2[0]; + if (octal) { + strict_error(env, /* StrictOctalLiteral */31); } - break; - case /* T_INTERFACE */51 : - token$4(env, /* T_DECLARE */58); - return $$interface(env); - case /* T_TYPE */59 : - token$4(env, /* T_DECLARE */58); - return type_alias(env); - case /* T_EXTENDS */39 : - case /* T_STATIC */40 : - case /* T_ELSE */41 : - case /* T_NEW */42 : - case /* T_DELETE */43 : - case /* T_TYPEOF */44 : - case /* T_VOID */45 : - case /* T_ENUM */46 : - case /* T_IMPORT */48 : - case /* T_SUPER */49 : - case /* T_IMPLEMENTS */50 : - case /* T_PACKAGE */52 : - case /* T_PRIVATE */53 : - case /* T_PROTECTED */54 : - case /* T_PUBLIC */55 : - case /* T_YIELD */56 : - case /* T_DEBUGGER */57 : - case /* T_DECLARE */58 : - case /* T_OF */60 : - break; - case /* T_ASYNC */61 : - token$4(env, /* T_DECLARE */58); - error$1(env, /* DeclareAsync */49); - token$4(env, /* T_ASYNC */61); - return declare_function_statement(env, start_loc); - + token$4(env, { + TAG: /* T_STRING */1, + _0: [ + loc$2, + value, + raw, + octal + ] + }); + const value$1 = { + TAG: /* String */0, + _0: value + }; + id = { + TAG: /* Literal */1, + _0: [ + loc$2, + { + value: value$1, + raw: raw + } + ] + }; + } + const body_start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_LCURLY */1); + const match$3 = module_items(env, undefined, /* [] */0); + const module_kind = match$3[0]; + token$4(env, /* T_RCURLY */2); + const body_end_loc = Curry._2(Parser_env_Peek.loc, undefined, env); + const body_loc = btwn(body_start_loc, body_end_loc); + const body_1 = { + body: match$3[1] + }; + const body = [ + body_loc, + body_1 + ]; + const loc$3 = btwn(start_loc, body_loc); + const kind = module_kind !== undefined ? module_kind : ({ + TAG: /* CommonJS */0, + _0: loc$3 + }); + return [ + loc$3, + { + TAG: /* DeclareModule */25, + _0: { + id: id, + body: body, + kind: kind + } + } + ]; + } } - } - - } else if (match < 23) { - token$4(env, /* T_DECLARE */58); - return declare_var_statement(env, start_loc); - } - - } else if (match !== 13) { - if (!match && Curry._2(Parser_env_Peek.value, 1, env) === "module") { - token$4(env, /* T_DECLARE */58); - contextual(env, "module"); - if (in_module || Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_PERIOD */9)) { - token$4(env, /* T_PERIOD */9); - contextual(env, "exports"); - const type_annot = wrap(annotation, env); - const loc = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); - const end_loc = loc !== undefined ? loc : type_annot[0]; - semicolon(env); - const loc$1 = btwn(start_loc, end_loc); + break; + case /* T_FUNCTION */13 : + token$4(env, /* T_DECLARE */58); + return declare_function_statement(env, start_loc); + case /* T_VAR */22 : + token$4(env, /* T_DECLARE */58); + return declare_var_statement(env, start_loc); + case /* T_CLASS */38 : + token$4(env, /* T_DECLARE */58); + const match$4 = Curry._2(declare_class, env, start_loc); return [ - loc$1, + match$4[0], { - TAG: /* DeclareModuleExports */26, - _0: type_annot + TAG: /* DeclareClass */24, + _0: match$4[1] } ]; - } else { - const match$2 = Curry._2(Parser_env_Peek.token, undefined, env); - let id; - if (typeof match$2 === "number" || match$2.TAG !== /* T_STRING */1) { - id = { - TAG: /* Identifier */0, - _0: Curry._2(Parse.identifier, undefined, env) - }; - } else { - const match$3 = match$2._0; - const octal = match$3[3]; - const raw = match$3[2]; - const value = match$3[1]; - const loc$2 = match$3[0]; - if (octal) { - strict_error(env, /* StrictOctalLiteral */31); - } - token$4(env, { - TAG: /* T_STRING */1, - _0: [ - loc$2, - value, - raw, - octal - ] - }); - const value$1 = { - TAG: /* String */0, - _0: value - }; - id = { - TAG: /* Literal */1, - _0: [ - loc$2, - { - value: value$1, - raw: raw - } - ] - }; + case /* T_EXPORT */47 : + if (in_module) { + return declare_export_declaration(in_module, env); } - const body_start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_LCURLY */1); - const match$4 = module_items(env, undefined, /* [] */0); - const module_kind = match$4[0]; - token$4(env, /* T_RCURLY */2); - const body_end_loc = Curry._2(Parser_env_Peek.loc, undefined, env); - const body_loc = btwn(body_start_loc, body_end_loc); - const body_1 = { - body: match$4[1] - }; - const body = [ - body_loc, - body_1 - ]; - const loc$3 = btwn(start_loc, body_loc); - const kind = module_kind !== undefined ? module_kind : ({ - TAG: /* CommonJS */0, - _0: loc$3 - }); - return [ - loc$3, - { - TAG: /* DeclareModule */25, - _0: { - id: id, - body: body, - kind: kind - } - } - ]; - } - } - - } else { - token$4(env, /* T_DECLARE */58); - return declare_function_statement(env, start_loc); + break; + case /* T_INTERFACE */51 : + token$4(env, /* T_DECLARE */58); + return $$interface(env); + case /* T_TYPE */59 : + token$4(env, /* T_DECLARE */58); + return type_alias(env); + case /* T_ASYNC */61 : + token$4(env, /* T_DECLARE */58); + error$1(env, /* DeclareAsync */49); + token$4(env, /* T_ASYNC */61); + return declare_function_statement(env, start_loc); + default: + } } if (in_module) { @@ -11994,7 +12084,7 @@ function declare(in_moduleOpt, env) { function export_source(env) { contextual(env, "from"); const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match !== "number" && match.TAG === /* T_STRING */1) { + if (!/* tag */(typeof match === "number" || typeof match === "string") && match.TAG === /* T_STRING */1) { const match$1 = match._0; const octal = match$1[3]; const raw = match$1[2]; @@ -12072,20 +12162,17 @@ function export_specifiers_and_errs(env, _specifiers, _errs) { const errs = _errs; const specifiers = _specifiers; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number") { - if (match === 2) { - return [ - Stdlib__List.rev(specifiers), - Stdlib__List.rev(errs) - ]; - } - if (match === 105) { - return [ - Stdlib__List.rev(specifiers), - Stdlib__List.rev(errs) - ]; + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_RCURLY */2 : + case /* T_EOF */105 : + return [ + Stdlib__List.rev(specifiers), + Stdlib__List.rev(errs) + ]; + default: + } - } const match$1 = Curry._1(Parse.identifier_or_reserved_keyword, env); const id = match$1[0]; @@ -12154,7 +12241,10 @@ function supers(env, _acc) { tl: acc }; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match !== 8) { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + return Stdlib__List.rev(acc$1); + } + if (match !== /* T_COMMA */8) { return Stdlib__List.rev(acc$1); } token$4(env, /* T_COMMA */8); @@ -12193,7 +12283,10 @@ function supers$1(env, _acc) { tl: acc }; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match !== 8) { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + return Stdlib__List.rev(acc$1); + } + if (match !== /* T_COMMA */8) { return Stdlib__List.rev(acc$1); } token$4(env, /* T_COMMA */8); @@ -12230,20 +12323,17 @@ function module_items(env, _module_kind, _acc) { const acc = _acc; const module_kind = _module_kind; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number") { - if (match === 2) { - return [ - module_kind, - Stdlib__List.rev(acc) - ]; - } - if (match === 105) { - return [ - module_kind, - Stdlib__List.rev(acc) - ]; + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_RCURLY */2 : + case /* T_EOF */105 : + return [ + module_kind, + Stdlib__List.rev(acc) + ]; + default: + } - } const stmt = declare(true, env); const stmt$1 = stmt[1]; @@ -12251,10 +12341,10 @@ function module_items(env, _module_kind, _acc) { let module_kind$1; if (module_kind !== undefined) { if (module_kind.TAG === /* CommonJS */0) { - if (typeof stmt$1 === "number") { + if (/* tag */typeof stmt$1 === "number" || typeof stmt$1 === "string") { module_kind$1 = module_kind; } else { - switch (stmt$1.TAG | 0) { + switch (stmt$1.TAG) { case /* DeclareModuleExports */26 : error$1(env, /* DuplicateDeclareModuleExports */60); module_kind$1 = module_kind; @@ -12262,7 +12352,7 @@ function module_items(env, _module_kind, _acc) { case /* DeclareExportDeclaration */27 : const declaration = stmt$1._0.declaration; if (declaration !== undefined) { - switch (declaration.TAG | 0) { + switch (declaration.TAG) { case /* NamedType */4 : case /* Interface */5 : break; @@ -12278,16 +12368,16 @@ function module_items(env, _module_kind, _acc) { module_kind$1 = module_kind; } } - } else if (typeof stmt$1 === "number" || stmt$1.TAG !== /* DeclareModuleExports */26) { + } else if (/* tag */typeof stmt$1 === "number" || typeof stmt$1 === "string" || stmt$1.TAG !== /* DeclareModuleExports */26) { module_kind$1 = module_kind; } else { error$1(env, /* AmbiguousDeclareModuleKind */61); module_kind$1 = module_kind; } - } else if (typeof stmt$1 === "number") { + } else if (/* tag */typeof stmt$1 === "number" || typeof stmt$1 === "string") { module_kind$1 = module_kind; } else { - switch (stmt$1.TAG | 0) { + switch (stmt$1.TAG) { case /* DeclareModuleExports */26 : module_kind$1 = { TAG: /* CommonJS */0, @@ -12297,7 +12387,7 @@ function module_items(env, _module_kind, _acc) { case /* DeclareExportDeclaration */27 : const declaration$1 = stmt$1._0.declaration; if (declaration$1 !== undefined) { - switch (declaration$1.TAG | 0) { + switch (declaration$1.TAG) { case /* NamedType */4 : case /* Interface */5 : module_kind$1 = module_kind; @@ -12331,7 +12421,7 @@ function module_items(env, _module_kind, _acc) { function fold(acc) { return function (param) { const match = param[1]; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Object */0 : return Stdlib__List.fold_left((function (acc, prop) { if (prop.TAG === /* Property */0) { @@ -12433,31 +12523,43 @@ function case_list(env, _param) { const acc = param[1]; const seen_default = param[0]; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number") { - if (match === 2) { - return Stdlib__List.rev(acc); - } - if (match === 105) { - return Stdlib__List.rev(acc); + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_RCURLY */2 : + case /* T_EOF */105 : + return Stdlib__List.rev(acc); + default: + } - } const start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); const match$1 = Curry._2(Parser_env_Peek.token, undefined, env); - const test = match$1 === 34 ? (seen_default ? error$1(env, /* MultipleDefaultsInSwitch */19) : undefined, token$4(env, /* T_DEFAULT */34), undefined) : (token$4(env, /* T_CASE */31), Curry._1(Parse.expression, env)); + let test; + if (/* tag */(typeof match$1 === "number" || typeof match$1 === "string") && match$1 === /* T_DEFAULT */34) { + if (seen_default) { + error$1(env, /* MultipleDefaultsInSwitch */19); + } + token$4(env, /* T_DEFAULT */34); + test = undefined; + } else { + token$4(env, /* T_CASE */31); + test = Curry._1(Parse.expression, env); + } const seen_default$1 = seen_default || test === undefined; const end_loc = Curry._2(Parser_env_Peek.loc, undefined, env); token$4(env, /* T_COLON */77); const term_fn = function (param) { - if (typeof param === "number") { - if (param > 31 || param < 2) { - return param === 34; - } else { - return param > 30 || param < 3; - } - } else { + if (!/* tag */(typeof param === "number" || typeof param === "string")) { return false; } + switch (param) { + case /* T_RCURLY */2 : + case /* T_CASE */31 : + case /* T_DEFAULT */34 : + return true; + default: + return false; + } }; const consequent = Curry._2(Parse.statement_list, term_fn, with_in_switch(true, env)); const match$2 = Stdlib__List.rev(consequent); @@ -12500,7 +12602,7 @@ function var_or_const(env) { function source(env) { contextual(env, "from"); const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match !== "number" && match.TAG === /* T_STRING */1) { + if (!/* tag */(typeof match === "number" || typeof match === "string") && match.TAG === /* T_STRING */1) { const match$1 = match._0; const octal = match$1[3]; const raw = match$1[2]; @@ -12552,14 +12654,14 @@ function specifier_list(env, _acc) { while(true) { const acc = _acc; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number") { - if (match === 2) { - return Stdlib__List.rev(acc); - } - if (match === 105) { - return Stdlib__List.rev(acc); + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_RCURLY */2 : + case /* T_EOF */105 : + return Stdlib__List.rev(acc); + default: + } - } const match$1 = Curry._1(Parse.identifier_or_reserved_keyword, env); const err = match$1[1]; @@ -12601,7 +12703,7 @@ function specifier_list(env, _acc) { function named_or_namespace_specifier(env) { const start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match === 97) { + if (/* tag */(typeof match === "number" || typeof match === "string") && match === /* T_MULT */97) { token$4(env, /* T_MULT */97); contextual(env, "as"); const id = Curry._2(Parse.identifier, undefined, env); @@ -12654,8 +12756,8 @@ function element(env) { function from_expr(env, param) { const expr = param[1]; const loc = param[0]; - if (typeof expr !== "number") { - switch (expr.TAG | 0) { + if (!/* tag */(typeof expr === "number" || typeof expr === "string")) { + switch (expr.TAG) { case /* Array */0 : let param$1 = [ loc, @@ -12683,7 +12785,7 @@ function from_expr(env, param) { const match$1 = match[1]; const key = match$1.key; let key$1; - switch (key.TAG | 0) { + switch (key.TAG) { case /* Literal */0 : key$1 = { TAG: /* Literal */0, @@ -12741,7 +12843,7 @@ function from_expr(env, param) { ]; case /* Assignment */7 : const match = expr._0; - if (!match.operator) { + if (match.operator === /* Assign */0) { return [ loc, { @@ -12797,7 +12899,7 @@ function _object$2(restricted_error) { const match = Curry._1(Parse.object_key, env); const lit = match[1]; let key; - switch (lit.TAG | 0) { + switch (lit.TAG) { case /* Literal */0 : key = { TAG: /* Literal */0, @@ -12820,14 +12922,18 @@ function _object$2(restricted_error) { } const match$1 = Curry._2(Parser_env_Peek.token, undefined, env); let prop; - if (match$1 === 77) { + let exit = 0; + if (/* tag */(typeof match$1 === "number" || typeof match$1 === "string") && match$1 === /* T_COLON */77) { token$4(env, /* T_COLON */77); prop = [ pattern$1(env, restricted_error), false ]; } else { - switch (key.TAG | 0) { + exit = 1; + } + if (exit === 1) { + switch (key.TAG) { case /* Identifier */1 : const id = key._0; const pattern_0 = id[0]; @@ -12858,7 +12964,7 @@ function _object$2(restricted_error) { const pattern$3 = prop[0]; const match$2 = Curry._2(Parser_env_Peek.token, undefined, env); let pattern$4; - if (match$2 === 75) { + if (/* tag */(typeof match$2 === "number" || typeof match$2 === "string") && match$2 === /* T_ASSIGN */75) { token$4(env, /* T_ASSIGN */75); const $$default = Curry._1(Parse.assignment, env); const loc$1 = btwn(pattern$3[0], $$default[0]); @@ -12892,14 +12998,14 @@ function _object$2(restricted_error) { while(true) { const acc = _acc; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number") { - if (match === 2) { - return Stdlib__List.rev(acc); - } - if (match === 105) { - return Stdlib__List.rev(acc); + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_RCURLY */2 : + case /* T_EOF */105 : + return Stdlib__List.rev(acc); + default: + } - } const prop = property(env); if (prop !== undefined) { @@ -12952,59 +13058,45 @@ function _array(restricted_error) { while(true) { const acc = _acc; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number") { - if (match === 105) { - return Stdlib__List.rev(acc); - } - if (match < 12) { - switch (match) { - case /* T_RBRACKET */6 : - return Stdlib__List.rev(acc); - case /* T_COMMA */8 : - token$4(env, /* T_COMMA */8); - _acc = { - hd: undefined, - tl: acc - }; - continue ; - case /* T_IDENTIFIER */0 : - case /* T_LCURLY */1 : - case /* T_RCURLY */2 : - case /* T_LPAREN */3 : - case /* T_RPAREN */4 : - case /* T_LBRACKET */5 : - case /* T_SEMICOLON */7 : - case /* T_PERIOD */9 : - case /* T_ARROW */10 : - break; - case /* T_ELLIPSIS */11 : - const start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_ELLIPSIS */11); - const argument = pattern$1(env, restricted_error); - const loc = btwn(start_loc, argument[0]); - const element = { - TAG: /* Spread */1, - _0: [ - loc, - { - argument: argument - } - ] - }; - _acc = { - hd: element, - tl: acc - }; - continue ; + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_COMMA */8 : + token$4(env, /* T_COMMA */8); + _acc = { + hd: undefined, + tl: acc + }; + continue ; + case /* T_ELLIPSIS */11 : + const start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_ELLIPSIS */11); + const argument = pattern$1(env, restricted_error); + const loc = btwn(start_loc, argument[0]); + const element = { + TAG: /* Spread */1, + _0: [ + loc, + { + argument: argument + } + ] + }; + _acc = { + hd: element, + tl: acc + }; + continue ; + case /* T_RBRACKET */6 : + case /* T_EOF */105 : + return Stdlib__List.rev(acc); + default: - } } - } const pattern$2 = pattern$1(env, restricted_error); const match$1 = Curry._2(Parser_env_Peek.token, undefined, env); let pattern$3; - if (match$1 === 75) { + if (/* tag */(typeof match$1 === "number" || typeof match$1 === "string") && match$1 === /* T_ASSIGN */75) { token$4(env, /* T_ASSIGN */75); const $$default = Curry._1(Parse.expression, env); const loc$1 = btwn(pattern$2[0], $$default[0]); @@ -13069,14 +13161,15 @@ function _array(restricted_error) { function pattern$1(env, restricted_error) { const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number") { - if (match === 1) { - return _object$2(restricted_error)(env); - } - if (match === 5) { - return _array(restricted_error)(env); + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_LCURLY */1 : + return _object$2(restricted_error)(env); + case /* T_LBRACKET */5 : + return _array(restricted_error)(env); + default: + } - } const id = Curry._2(Parse.identifier_with_type, env, restricted_error); return [ @@ -13149,7 +13242,10 @@ function member_expression(env, _member) { while(true) { const member = _member; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match !== 9) { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + return member; + } + if (match !== /* T_PERIOD */9) { return member; } const _object = { @@ -13175,52 +13271,53 @@ function member_expression(env, _member) { function name(env) { const name$1 = identifier$1(env); const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match !== "number") { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { return { TAG: /* Identifier */0, _0: name$1 }; } - if (match !== 9) { - if (match !== 77) { + switch (match) { + case /* T_PERIOD */9 : + const _object = { + TAG: /* Identifier */0, + _0: name$1 + }; + token$4(env, /* T_PERIOD */9); + const property = identifier$1(env); + const loc = btwn(name$1[0], property[0]); + const member_1 = { + _object: _object, + property: property + }; + const member = [ + loc, + member_1 + ]; + return { + TAG: /* MemberExpression */2, + _0: member_expression(env, member) + }; + case /* T_COLON */77 : + token$4(env, /* T_COLON */77); + const name$2 = identifier$1(env); + const loc$1 = btwn(name$1[0], name$2[0]); + return { + TAG: /* NamespacedName */1, + _0: [ + loc$1, + { + namespace: name$1, + name: name$2 + } + ] + }; + default: return { TAG: /* Identifier */0, _0: name$1 }; - } - token$4(env, /* T_COLON */77); - const name$2 = identifier$1(env); - const loc = btwn(name$1[0], name$2[0]); - return { - TAG: /* NamespacedName */1, - _0: [ - loc, - { - namespace: name$1, - name: name$2 - } - ] - }; } - const _object = { - TAG: /* Identifier */0, - _0: name$1 - }; - token$4(env, /* T_PERIOD */9); - const property = identifier$1(env); - const loc$1 = btwn(name$1[0], property[0]); - const member_1 = { - _object: _object, - property: property - }; - const member = [ - loc$1, - member_1 - ]; - return { - TAG: /* MemberExpression */2, - _0: member_expression(env, member) - }; } function attribute(env) { @@ -13258,7 +13355,7 @@ function attribute(env) { token$4(env, /* T_ASSIGN */75); const token$5 = Curry._2(Parser_env_Peek.token, undefined, env); let exit = 0; - if (typeof token$5 === "number") { + if (/* tag */typeof token$5 === "number" || typeof token$5 === "string") { if (token$5 === /* T_LCURLY */1) { const match$2 = expression_container(env); const expression_container$1 = match$2[1]; @@ -13338,30 +13435,24 @@ function attributes(env, _acc) { while(true) { const acc = _acc; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number") { - if (match >= 91) { - if (match === 96) { - return Stdlib__List.rev(acc); - } - if (match === 105) { - return Stdlib__List.rev(acc); - } - - } else if (match !== 1) { - if (match >= 90) { - return Stdlib__List.rev(acc); - } - - } else { - const attribute$1 = { - TAG: /* SpreadAttribute */1, - _0: spread_attribute(env) - }; - _acc = { - hd: attribute$1, - tl: acc - }; - continue ; + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_LCURLY */1 : + const attribute$1 = { + TAG: /* SpreadAttribute */1, + _0: spread_attribute(env) + }; + _acc = { + hd: attribute$1, + tl: acc + }; + continue ; + case /* T_GREATER_THAN */90 : + case /* T_DIV */96 : + case /* T_EOF */105 : + return Stdlib__List.rev(acc); + default: + } } const attribute$2 = { @@ -13412,7 +13503,7 @@ function closing_element_without_lt(env, start_loc) { function child(env) { const token$5 = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof token$5 === "number") { + if (/* tag */typeof token$5 === "number" || typeof token$5 === "string") { if (token$5 === /* T_LCURLY */1) { const expression_container$1 = expression_container(env); return [ @@ -13460,71 +13551,81 @@ function element_or_closing(env) { const start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); token$4(env, /* T_LESS_THAN */89); const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number" && !(match !== 96 && match !== 105)) { - return { - TAG: /* Closing */0, - _0: closing_element_without_lt(env, start_loc) - }; - } else { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { return { TAG: /* ChildElement */1, _0: Curry._2(element_without_lt, env, start_loc) }; } + switch (match) { + case /* T_DIV */96 : + case /* T_EOF */105 : + return { + TAG: /* Closing */0, + _0: closing_element_without_lt(env, start_loc) + }; + default: + return { + TAG: /* ChildElement */1, + _0: Curry._2(element_without_lt, env, start_loc) + }; + } } function children_and_closing(env, _acc) { while(true) { const acc = _acc; const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number") { - if (match !== 89) { - if (match !== 105) { + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_LESS_THAN */89 : + const closingElement = element_or_closing(env); + if (closingElement.TAG === /* Closing */0) { + return [ + Stdlib__List.rev(acc), + closingElement._0 + ]; + } + const element = closingElement._0; + const element_0 = element[0]; + const element_1 = { + TAG: /* Element */0, + _0: element[1] + }; + const element$1 = [ + element_0, + element_1 + ]; + _acc = { + hd: element$1, + tl: acc + }; + continue ; + case /* T_EOF */105 : + error_unexpected(env); + return [ + Stdlib__List.rev(acc), + undefined + ]; + default: _acc = { hd: child(env), tl: acc }; continue ; - } - error_unexpected(env); - return [ - Stdlib__List.rev(acc), - undefined - ]; } - const closingElement = element_or_closing(env); - if (closingElement.TAG === /* Closing */0) { - return [ - Stdlib__List.rev(acc), - closingElement._0 - ]; - } - const element = closingElement._0; - const element_0 = element[0]; - const element_1 = { - TAG: /* Element */0, - _0: element[1] - }; - const element$1 = [ - element_0, - element_1 - ]; + } else { _acc = { - hd: element$1, + hd: child(env), tl: acc }; continue ; } - _acc = { - hd: child(env), - tl: acc - }; - continue ; }; } function normalize(name) { - switch (name.TAG | 0) { + switch (name.TAG) { case /* Identifier */0 : return name._0[1].name; case /* NamespacedName */1 : @@ -13577,410 +13678,364 @@ function statement(env) { while(true) { const match = Curry._2(Parser_env_Peek.token, undefined, env); let exit = 0; - if (typeof match === "number") { - if (match !== 105) { - if (match >= 58) { - exit = 2; - } else { - switch (match) { - case /* T_LCURLY */1 : - const match$1 = Curry._1(Parse.block_body, env); - return [ - match$1[0], - { - TAG: /* Block */0, - _0: match$1[1] - } - ]; - case /* T_SEMICOLON */7 : - const loc = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_SEMICOLON */7); - return [ - loc, - /* Empty */0 - ]; - case /* T_IF */14 : - return _if(env); - case /* T_RETURN */17 : - if (!env.in_function) { - error$1(env, /* IllegalReturn */23); - } - const start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_RETURN */17); - const argument = Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_SEMICOLON */7) || Curry._1(Parser_env_Peek.is_implicit_semicolon, env) ? undefined : Curry._1(Parse.expression, env); - const loc$1 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); - const end_loc = loc$1 !== undefined ? loc$1 : ( - argument !== undefined ? argument[0] : start_loc - ); - semicolon(env); - return [ - btwn(start_loc, end_loc), - { - TAG: /* Return */9, - _0: { - argument: argument - } - } - ]; - case /* T_SWITCH */18 : - const start_loc$1 = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_SWITCH */18); - token$4(env, /* T_LPAREN */3); - const discriminant = Curry._1(Parse.expression, env); - token$4(env, /* T_RPAREN */4); - token$4(env, /* T_LCURLY */1); - const cases = case_list(env, [ - false, - /* [] */0 - ]); - const end_loc$1 = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_RCURLY */2); - return [ - btwn(start_loc$1, end_loc$1), - { - TAG: /* Switch */8, - _0: { - discriminant: discriminant, - cases: cases, - lexical: false - } - } - ]; - case /* T_THROW */20 : - const start_loc$2 = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_THROW */20); - if (Curry._1(Parser_env_Peek.is_line_terminator, env)) { - error_at(env, [ - start_loc$2, - /* NewlineAfterThrow */11 - ]); - } - const argument$1 = Curry._1(Parse.expression, env); - const loc$2 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); - const end_loc$2 = loc$2 !== undefined ? loc$2 : argument$1[0]; - semicolon(env); - return [ - btwn(start_loc$2, end_loc$2), - { - TAG: /* Throw */10, - _0: { - argument: argument$1 - } - } - ]; - case /* T_TRY */21 : - const start_loc$3 = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_TRY */21); - const block = Curry._1(Parse.block_body, env); - const match$2 = Curry._2(Parser_env_Peek.token, undefined, env); - let handler; - if (match$2 === 32) { - const start_loc$4 = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_CATCH */32); - token$4(env, /* T_LPAREN */3); - const id = Curry._2(Parse.identifier, /* StrictCatchVariable */26, env); - const param_0 = id[0]; - const param_1 = { - TAG: /* Identifier */3, - _0: id - }; - const param = [ - param_0, - param_1 + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_LCURLY */1 : + const match$1 = Curry._1(Parse.block_body, env); + return [ + match$1[0], + { + TAG: /* Block */0, + _0: match$1[1] + } + ]; + case /* T_SEMICOLON */7 : + const loc = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_SEMICOLON */7); + return [ + loc, + /* Empty */0 ]; - token$4(env, /* T_RPAREN */4); - const body = Curry._1(Parse.block_body, env); - const loc$3 = btwn(start_loc$4, body[0]); - handler = [ - loc$3, + case /* T_IF */14 : + return _if(env); + case /* T_RETURN */17 : + if (!env.in_function) { + error$1(env, /* IllegalReturn */23); + } + const start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_RETURN */17); + const argument = Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_SEMICOLON */7) || Curry._1(Parser_env_Peek.is_implicit_semicolon, env) ? undefined : Curry._1(Parse.expression, env); + const loc$1 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); + const end_loc = loc$1 !== undefined ? loc$1 : ( + argument !== undefined ? argument[0] : start_loc + ); + semicolon(env); + return [ + btwn(start_loc, end_loc), { - param: param, - guard: undefined, - body: body + TAG: /* Return */9, + _0: { + argument: argument + } } ]; - } else { - handler = undefined; - } - const match$3 = Curry._2(Parser_env_Peek.token, undefined, env); - const finalizer = match$3 === 36 ? (token$4(env, /* T_FINALLY */36), Curry._1(Parse.block_body, env)) : undefined; - const end_loc$3 = finalizer !== undefined ? finalizer[0] : ( - handler !== undefined ? handler[0] : (error_at(env, [ - block[0], - /* NoCatchOrFinally */20 - ]), block[0]) - ); - return [ - btwn(start_loc$3, end_loc$3), - { - TAG: /* Try */11, - _0: { - block: block, - handler: handler, - guardedHandlers: /* [] */0, - finalizer: finalizer - } - } - ]; - case /* T_VAR */22 : - return var_or_const(env); - case /* T_WHILE */23 : - const start_loc$5 = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_WHILE */23); - token$4(env, /* T_LPAREN */3); - const test = Curry._1(Parse.expression, env); - token$4(env, /* T_RPAREN */4); - const body$1 = Curry._1(Parse.statement, with_in_loop(true, env)); - return [ - btwn(start_loc$5, body$1[0]), - { - TAG: /* While */12, - _0: { - test: test, - body: body$1 - } - } - ]; - case /* T_WITH */24 : - const start_loc$6 = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_WITH */24); - token$4(env, /* T_LPAREN */3); - const _object = Curry._1(Parse.expression, env); - token$4(env, /* T_RPAREN */4); - const body$2 = Curry._1(Parse.statement, env); - const loc$4 = btwn(start_loc$6, body$2[0]); - strict_error_at(env, [ - loc$4, - /* StrictModeWith */25 - ]); - return [ - loc$4, - { - TAG: /* With */6, - _0: { - _object: _object, - body: body$2 - } - } - ]; - case /* T_BREAK */30 : - const start_loc$7 = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_BREAK */30); - let label; - if (Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_SEMICOLON */7) || Curry._1(Parser_env_Peek.is_implicit_semicolon, env)) { - label = undefined; - } else { - const label$1 = Curry._2(Parse.identifier, undefined, env); - const name = label$1[1].name; - if (!Curry._2(mem$1, name, env.labels)) { - error$1(env, { - TAG: /* UnknownLabel */4, - _0: name - }); - } - label = label$1; - } - const loc$5 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); - const end_loc$4 = loc$5 !== undefined ? loc$5 : ( - label !== undefined ? label[0] : start_loc$7 - ); - const loc$6 = btwn(start_loc$7, end_loc$4); - if (label === undefined && !(env.in_loop || env.in_switch)) { - error_at(env, [ - loc$6, - /* IllegalBreak */22 - ]); - } - semicolon(env); - return [ - loc$6, - { - TAG: /* Break */4, - _0: { - label: label - } - } - ]; - case /* T_CONTINUE */33 : - const start_loc$8 = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_CONTINUE */33); - let label$2; - if (Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_SEMICOLON */7) || Curry._1(Parser_env_Peek.is_implicit_semicolon, env)) { - label$2 = undefined; - } else { - const label$3 = Curry._2(Parse.identifier, undefined, env); - const name$1 = label$3[1].name; - if (!Curry._2(mem$1, name$1, env.labels)) { - error$1(env, { - TAG: /* UnknownLabel */4, - _0: name$1 - }); - } - label$2 = label$3; - } - const loc$7 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); - const end_loc$5 = loc$7 !== undefined ? loc$7 : ( - label$2 !== undefined ? label$2[0] : start_loc$8 - ); - const loc$8 = btwn(start_loc$8, end_loc$5); - if (!env.in_loop) { - error_at(env, [ - loc$8, - /* IllegalContinue */21 - ]); - } - semicolon(env); - return [ - loc$8, - { - TAG: /* Continue */5, - _0: { - label: label$2 - } - } - ]; - case /* T_DO */35 : - const start_loc$9 = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_DO */35); - const body$3 = Curry._1(Parse.statement, with_in_loop(true, env)); - token$4(env, /* T_WHILE */23); - token$4(env, /* T_LPAREN */3); - const test$1 = Curry._1(Parse.expression, env); - const end_loc$6 = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_RPAREN */4); - const loc$9 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); - const end_loc$7 = loc$9 !== undefined ? loc$9 : end_loc$6; - if (Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_SEMICOLON */7)) { - semicolon(env); + case /* T_SWITCH */18 : + const start_loc$1 = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_SWITCH */18); + token$4(env, /* T_LPAREN */3); + const discriminant = Curry._1(Parse.expression, env); + token$4(env, /* T_RPAREN */4); + token$4(env, /* T_LCURLY */1); + const cases = case_list(env, [ + false, + /* [] */0 + ]); + const end_loc$1 = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_RCURLY */2); + return [ + btwn(start_loc$1, end_loc$1), + { + TAG: /* Switch */8, + _0: { + discriminant: discriminant, + cases: cases, + lexical: false + } + } + ]; + case /* T_THROW */20 : + const start_loc$2 = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_THROW */20); + if (Curry._1(Parser_env_Peek.is_line_terminator, env)) { + error_at(env, [ + start_loc$2, + /* NewlineAfterThrow */11 + ]); + } + const argument$1 = Curry._1(Parse.expression, env); + const loc$2 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); + const end_loc$2 = loc$2 !== undefined ? loc$2 : argument$1[0]; + semicolon(env); + return [ + btwn(start_loc$2, end_loc$2), + { + TAG: /* Throw */10, + _0: { + argument: argument$1 + } + } + ]; + case /* T_TRY */21 : + const start_loc$3 = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_TRY */21); + const block = Curry._1(Parse.block_body, env); + const match$2 = Curry._2(Parser_env_Peek.token, undefined, env); + let handler; + if (/* tag */(typeof match$2 === "number" || typeof match$2 === "string") && match$2 === /* T_CATCH */32) { + const start_loc$4 = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_CATCH */32); + token$4(env, /* T_LPAREN */3); + const id = Curry._2(Parse.identifier, /* StrictCatchVariable */26, env); + const param_0 = id[0]; + const param_1 = { + TAG: /* Identifier */3, + _0: id + }; + const param = [ + param_0, + param_1 + ]; + token$4(env, /* T_RPAREN */4); + const body = Curry._1(Parse.block_body, env); + const loc$3 = btwn(start_loc$4, body[0]); + handler = [ + loc$3, + { + param: param, + guard: undefined, + body: body } - return [ - btwn(start_loc$9, end_loc$7), - { - TAG: /* DoWhile */13, - _0: { - body: body$3, - test: test$1 - } - } - ]; - case /* T_FOR */37 : - const start_loc$10 = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_FOR */37); - token$4(env, /* T_LPAREN */3); - const match$4 = Curry._2(Parser_env_Peek.token, undefined, env); - let match$5; - let exit$1 = 0; - if (typeof match$4 === "number") { - if (match$4 >= 22) { - if (match$4 >= 27) { - exit$1 = 1; - } else { - switch (match$4) { - case /* T_VAR */22 : - const match$6 = declarations(/* T_VAR */22, /* Var */0, with_no_in(true, env)); - match$5 = [ - { - TAG: /* InitDeclaration */0, - _0: match$6[0] - }, - match$6[1] - ]; - break; - case /* T_WHILE */23 : - case /* T_WITH */24 : - exit$1 = 1; - break; - case /* T_CONST */25 : - const match$7 = $$const(with_no_in(true, env)); - match$5 = [ - { - TAG: /* InitDeclaration */0, - _0: match$7[0] - }, - match$7[1] - ]; - break; - case /* T_LET */26 : - const match$8 = _let(with_no_in(true, env)); - match$5 = [ - { - TAG: /* InitDeclaration */0, - _0: match$8[0] - }, - match$8[1] - ]; - break; - + ]; + } else { + handler = undefined; + } + const match$3 = Curry._2(Parser_env_Peek.token, undefined, env); + let finalizer; + if (/* tag */(typeof match$3 === "number" || typeof match$3 === "string") && match$3 === /* T_FINALLY */36) { + token$4(env, /* T_FINALLY */36); + finalizer = Curry._1(Parse.block_body, env); + } else { + finalizer = undefined; + } + const end_loc$3 = finalizer !== undefined ? finalizer[0] : ( + handler !== undefined ? handler[0] : (error_at(env, [ + block[0], + /* NoCatchOrFinally */20 + ]), block[0]) + ); + return [ + btwn(start_loc$3, end_loc$3), + { + TAG: /* Try */11, + _0: { + block: block, + handler: handler, + guardedHandlers: /* [] */0, + finalizer: finalizer } } - } else if (match$4 !== 7) { - exit$1 = 1; - } else { + ]; + case /* T_VAR */22 : + return var_or_const(env); + case /* T_WHILE */23 : + const start_loc$5 = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_WHILE */23); + token$4(env, /* T_LPAREN */3); + const test = Curry._1(Parse.expression, env); + token$4(env, /* T_RPAREN */4); + const body$1 = Curry._1(Parse.statement, with_in_loop(true, env)); + return [ + btwn(start_loc$5, body$1[0]), + { + TAG: /* While */12, + _0: { + test: test, + body: body$1 + } + } + ]; + case /* T_WITH */24 : + const start_loc$6 = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_WITH */24); + token$4(env, /* T_LPAREN */3); + const _object = Curry._1(Parse.expression, env); + token$4(env, /* T_RPAREN */4); + const body$2 = Curry._1(Parse.statement, env); + const loc$4 = btwn(start_loc$6, body$2[0]); + strict_error_at(env, [ + loc$4, + /* StrictModeWith */25 + ]); + return [ + loc$4, + { + TAG: /* With */6, + _0: { + _object: _object, + body: body$2 + } + } + ]; + case /* T_BREAK */30 : + const start_loc$7 = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_BREAK */30); + let label; + if (Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_SEMICOLON */7) || Curry._1(Parser_env_Peek.is_implicit_semicolon, env)) { + label = undefined; + } else { + const label$1 = Curry._2(Parse.identifier, undefined, env); + const name = label$1[1].name; + if (!Curry._2(mem$1, name, env.labels)) { + error$1(env, { + TAG: /* UnknownLabel */4, + _0: name + }); + } + label = label$1; + } + const loc$5 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); + const end_loc$4 = loc$5 !== undefined ? loc$5 : ( + label !== undefined ? label[0] : start_loc$7 + ); + const loc$6 = btwn(start_loc$7, end_loc$4); + if (label === undefined && !(env.in_loop || env.in_switch)) { + error_at(env, [ + loc$6, + /* IllegalBreak */22 + ]); + } + semicolon(env); + return [ + loc$6, + { + TAG: /* Break */4, + _0: { + label: label + } + } + ]; + case /* T_CONTINUE */33 : + const start_loc$8 = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_CONTINUE */33); + let label$2; + if (Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_SEMICOLON */7) || Curry._1(Parser_env_Peek.is_implicit_semicolon, env)) { + label$2 = undefined; + } else { + const label$3 = Curry._2(Parse.identifier, undefined, env); + const name$1 = label$3[1].name; + if (!Curry._2(mem$1, name$1, env.labels)) { + error$1(env, { + TAG: /* UnknownLabel */4, + _0: name$1 + }); + } + label$2 = label$3; + } + const loc$7 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); + const end_loc$5 = loc$7 !== undefined ? loc$7 : ( + label$2 !== undefined ? label$2[0] : start_loc$8 + ); + const loc$8 = btwn(start_loc$8, end_loc$5); + if (!env.in_loop) { + error_at(env, [ + loc$8, + /* IllegalContinue */21 + ]); + } + semicolon(env); + return [ + loc$8, + { + TAG: /* Continue */5, + _0: { + label: label$2 + } + } + ]; + case /* T_DO */35 : + const start_loc$9 = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_DO */35); + const body$3 = Curry._1(Parse.statement, with_in_loop(true, env)); + token$4(env, /* T_WHILE */23); + token$4(env, /* T_LPAREN */3); + const test$1 = Curry._1(Parse.expression, env); + const end_loc$6 = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_RPAREN */4); + const loc$9 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); + const end_loc$7 = loc$9 !== undefined ? loc$9 : end_loc$6; + if (Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_SEMICOLON */7)) { + semicolon(env); + } + return [ + btwn(start_loc$9, end_loc$7), + { + TAG: /* DoWhile */13, + _0: { + body: body$3, + test: test$1 + } + } + ]; + case /* T_FOR */37 : + const start_loc$10 = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_FOR */37); + token$4(env, /* T_LPAREN */3); + const match$4 = Curry._2(Parser_env_Peek.token, undefined, env); + let match$5; + let exit$1 = 0; + if (/* tag */typeof match$4 === "number" || typeof match$4 === "string") { + switch (match$4) { + case /* T_SEMICOLON */7 : match$5 = [ undefined, /* [] */0 ]; - } - } else { + break; + case /* T_VAR */22 : + const match$6 = declarations(/* T_VAR */22, /* Var */0, with_no_in(true, env)); + match$5 = [ + { + TAG: /* InitDeclaration */0, + _0: match$6[0] + }, + match$6[1] + ]; + break; + case /* T_CONST */25 : + const match$7 = $$const(with_no_in(true, env)); + match$5 = [ + { + TAG: /* InitDeclaration */0, + _0: match$7[0] + }, + match$7[1] + ]; + break; + case /* T_LET */26 : + const match$8 = _let(with_no_in(true, env)); + match$5 = [ + { + TAG: /* InitDeclaration */0, + _0: match$8[0] + }, + match$8[1] + ]; + break; + default: exit$1 = 1; - } - if (exit$1 === 1) { - const expr = Curry._1(Parse.expression, with_no_let(true, with_no_in(true, env))); - match$5 = [ - { - TAG: /* InitExpression */1, - _0: expr - }, - /* [] */0 - ]; - } - const init = match$5[0]; - const match$9 = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match$9 === "number") { - if (match$9 !== 15) { - if (match$9 === 60) { - assert_can_be_forin_or_forof(env, /* InvalidLHSInForOf */17)(init); - let left; - if (init !== undefined) { - left = init.TAG === /* InitDeclaration */0 ? ({ - TAG: /* LeftDeclaration */0, - _0: init._0 - }) : ({ - TAG: /* LeftExpression */1, - _0: init._0 - }); - } else { - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "parser_flow.ml", - 2573, - 22 - ] - }); - } - token$4(env, /* T_OF */60); - const right = Curry._1(Parse.assignment, env); - token$4(env, /* T_RPAREN */4); - const body$4 = Curry._1(Parse.statement, with_in_loop(true, env)); - return [ - btwn(start_loc$10, body$4[0]), - { - TAG: /* ForOf */16, - _0: { - left: left, - right: right, - body: body$4 - } - } - ]; - } - - } else { + } + } else { + exit$1 = 1; + } + if (exit$1 === 1) { + const expr = Curry._1(Parse.expression, with_no_let(true, with_no_in(true, env))); + match$5 = [ + { + TAG: /* InitExpression */1, + _0: expr + }, + /* [] */0 + ]; + } + const init = match$5[0]; + const match$9 = Curry._2(Parser_env_Peek.token, undefined, env); + if (/* tag */typeof match$9 === "number" || typeof match$9 === "string") { + switch (match$9) { + case /* T_IN */15 : assert_can_be_forin_or_forof(env, /* InvalidLHSInForIn */16)(init); - let left$1; + let left; if (init !== undefined) { - left$1 = init.TAG === /* InitDeclaration */0 ? ({ + left = init.TAG === /* InitDeclaration */0 ? ({ TAG: /* LeftDeclaration */0, _0: init._0 }) : ({ @@ -13998,110 +14053,104 @@ function statement(env) { }); } token$4(env, /* T_IN */15); - const right$1 = Curry._1(Parse.expression, env); + const right = Curry._1(Parse.expression, env); + token$4(env, /* T_RPAREN */4); + const body$4 = Curry._1(Parse.statement, with_in_loop(true, env)); + return [ + btwn(start_loc$10, body$4[0]), + { + TAG: /* ForIn */15, + _0: { + left: left, + right: right, + body: body$4, + each: false + } + } + ]; + case /* T_OF */60 : + assert_can_be_forin_or_forof(env, /* InvalidLHSInForOf */17)(init); + let left$1; + if (init !== undefined) { + left$1 = init.TAG === /* InitDeclaration */0 ? ({ + TAG: /* LeftDeclaration */0, + _0: init._0 + }) : ({ + TAG: /* LeftExpression */1, + _0: init._0 + }); + } else { + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "parser_flow.ml", + 2573, + 22 + ] + }); + } + token$4(env, /* T_OF */60); + const right$1 = Curry._1(Parse.assignment, env); token$4(env, /* T_RPAREN */4); const body$5 = Curry._1(Parse.statement, with_in_loop(true, env)); return [ btwn(start_loc$10, body$5[0]), { - TAG: /* ForIn */15, + TAG: /* ForOf */16, _0: { left: left$1, right: right$1, - body: body$5, - each: false + body: body$5 } } ]; - } - } - Stdlib__List.iter((function (param) { - return error_at(env, param); - }), match$5[1]); - token$4(env, /* T_SEMICOLON */7); - const match$10 = Curry._2(Parser_env_Peek.token, undefined, env); - const test$2 = match$10 === 7 ? undefined : Curry._1(Parse.expression, env); - token$4(env, /* T_SEMICOLON */7); - const match$11 = Curry._2(Parser_env_Peek.token, undefined, env); - const update = match$11 === 4 ? undefined : Curry._1(Parse.expression, env); - token$4(env, /* T_RPAREN */4); - const body$6 = Curry._1(Parse.statement, with_in_loop(true, env)); - return [ - btwn(start_loc$10, body$6[0]), - { - TAG: /* For */14, - _0: { - init: init, - test: test$2, - update: update, - body: body$6 - } - } - ]; - case /* T_IDENTIFIER */0 : - case /* T_RCURLY */2 : - case /* T_LPAREN */3 : - case /* T_RPAREN */4 : - case /* T_LBRACKET */5 : - case /* T_RBRACKET */6 : - case /* T_COMMA */8 : - case /* T_PERIOD */9 : - case /* T_ARROW */10 : - case /* T_ELLIPSIS */11 : - case /* T_AT */12 : - case /* T_FUNCTION */13 : - case /* T_IN */15 : - case /* T_INSTANCEOF */16 : - case /* T_THIS */19 : - case /* T_CONST */25 : - case /* T_LET */26 : - case /* T_NULL */27 : - case /* T_FALSE */28 : - case /* T_TRUE */29 : - case /* T_CASE */31 : - case /* T_CATCH */32 : - case /* T_DEFAULT */34 : - case /* T_FINALLY */36 : - case /* T_CLASS */38 : - case /* T_EXTENDS */39 : - case /* T_STATIC */40 : - case /* T_ELSE */41 : - case /* T_NEW */42 : - case /* T_DELETE */43 : - case /* T_TYPEOF */44 : - case /* T_VOID */45 : - case /* T_ENUM */46 : - case /* T_EXPORT */47 : - case /* T_IMPORT */48 : - case /* T_SUPER */49 : - case /* T_IMPLEMENTS */50 : - case /* T_INTERFACE */51 : - case /* T_PACKAGE */52 : - case /* T_PRIVATE */53 : - case /* T_PROTECTED */54 : - case /* T_PUBLIC */55 : - case /* T_YIELD */56 : - exit = 2; - break; - case /* T_DEBUGGER */57 : - const start_loc$11 = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_DEBUGGER */57); - const loc$10 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); - const end_loc$8 = loc$10 !== undefined ? loc$10 : start_loc$11; - semicolon(env); - return [ - btwn(start_loc$11, end_loc$8), - /* Debugger */1 - ]; - - } - } - } else { - error_unexpected(env); - return [ - Curry._2(Parser_env_Peek.loc, undefined, env), - /* Empty */0 - ]; + default: + + } + } + Stdlib__List.iter((function (param) { + return error_at(env, param); + }), match$5[1]); + token$4(env, /* T_SEMICOLON */7); + const match$10 = Curry._2(Parser_env_Peek.token, undefined, env); + let test$2; + test$2 = /* tag */(typeof match$10 === "number" || typeof match$10 === "string") && match$10 === /* T_SEMICOLON */7 ? undefined : Curry._1(Parse.expression, env); + token$4(env, /* T_SEMICOLON */7); + const match$11 = Curry._2(Parser_env_Peek.token, undefined, env); + let update; + update = /* tag */(typeof match$11 === "number" || typeof match$11 === "string") && match$11 === /* T_RPAREN */4 ? undefined : Curry._1(Parse.expression, env); + token$4(env, /* T_RPAREN */4); + const body$6 = Curry._1(Parse.statement, with_in_loop(true, env)); + return [ + btwn(start_loc$10, body$6[0]), + { + TAG: /* For */14, + _0: { + init: init, + test: test$2, + update: update, + body: body$6 + } + } + ]; + case /* T_DEBUGGER */57 : + const start_loc$11 = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_DEBUGGER */57); + const loc$10 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); + const end_loc$8 = loc$10 !== undefined ? loc$10 : start_loc$11; + semicolon(env); + return [ + btwn(start_loc$11, end_loc$8), + /* Debugger */1 + ]; + case /* T_EOF */105 : + error_unexpected(env); + return [ + Curry._2(Parser_env_Peek.loc, undefined, env), + /* Empty */0 + ]; + default: + exit = 2; } } else { exit = 2; @@ -14111,7 +14160,7 @@ function statement(env) { const expr$1 = Curry._1(Parse.expression, env); const match$12 = Curry._2(Parser_env_Peek.token, undefined, env); const label$4 = expr$1[1]; - if (typeof label$4 !== "number" && label$4.TAG === /* Identifier */18 && match$12 === 77) { + if (!/* tag */(typeof label$4 === "number" || typeof label$4 === "string") && label$4.TAG === /* Identifier */18 && /* tag */(typeof match$12 === "number" || typeof match$12 === "string") && match$12 === /* T_COLON */77) { const label$5 = label$4._0; const loc$11 = expr$1[0]; const match$13 = label$5[1]; @@ -14153,70 +14202,34 @@ function statement(env) { } ]; } - if (typeof match !== "number") { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { return expression(env); } - if (match !== 77) { - if (match >= 49) { + switch (match) { + case /* T_ELSE */41 : + return _if(env); + case /* T_RCURLY */2 : + case /* T_RPAREN */4 : + case /* T_RBRACKET */6 : + case /* T_COMMA */8 : + case /* T_PERIOD */9 : + case /* T_ARROW */10 : + case /* T_ELLIPSIS */11 : + case /* T_IN */15 : + case /* T_INSTANCEOF */16 : + case /* T_CASE */31 : + case /* T_CATCH */32 : + case /* T_DEFAULT */34 : + case /* T_FINALLY */36 : + case /* T_EXTENDS */39 : + case /* T_STATIC */40 : + case /* T_EXPORT */47 : + case /* T_IMPORT */48 : + case /* T_COLON */77 : + break; + default: return expression(env); - } - switch (match) { - case /* T_ELSE */41 : - return _if(env); - case /* T_IDENTIFIER */0 : - case /* T_LCURLY */1 : - case /* T_LPAREN */3 : - case /* T_LBRACKET */5 : - case /* T_SEMICOLON */7 : - case /* T_AT */12 : - case /* T_FUNCTION */13 : - case /* T_IF */14 : - case /* T_RETURN */17 : - case /* T_SWITCH */18 : - case /* T_THIS */19 : - case /* T_THROW */20 : - case /* T_TRY */21 : - case /* T_VAR */22 : - case /* T_WHILE */23 : - case /* T_WITH */24 : - case /* T_CONST */25 : - case /* T_LET */26 : - case /* T_NULL */27 : - case /* T_FALSE */28 : - case /* T_TRUE */29 : - case /* T_BREAK */30 : - case /* T_CONTINUE */33 : - case /* T_DO */35 : - case /* T_FOR */37 : - case /* T_CLASS */38 : - case /* T_NEW */42 : - case /* T_DELETE */43 : - case /* T_TYPEOF */44 : - case /* T_VOID */45 : - case /* T_ENUM */46 : - return expression(env); - case /* T_RCURLY */2 : - case /* T_RPAREN */4 : - case /* T_RBRACKET */6 : - case /* T_COMMA */8 : - case /* T_PERIOD */9 : - case /* T_ARROW */10 : - case /* T_ELLIPSIS */11 : - case /* T_IN */15 : - case /* T_INSTANCEOF */16 : - case /* T_CASE */31 : - case /* T_CATCH */32 : - case /* T_DEFAULT */34 : - case /* T_FINALLY */36 : - case /* T_EXTENDS */39 : - case /* T_STATIC */40 : - case /* T_EXPORT */47 : - case /* T_IMPORT */48 : - break; - - } } - } error_unexpected(env); token$3(env); @@ -14227,7 +14240,7 @@ function statement(env) { function module_item(env) { const decorators = decorator_list(env); const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match !== "number") { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { return statement_list_item(decorators, env); } switch (match) { @@ -14237,164 +14250,33 @@ function module_item(env) { token$4(env$1, /* T_EXPORT */47); const match$1 = Curry._2(Parser_env_Peek.token, undefined, env$1); let exit = 0; - if (typeof match$1 === "number") { - if (match$1 >= 51) { - if (match$1 !== 97) { - if (match$1 >= 62) { - exit = 1; - } else { - switch (match$1) { - case /* T_INTERFACE */51 : - if (!env$1.parse_options.types) { - error$1(env$1, /* UnexpectedTypeExport */9); - } - const $$interface$1 = $$interface(env$1); - const match$2 = $$interface$1[1]; - if (typeof match$2 === "number") { - throw new Caml_js_exceptions.MelangeError("Failure", { - MEL_EXN_ID: "Failure", - _1: "Internal Flow Error! Parsed `export interface` into something other than an interface declaration!" - }); - } - if (match$2.TAG === /* InterfaceDeclaration */21) { - record_export(env$1, [ - $$interface$1[0], - extract_ident_name(match$2._0.id) - ]); - } else { - throw new Caml_js_exceptions.MelangeError("Failure", { - MEL_EXN_ID: "Failure", - _1: "Internal Flow Error! Parsed `export interface` into something other than an interface declaration!" - }); - } - const end_loc = $$interface$1[0]; - return [ - btwn(start_loc, end_loc), - { - TAG: /* ExportDeclaration */28, - _0: { - default: false, - declaration: { - TAG: /* Declaration */0, - _0: $$interface$1 - }, - specifiers: undefined, - source: undefined, - exportKind: /* ExportType */0 - } - } - ]; - case /* T_TYPE */59 : - if (Caml_obj.caml_notequal(Curry._2(Parser_env_Peek.token, 1, env$1), /* T_LCURLY */1)) { - if (!env$1.parse_options.types) { - error$1(env$1, /* UnexpectedTypeExport */9); - } - const type_alias$1 = type_alias(env$1); - const match$3 = type_alias$1[1]; - if (typeof match$3 === "number") { - throw new Caml_js_exceptions.MelangeError("Failure", { - MEL_EXN_ID: "Failure", - _1: "Internal Flow Error! Parsed `export type` into something other than a type alias!" - }); - } - if (match$3.TAG === /* TypeAlias */7) { - record_export(env$1, [ - type_alias$1[0], - extract_ident_name(match$3._0.id) - ]); - } else { - throw new Caml_js_exceptions.MelangeError("Failure", { - MEL_EXN_ID: "Failure", - _1: "Internal Flow Error! Parsed `export type` into something other than a type alias!" - }); - } - const end_loc$1 = type_alias$1[0]; - return [ - btwn(start_loc, end_loc$1), - { - TAG: /* ExportDeclaration */28, - _0: { - default: false, - declaration: { - TAG: /* Declaration */0, - _0: type_alias$1 - }, - specifiers: undefined, - source: undefined, - exportKind: /* ExportType */0 - } - } - ]; - } - exit = 1; - break; - case /* T_PACKAGE */52 : - case /* T_PRIVATE */53 : - case /* T_PROTECTED */54 : - case /* T_PUBLIC */55 : - case /* T_YIELD */56 : - case /* T_DEBUGGER */57 : - case /* T_DECLARE */58 : - case /* T_OF */60 : - exit = 1; - break; - case /* T_ASYNC */61 : - exit = 2; - break; - + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { + switch (match$1) { + case /* T_DEFAULT */34 : + token$4(env$1, /* T_DEFAULT */34); + record_export(env$1, [ + btwn(start_loc, Curry._2(Parser_env_Peek.loc, undefined, env$1)), + "default" + ]); + const match$2 = Curry._2(Parser_env_Peek.token, undefined, env$1); + let match$3; + let exit$1 = 0; + if (/* tag */(typeof match$2 === "number" || typeof match$2 === "string") && match$2 === /* T_FUNCTION */13) { + const fn = _function(env$1); + match$3 = [ + fn[0], + { + TAG: /* Declaration */0, + _0: fn + } + ]; + } else { + exit$1 = 3; } - } - } else { - const loc = Curry._2(Parser_env_Peek.loc, undefined, env$1); - token$4(env$1, /* T_MULT */97); - const parse_export_star_as = env$1.parse_options.esproposal_export_star_as; - const local_name = Curry._2(Parser_env_Peek.value, undefined, env$1) === "as" ? (contextual(env$1, "as"), parse_export_star_as ? Curry._2(Parse.identifier, undefined, env$1) : (error$1(env$1, /* UnexpectedTypeDeclaration */7), undefined)) : undefined; - const specifiers = { - TAG: /* ExportBatchSpecifier */1, - _0: loc, - _1: local_name - }; - const source$1 = export_source(env$1); - const loc$1 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env$1); - const end_loc$2 = loc$1 !== undefined ? loc$1 : source$1[0]; - const source$2 = source$1; - semicolon(env$1); - return [ - btwn(start_loc, end_loc$2), - { - TAG: /* ExportDeclaration */28, - _0: { - default: false, - declaration: undefined, - specifiers: specifiers, - source: source$2, - exportKind: /* ExportValue */1 - } - } - ]; - } - } else { - switch (match$1) { - case /* T_DEFAULT */34 : - token$4(env$1, /* T_DEFAULT */34); - record_export(env$1, [ - btwn(start_loc, Curry._2(Parser_env_Peek.loc, undefined, env$1)), - "default" - ]); - const match$4 = Curry._2(Parser_env_Peek.token, undefined, env$1); - let match$5; - if (match$4 === 13) { - const fn = _function(env$1); - match$5 = [ - fn[0], - { - TAG: /* Declaration */0, - _0: fn - } - ]; - } else if (Curry._2(Parser_env_Peek.is_class, undefined, env$1)) { + if (exit$1 === 3) { + if (Curry._2(Parser_env_Peek.is_class, undefined, env$1)) { const _class = class_declaration(env$1, decorators); - match$5 = [ + match$3 = [ _class[0], { TAG: /* Declaration */0, @@ -14403,63 +14285,154 @@ function module_item(env) { ]; } else { const expr = Curry._1(Parse.assignment, env$1); - const loc$2 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env$1); - const end_loc$3 = loc$2 !== undefined ? loc$2 : expr[0]; + const loc = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env$1); + const end_loc = loc !== undefined ? loc : expr[0]; semicolon(env$1); - match$5 = [ - end_loc$3, + match$3 = [ + end_loc, { TAG: /* Expression */1, _0: expr } ]; } + } + return [ + btwn(start_loc, match$3[0]), + { + TAG: /* ExportDeclaration */28, + _0: { + default: true, + declaration: match$3[1], + specifiers: undefined, + source: undefined, + exportKind: /* ExportValue */1 + } + } + ]; + case /* T_INTERFACE */51 : + if (!env$1.parse_options.types) { + error$1(env$1, /* UnexpectedTypeExport */9); + } + const $$interface$1 = $$interface(env$1); + const match$4 = $$interface$1[1]; + if (/* tag */typeof match$4 === "number" || typeof match$4 === "string") { + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "Internal Flow Error! Parsed `export interface` into something other than an interface declaration!" + }); + } + if (match$4.TAG === /* InterfaceDeclaration */21) { + record_export(env$1, [ + $$interface$1[0], + extract_ident_name(match$4._0.id) + ]); + } else { + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "Internal Flow Error! Parsed `export interface` into something other than an interface declaration!" + }); + } + const end_loc$1 = $$interface$1[0]; + return [ + btwn(start_loc, end_loc$1), + { + TAG: /* ExportDeclaration */28, + _0: { + default: false, + declaration: { + TAG: /* Declaration */0, + _0: $$interface$1 + }, + specifiers: undefined, + source: undefined, + exportKind: /* ExportType */0 + } + } + ]; + case /* T_TYPE */59 : + if (Caml_obj.caml_notequal(Curry._2(Parser_env_Peek.token, 1, env$1), /* T_LCURLY */1)) { + if (!env$1.parse_options.types) { + error$1(env$1, /* UnexpectedTypeExport */9); + } + const type_alias$1 = type_alias(env$1); + const match$5 = type_alias$1[1]; + if (/* tag */typeof match$5 === "number" || typeof match$5 === "string") { + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "Internal Flow Error! Parsed `export type` into something other than a type alias!" + }); + } + if (match$5.TAG === /* TypeAlias */7) { + record_export(env$1, [ + type_alias$1[0], + extract_ident_name(match$5._0.id) + ]); + } else { + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "Internal Flow Error! Parsed `export type` into something other than a type alias!" + }); + } + const end_loc$2 = type_alias$1[0]; return [ - btwn(start_loc, match$5[0]), + btwn(start_loc, end_loc$2), { TAG: /* ExportDeclaration */28, _0: { - default: true, - declaration: match$5[1], + default: false, + declaration: { + TAG: /* Declaration */0, + _0: type_alias$1 + }, specifiers: undefined, source: undefined, - exportKind: /* ExportValue */1 + exportKind: /* ExportType */0 } } ]; - case /* T_IF */14 : - case /* T_IN */15 : - case /* T_INSTANCEOF */16 : - case /* T_RETURN */17 : - case /* T_SWITCH */18 : - case /* T_THIS */19 : - case /* T_THROW */20 : - case /* T_TRY */21 : - case /* T_WHILE */23 : - case /* T_WITH */24 : - case /* T_NULL */27 : - case /* T_FALSE */28 : - case /* T_TRUE */29 : - case /* T_BREAK */30 : - case /* T_CASE */31 : - case /* T_CATCH */32 : - case /* T_CONTINUE */33 : - case /* T_DO */35 : - case /* T_FINALLY */36 : - case /* T_FOR */37 : - exit = 1; - break; - case /* T_AT */12 : - case /* T_FUNCTION */13 : - case /* T_VAR */22 : - case /* T_CONST */25 : - case /* T_LET */26 : - case /* T_CLASS */38 : - exit = 2; - break; - default: + } exit = 1; - } + break; + case /* T_AT */12 : + case /* T_FUNCTION */13 : + case /* T_VAR */22 : + case /* T_CONST */25 : + case /* T_LET */26 : + case /* T_CLASS */38 : + case /* T_ASYNC */61 : + exit = 2; + break; + case /* T_MULT */97 : + const loc$1 = Curry._2(Parser_env_Peek.loc, undefined, env$1); + token$4(env$1, /* T_MULT */97); + const parse_export_star_as = env$1.parse_options.esproposal_export_star_as; + const local_name = Curry._2(Parser_env_Peek.value, undefined, env$1) === "as" ? (contextual(env$1, "as"), parse_export_star_as ? Curry._2(Parse.identifier, undefined, env$1) : (error$1(env$1, /* UnexpectedTypeDeclaration */7), undefined)) : undefined; + const specifiers = { + TAG: /* ExportBatchSpecifier */1, + _0: loc$1, + _1: local_name + }; + const source$1 = export_source(env$1); + const loc$2 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env$1); + const end_loc$3 = loc$2 !== undefined ? loc$2 : source$1[0]; + const source$2 = source$1; + semicolon(env$1); + return [ + btwn(start_loc, end_loc$3), + { + TAG: /* ExportDeclaration */28, + _0: { + default: false, + declaration: undefined, + specifiers: specifiers, + source: source$2, + exportKind: /* ExportValue */1 + } + } + ]; + default: + exit = 1; } } else { exit = 1; @@ -14467,7 +14440,13 @@ function module_item(env) { switch (exit) { case 1 : const match$6 = Curry._2(Parser_env_Peek.token, undefined, env$1); - const exportKind = match$6 === 59 ? (token$3(env$1), /* ExportType */0) : /* ExportValue */1; + let exportKind; + if (/* tag */(typeof match$6 === "number" || typeof match$6 === "string") && match$6 === /* T_TYPE */59) { + token$3(env$1); + exportKind = /* ExportType */0; + } else { + exportKind = /* ExportValue */1; + } token$4(env$1, /* T_LCURLY */1); const match$7 = export_specifiers_and_errs(env$1, /* [] */0, /* [] */0); const specifiers$1 = { @@ -14502,13 +14481,13 @@ function module_item(env) { const match$8 = stmt[1]; const loc$4 = stmt[0]; let names; - if (typeof match$8 === "number") { + if (/* tag */typeof match$8 === "number" || typeof match$8 === "string") { throw new Caml_js_exceptions.MelangeError("Failure", { MEL_EXN_ID: "Failure", _1: "Internal Flow Error! Unexpected export statement declaration!" }); } - switch (match$8.TAG | 0) { + switch (match$8.TAG) { case /* FunctionDeclaration */18 : const id = match$8._0.id; if (id !== undefined) { @@ -14589,34 +14568,51 @@ function module_item(env) { const start_loc$1 = Curry._2(Parser_env_Peek.loc, undefined, env$2); token$4(env$2, /* T_IMPORT */48); const match$9 = Curry._2(Parser_env_Peek.token, undefined, env$2); - const match$10 = typeof match$9 === "number" ? ( - match$9 !== 44 ? ( - match$9 !== 59 ? [ - /* ImportValue */2, - undefined - ] : (!env$2.parse_options.types ? error$1(env$2, /* UnexpectedTypeImport */8) : undefined, [ - /* ImportType */0, - Curry._2(Parse.identifier, undefined, env$2) - ]) - ) : (!env$2.parse_options.types ? error$1(env$2, /* UnexpectedTypeImport */8) : undefined, token$4(env$2, /* T_TYPEOF */44), [ + let match$10; + if (/* tag */typeof match$9 === "number" || typeof match$9 === "string") { + switch (match$9) { + case /* T_TYPEOF */44 : + if (!env$2.parse_options.types) { + error$1(env$2, /* UnexpectedTypeImport */8); + } + token$4(env$2, /* T_TYPEOF */44); + match$10 = [ /* ImportTypeof */1, undefined - ]) - ) : [ + ]; + break; + case /* T_TYPE */59 : + if (!env$2.parse_options.types) { + error$1(env$2, /* UnexpectedTypeImport */8); + } + match$10 = [ + /* ImportType */0, + Curry._2(Parse.identifier, undefined, env$2) + ]; + break; + default: + match$10 = [ + /* ImportValue */2, + undefined + ]; + } + } else { + match$10 = [ /* ImportValue */2, undefined ]; + } const type_ident = match$10[1]; const importKind = match$10[0]; const match$11 = Curry._2(Parser_env_Peek.token, undefined, env$2); const match$12 = Curry._2(Parser_env_Peek.is_identifier, undefined, env$2); - let exit$1 = 0; let exit$2 = 0; - if (typeof match$11 === "number") { + let exit$3 = 0; + if (/* tag */typeof match$11 === "number" || typeof match$11 === "string") { if (match$11 === /* T_COMMA */8) { - exit$1 = 1; + exit$2 = 1; } else { - exit$2 = 2; + exit$3 = 2; } } else if (match$11.TAG === /* T_STRING */1) { if (importKind === /* ImportValue */2) { @@ -14664,13 +14660,13 @@ function module_item(env) { } ]; } - exit$2 = 2; + exit$3 = 2; } else { - exit$2 = 2; + exit$3 = 2; } - if (exit$2 === 2) { + if (exit$3 === 2) { if (match$12) { - exit$1 = 1; + exit$2 = 1; } else { const specifiers$2 = named_or_namespace_specifier(env$2); const source$5 = source(env$2); @@ -14690,23 +14686,42 @@ function module_item(env) { ]; } } - if (exit$1 === 1) { + if (exit$2 === 1) { const match$14 = Curry._2(Parser_env_Peek.token, undefined, env$2); const match$15 = Curry._2(Parser_env_Peek.value, undefined, env$2); let match$16; - let exit$3 = 0; - if (type_ident !== undefined && typeof match$14 === "number" && !(match$14 !== 8 && (match$14 || match$15 !== "from"))) { - match$16 = [ - /* ImportValue */2, - { - TAG: /* ImportDefaultSpecifier */1, - _0: type_ident - } - ]; + let exit$4 = 0; + if (type_ident !== undefined && /* tag */(typeof match$14 === "number" || typeof match$14 === "string")) { + switch (match$14) { + case /* T_IDENTIFIER */0 : + if (match$15 === "from") { + match$16 = [ + /* ImportValue */2, + { + TAG: /* ImportDefaultSpecifier */1, + _0: type_ident + } + ]; + } else { + exit$4 = 2; + } + break; + case /* T_COMMA */8 : + match$16 = [ + /* ImportValue */2, + { + TAG: /* ImportDefaultSpecifier */1, + _0: type_ident + } + ]; + break; + default: + exit$4 = 2; + } } else { - exit$3 = 2; + exit$4 = 2; } - if (exit$3 === 2) { + if (exit$4 === 2) { match$16 = [ importKind, { @@ -14716,7 +14731,13 @@ function module_item(env) { ]; } const match$17 = Curry._2(Parser_env_Peek.token, undefined, env$2); - const additional_specifiers = match$17 === 8 ? (token$4(env$2, /* T_COMMA */8), named_or_namespace_specifier(env$2)) : /* [] */0; + let additional_specifiers; + if (/* tag */(typeof match$17 === "number" || typeof match$17 === "string") && match$17 === /* T_COMMA */8) { + token$4(env$2, /* T_COMMA */8); + additional_specifiers = named_or_namespace_specifier(env$2); + } else { + additional_specifiers = /* [] */0; + } const source$6 = source(env$2); const loc$7 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env$2); const end_loc$8 = loc$7 !== undefined ? loc$7 : source$6[0]; @@ -14736,17 +14757,7 @@ function module_item(env) { } ]; } - case /* T_SUPER */49 : - case /* T_IMPLEMENTS */50 : - case /* T_INTERFACE */51 : - case /* T_PACKAGE */52 : - case /* T_PRIVATE */53 : - case /* T_PROTECTED */54 : - case /* T_PUBLIC */55 : - case /* T_YIELD */56 : - case /* T_DEBUGGER */57 : - return statement_list_item(decorators, env); - case /* T_DECLARE */58 : + case /* T_DECLARE */58 : if (Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, 1, env), /* T_EXPORT */47)) { error_on_decorators(env)(decorators); return declare_export_declaration(undefined, env); @@ -14764,62 +14775,63 @@ function statement_list_item(decoratorsOpt, env) { error_on_decorators(env)(decorators); } const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (typeof match === "number") { - if (match === 25) { - return var_or_const(env); - } - if (match === 26) { - const start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); - token$4(env, /* T_LET */26); - if (Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_LPAREN */3)) { - token$4(env, /* T_LPAREN */3); - const match$1 = helper(with_no_let(true, env), /* [] */0, /* [] */0); - const head = Stdlib__List.map((function (param) { - const match = param[1]; - return { - id: match.id, - init: match.init - }; - }), match$1[1]); - token$4(env, /* T_RPAREN */4); - const body = Curry._1(Parse.statement, env); - const end_loc = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); - const end_loc$1 = end_loc !== undefined ? end_loc : match$1[0]; - semicolon(env); - Stdlib__List.iter((function (param) { - return error_at(env, param); - }), match$1[2]); - return [ - btwn(start_loc, end_loc$1), - { - TAG: /* Let */17, - _0: { - head: head, - body: body - } - } - ]; - } - const match$2 = helper(with_no_let(true, env), /* [] */0, /* [] */0); - const declaration = { - TAG: /* VariableDeclaration */19, - _0: { - declarations: match$2[1], - kind: /* Let */1 - } - }; - const end_loc$2 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); - const end_loc$3 = end_loc$2 !== undefined ? end_loc$2 : match$2[0]; - semicolon(env); - Stdlib__List.iter((function (param) { - return error_at(env, param); - }), match$2[2]); - return [ - btwn(start_loc, end_loc$3), - declaration - ]; + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* T_CONST */25 : + return var_or_const(env); + case /* T_LET */26 : + const start_loc = Curry._2(Parser_env_Peek.loc, undefined, env); + token$4(env, /* T_LET */26); + if (Caml_obj.caml_equal(Curry._2(Parser_env_Peek.token, undefined, env), /* T_LPAREN */3)) { + token$4(env, /* T_LPAREN */3); + const match$1 = helper(with_no_let(true, env), /* [] */0, /* [] */0); + const head = Stdlib__List.map((function (param) { + const match = param[1]; + return { + id: match.id, + init: match.init + }; + }), match$1[1]); + token$4(env, /* T_RPAREN */4); + const body = Curry._1(Parse.statement, env); + const end_loc = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); + const end_loc$1 = end_loc !== undefined ? end_loc : match$1[0]; + semicolon(env); + Stdlib__List.iter((function (param) { + return error_at(env, param); + }), match$1[2]); + return [ + btwn(start_loc, end_loc$1), + { + TAG: /* Let */17, + _0: { + head: head, + body: body + } + } + ]; + } + const match$2 = helper(with_no_let(true, env), /* [] */0, /* [] */0); + const declaration = { + TAG: /* VariableDeclaration */19, + _0: { + declarations: match$2[1], + kind: /* Let */1 + } + }; + const end_loc$2 = Curry._2(Parser_env_Peek.semicolon_loc, undefined, env); + const end_loc$3 = end_loc$2 !== undefined ? end_loc$2 : match$2[0]; + semicolon(env); + Stdlib__List.iter((function (param) { + return error_at(env, param); + }), match$2[2]); + return [ + btwn(start_loc, end_loc$3), + declaration + ]; + default: + } - } if (Curry._2(Parser_env_Peek.is_function, undefined, env)) { return _function(env); @@ -14827,19 +14839,12 @@ function statement_list_item(decoratorsOpt, env) { if (Curry._2(Parser_env_Peek.is_class, undefined, env)) { return class_declaration$1(env, decorators); } - if (typeof match !== "number") { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { return statement(env); } switch (match) { case /* T_INTERFACE */51 : return $$interface(env); - case /* T_PACKAGE */52 : - case /* T_PRIVATE */53 : - case /* T_PROTECTED */54 : - case /* T_PUBLIC */55 : - case /* T_YIELD */56 : - case /* T_DEBUGGER */57 : - return statement(env); case /* T_DECLARE */58 : return declare(undefined, env); case /* T_TYPE */59 : @@ -14854,7 +14859,7 @@ function module_body(term_fn, env) { while(true) { const acc = _acc; const t = Curry._2(Parser_env_Peek.token, undefined, env); - if (t === 105) { + if (/* tag */(typeof t === "number" || typeof t === "string") && t === /* T_EOF */105) { return Stdlib__List.rev(acc); } if (Curry._1(term_fn, t)) { @@ -14875,7 +14880,7 @@ function statement_list(_env, term_fn, item_fn, _param) { const stmts = param[1]; const string_tokens = param[0]; const t = Curry._2(Parser_env_Peek.token, undefined, env); - if (t === 105) { + if (/* tag */(typeof t === "number" || typeof t === "string") && t === /* T_EOF */105) { return [ env, string_tokens, @@ -14901,7 +14906,7 @@ function statement_list(_env, term_fn, item_fn, _param) { tl: stmts }; const match = possible_directive[1]; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return [ env, string_tokens, @@ -14917,7 +14922,7 @@ function statement_list(_env, term_fn, item_fn, _param) { } const match$1 = match._0.expression; const match$2 = match$1[1]; - if (typeof match$2 === "number") { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string") { return [ env, string_tokens, @@ -14932,7 +14937,7 @@ function statement_list(_env, term_fn, item_fn, _param) { ]; } const str = match$2._0.value; - if (typeof str === "number") { + if (/* tag */typeof str === "number" || typeof str === "string") { return [ env, string_tokens, @@ -14970,7 +14975,7 @@ function directives(env, term_fn, item_fn) { const env$1 = match[0]; Stdlib__List.iter((function (param) { const token = param[1]; - if (typeof token !== "number" && token.TAG === /* T_STRING */1) { + if (!/* tag */(typeof token === "number" || typeof token === "string") && token.TAG === /* T_STRING */1) { if (token._0[3]) { return strict_error_at(env$1, [ param[0], @@ -14999,7 +15004,7 @@ function statement_list$1(term_fn, env) { while(true) { const acc = _acc; const t = Curry._2(Parser_env_Peek.token, undefined, env); - if (t === 105) { + if (/* tag */(typeof t === "number" || typeof t === "string") && t === /* T_EOF */105) { return Stdlib__List.rev(acc); } if (Curry._1(term_fn, t)) { @@ -15035,7 +15040,8 @@ function identifier$2(restricted_error, env) { const loc = Curry._2(Parser_env_Peek.loc, undefined, env); const name = Curry._2(Parser_env_Peek.value, undefined, env); const t = Curry._2(Parser_env_Peek.token, undefined, env); - if (t === 26) { + let exit = 0; + if (/* tag */(typeof t === "number" || typeof t === "string") && t === /* T_LET */26) { if (env.in_strict_mode) { strict_error(env, /* StrictReservedWord */39); } else if (env.no_let) { @@ -15045,13 +15051,28 @@ function identifier$2(restricted_error, env) { }); } token$3(env); - } else if (is_strict_reserved(name)) { - strict_error(env, /* StrictReservedWord */39); - token$3(env); - } else if (typeof t === "number" && !(t > 62 || t < 58)) { - token$4(env, t); } else { - token$4(env, /* T_IDENTIFIER */0); + exit = 1; + } + if (exit === 1) { + if (is_strict_reserved(name)) { + strict_error(env, /* StrictReservedWord */39); + token$3(env); + } else if (/* tag */typeof t === "number" || typeof t === "string") { + switch (t) { + case /* T_DECLARE */58 : + case /* T_TYPE */59 : + case /* T_OF */60 : + case /* T_ASYNC */61 : + case /* T_AWAIT */62 : + token$4(env, t); + break; + default: + token$4(env, /* T_IDENTIFIER */0); + } + } else { + token$4(env, /* T_IDENTIFIER */0); + } } if (restricted_error !== undefined && is_restricted(name)) { strict_error_at(env, [ @@ -15098,7 +15119,7 @@ function program(env) { function expression$1(env) { const expr = Curry._1(assignment, env); const match = Curry._2(Parser_env_Peek.token, undefined, env); - if (match === 8) { + if (/* tag */(typeof match === "number" || typeof match === "string") && match === /* T_COMMA */8) { return sequence(env, { hd: expr, tl: /* [] */0 @@ -15207,7 +15228,8 @@ function predicate(env) { const loc = btwn(checks_loc, rparen_loc); return [ loc, - /* Declared */{ + { + TAG: /* Declared */0, _0: exp } ]; @@ -15426,7 +15448,7 @@ function parse(content, options) { const loc = function ($$location) { const match = $$location.source; const source = match !== undefined ? ( - typeof match === "number" ? string("(global)") : string(match._0) + /* tag */typeof match === "number" || typeof match === "string" ? string("(global)") : string(match._0) ) : $$null; return obj([ [ @@ -15483,7 +15505,7 @@ function parse(content, options) { const _type = function (param) { const t = param[1]; const loc = param[0]; - if (typeof t === "number") { + if (/* tag */typeof t === "number" || typeof t === "string") { switch (t) { case /* Any */0 : return node("AnyTypeAnnotation", loc, []); @@ -15502,7 +15524,7 @@ function parse(content, options) { } } else { - switch (t.TAG | 0) { + switch (t.TAG) { case /* Nullable */0 : let t$1 = t._0; return node("NullableTypeAnnotation", loc, [[ @@ -15635,10 +15657,10 @@ function parse(content, options) { const expression = function (param) { const arr = param[1]; const loc = param[0]; - if (typeof arr === "number") { + if (/* tag */typeof arr === "number" || typeof arr === "string") { return node("ThisExpression", loc, []); } - switch (arr.TAG | 0) { + switch (arr.TAG) { case /* Array */0 : return node("ArrayExpression", loc, [[ "elements", @@ -15713,7 +15735,7 @@ function parse(content, options) { case /* Unary */5 : const unary = arr._0; const match = unary.operator; - if (match >= 7) { + if (match === /* Await */7) { return node("AwaitExpression", loc, [[ "argument", expression(unary.argument) @@ -15914,7 +15936,8 @@ function parse(content, options) { case /* Update */8 : const update = arr._0; const match$4 = update.operator; - const operator$3 = match$4 ? "--" : "++"; + let operator$3; + operator$3 = match$4 === /* Increment */0 ? "++" : "--"; return node("UpdateExpression", loc, [ [ "operator", @@ -15932,7 +15955,8 @@ function parse(content, options) { case /* Logical */9 : const logical = arr._0; const match$5 = logical.operator; - const operator$4 = match$5 ? "&&" : "||"; + let operator$4; + operator$4 = match$5 === /* Or */0 ? "||" : "&&"; return node("LogicalExpression", loc, [ [ "operator", @@ -16147,7 +16171,7 @@ function parse(content, options) { const pattern = function (param) { const obj = param[1]; const loc = param[0]; - switch (obj.TAG | 0) { + switch (obj.TAG) { case /* Object */0 : const obj$1 = obj._0; return node("ObjectPattern", loc, [ @@ -16199,7 +16223,7 @@ function parse(content, options) { const prop = match[1]; const lit = prop.key; let match$1; - switch (lit.TAG | 0) { + switch (lit.TAG) { case /* Literal */0 : match$1 = [ literal(lit._0), @@ -16325,14 +16349,14 @@ function parse(content, options) { const statement = function (param) { const b = param[1]; const loc = param[0]; - if (typeof b === "number") { + if (/* tag */typeof b === "number" || typeof b === "string") { if (b === /* Empty */0) { return node("EmptyStatement", loc, []); } else { return node("DebuggerStatement", loc, []); } } - switch (b.TAG | 0) { + switch (b.TAG) { case /* Block */0 : return block([ loc, @@ -16707,7 +16731,7 @@ function parse(content, options) { const match$3 = $$export.declaration; let declaration; if (match$3 !== undefined) { - switch (match$3.TAG | 0) { + switch (match$3.TAG) { case /* Variable */0 : declaration = declare_variable(match$3._0); break; @@ -16774,13 +16798,13 @@ function parse(content, options) { ], [ "exportKind", - string($$export$1.exportKind ? "value" : "type") + string(export_kind($$export$1.exportKind)) ] ]); case /* ImportDeclaration */29 : const $$import = b._0; const specifiers = Stdlib__List.map((function (id) { - switch (id.TAG | 0) { + switch (id.TAG) { case /* ImportNamedSpecifier */0 : const match = id._0; let local_id = match.local; @@ -16864,10 +16888,10 @@ function parse(content, options) { const value = lit.value; const loc = param[0]; let value_; - if (typeof value === "number") { + if (/* tag */typeof value === "number" || typeof value === "string") { value_ = $$null; } else { - switch (value.TAG | 0) { + switch (value.TAG) { case /* String */0 : value_ = string(value._0); break; @@ -16886,7 +16910,7 @@ function parse(content, options) { } let props; let exit = 0; - if (typeof value === "number" || value.TAG !== /* RegExp */3) { + if (/* tag */typeof value === "number" || typeof value === "string" || value.TAG !== /* RegExp */3) { exit = 1; } else { const match$1 = value._0; @@ -17002,7 +17026,7 @@ function parse(content, options) { const jsx_child = function (param) { const element = param[1]; const loc = param[0]; - switch (element.TAG | 0) { + switch (element.TAG) { case /* Element */0 : return jsx_element([ loc, @@ -17087,7 +17111,7 @@ function parse(content, options) { const prop = match[1]; const lit = prop.key; let match$1; - switch (lit.TAG | 0) { + switch (lit.TAG) { case /* Literal */0 : match$1 = [ literal(lit._0), @@ -17329,7 +17353,7 @@ function parse(content, options) { } }; const jsx_name = function (id) { - switch (id.TAG | 0) { + switch (id.TAG) { case /* Identifier */0 : return jsx_identifier(id._0); case /* NamespacedName */1 : @@ -17339,6 +17363,13 @@ function parse(content, options) { } }; + const export_kind = function (param) { + if (param === /* ExportType */0) { + return "type"; + } else { + return "value"; + } + }; const export_specifiers = function (param) { if (param !== undefined) { if (param.TAG === /* ExportSpecifiers */0) { @@ -17487,7 +17518,7 @@ function parse(content, options) { const method_ = param[1]; const key = method_.key; let match; - switch (key.TAG | 0) { + switch (key.TAG) { case /* Literal */0 : match = [ literal(key._0), @@ -17555,7 +17586,7 @@ function parse(content, options) { const prop = param$1[1]; const lit = prop.key; let match$1; - switch (lit.TAG | 0) { + switch (lit.TAG) { case /* Literal */0 : match$1 = [ literal(lit._0), @@ -17677,7 +17708,7 @@ function parse(content, options) { const prop = param[1]; const lit = prop.key; let key; - switch (lit.TAG | 0) { + switch (lit.TAG) { case /* Literal */0 : key = literal(lit._0); break; @@ -17713,10 +17744,10 @@ function parse(content, options) { const type_param = function (param) { const tp = param[1]; const variance = function (param) { - if (param) { - return string("minus"); - } else { + if (param === /* Plus */0) { return string("plus"); + } else { + return string("minus"); } }; return node("TypeParameter", param[0], [ diff --git a/jscomp/test/dist/jscomp/test/format_test.js b/jscomp/test/dist/jscomp/test/format_test.js index 89ab5a5646..3d3485f3be 100644 --- a/jscomp/test/dist/jscomp/test/format_test.js +++ b/jscomp/test/dist/jscomp/test/format_test.js @@ -43,14 +43,16 @@ function eq3(loc, a, b, c) { } function $caret$caret(param, param$1) { - return /* Format */{ + return { + TAG: /* Format */0, _0: CamlinternalFormatBasics.concat_fmt(param._0, param$1._0), _1: param._1 + ("%," + param$1._1) }; } function u(param) { - return $caret$caret(/* Format */{ + return $caret$caret({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "xx ", @@ -61,7 +63,8 @@ function u(param) { } }, _1: "xx %s" - }, /* Format */{ + }, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "yy", @@ -75,7 +78,8 @@ const M = {}; eq("File \"jscomp/test/format_test.ml\", line 31, characters 5-12", Curry._1(Stdlib__Format.asprintf(u(undefined)), "x"), "xx xyy"); -eq("File \"jscomp/test/format_test.ml\", line 32, characters 5-12", Curry._1(Stdlib__Format.asprintf(/* Format */{ +eq("File \"jscomp/test/format_test.ml\", line 32, characters 5-12", Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int32 */5, _0: /* Int_d */0, @@ -86,7 +90,8 @@ eq("File \"jscomp/test/format_test.ml\", line 32, characters 5-12", Curry._1(Std _1: "%ld" }), -2147483648), "-2147483648"); -eq("File \"jscomp/test/format_test.ml\", line 33, characters 5-12", Curry._1(Stdlib__Format.asprintf(/* Format */{ +eq("File \"jscomp/test/format_test.ml\", line 33, characters 5-12", Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -160,7 +165,8 @@ f("File \"jscomp/test/format_test.ml\", line 82, characters 6-13", { }); function sl(f) { - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -243,7 +249,8 @@ const literals = { aux_list("File \"jscomp/test/format_test.ml\", line 112, characters 11-18", literals); -eq("File \"jscomp/test/format_test.ml\", line 115, characters 5-12", Curry._1(Stdlib__Printf.sprintf(/* Format */{ +eq("File \"jscomp/test/format_test.ml\", line 115, characters 5-12", Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -258,7 +265,8 @@ eq("File \"jscomp/test/format_test.ml\", line 115, characters 5-12", Curry._1(St }), 7.875), "0X1.F8P+2"); function scan_float(loc, s, expect) { - Curry._1(Stdlib__Scanf.sscanf(s, /* Format */{ + Curry._1(Stdlib__Scanf.sscanf(s, { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ diff --git a/jscomp/test/dist/jscomp/test/fun_pattern_match.js b/jscomp/test/dist/jscomp/test/fun_pattern_match.js index 9761df2bf2..2c9073a3f4 100644 --- a/jscomp/test/dist/jscomp/test/fun_pattern_match.js +++ b/jscomp/test/dist/jscomp/test/fun_pattern_match.js @@ -16,53 +16,43 @@ function f2(param, param$1) { function f3(param, param$1) { const lhs = param.rank; const rhs = param$1.rank; - if (typeof lhs === "number") { - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/test/fun_pattern_match.ml", - 41, - 9 - ] - }); - } - if (typeof rhs === "number") { - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/test/fun_pattern_match.ml", - 41, - 9 - ] - }); + if (/* tag */typeof lhs === "number" || typeof lhs === "string") { + lhs === /* Uninitialized */0; + } else { + if (!/* tag */(typeof rhs === "number" || typeof rhs === "string")) { + return Caml.caml_int_compare(lhs._0, rhs._0); + } + rhs === /* Uninitialized */0; } - return Caml.caml_int_compare(lhs._0, rhs._0); + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/test/fun_pattern_match.ml", + 41, + 9 + ] + }); } function f4(param, param$1) { const lhs = param.rank; const rhs = param$1.rank; - if (typeof lhs === "number") { - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/test/fun_pattern_match.ml", - 49, - 9 - ] - }); - } - if (typeof rhs === "number") { - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/test/fun_pattern_match.ml", - 49, - 9 - ] - }); + if (/* tag */typeof lhs === "number" || typeof lhs === "string") { + lhs === /* Uninitialized */0; + } else { + if (!/* tag */(typeof rhs === "number" || typeof rhs === "string")) { + return Caml.caml_int_compare(lhs._0, rhs._0); + } + rhs === /* Uninitialized */0; } - return Caml.caml_int_compare(lhs._0, rhs._0); + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/test/fun_pattern_match.ml", + 49, + 9 + ] + }); } const x = { diff --git a/jscomp/test/dist/jscomp/test/gpr_1285_test.js b/jscomp/test/dist/jscomp/test/gpr_1285_test.js index a30b2dd004..25056053e1 100644 --- a/jscomp/test/dist/jscomp/test/gpr_1285_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_1285_test.js @@ -31,13 +31,15 @@ function eq(loc, x, y) { }; } -const object_tables = /* Cons */{ +const object_tables = { + TAG: /* Cons */0, key: undefined, data: undefined, next: undefined }; -const object_tables$1 = /* Cons */{ +const object_tables$1 = { + TAG: /* Cons */0, key: undefined, data: undefined, next: undefined diff --git a/jscomp/test/dist/jscomp/test/gpr_1658_test.js b/jscomp/test/dist/jscomp/test/gpr_1658_test.js index c94d6b511f..02a9f0b112 100644 --- a/jscomp/test/dist/jscomp/test/gpr_1658_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_1658_test.js @@ -33,7 +33,7 @@ eq("File \"jscomp/test/gpr_1658_test.ml\", line 11, characters 7-14", null, null const match = Js__Js_types.classify(null); -if (match === 2) { +if (/* tag */(typeof match === "number" || typeof match === "string") && match === /* JSNull */2) { eq("File \"jscomp/test/gpr_1658_test.ml\", line 14, characters 11-18", true, true); } else { eq("File \"jscomp/test/gpr_1658_test.ml\", line 16, characters 11-18", true, false); diff --git a/jscomp/test/dist/jscomp/test/gpr_1698_test.js b/jscomp/test/dist/jscomp/test/gpr_1698_test.js index 71b1359b89..3ea2b6d263 100644 --- a/jscomp/test/dist/jscomp/test/gpr_1698_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_1698_test.js @@ -6,7 +6,7 @@ const Caml_js_exceptions = require("melange.js/caml_js_exceptions.js"); function is_number(_expr) { while(true) { const expr = _expr; - switch (expr.TAG | 0) { + switch (expr.TAG) { case /* Val */0 : if (expr._0.TAG === /* Natural */0) { return true; @@ -38,9 +38,9 @@ function compare(context, state, _a, _b) { let exit$1 = 0; let exit$2 = 0; let exit$3 = 0; - switch (a.TAG | 0) { + switch (a.TAG) { case /* Val */0 : - switch (b.TAG | 0) { + switch (b.TAG) { case /* Val */0 : return 111; case /* Neg */1 : @@ -73,7 +73,7 @@ function compare(context, state, _a, _b) { exit$3 = 5; break; case /* Frac */4 : - switch (b.TAG | 0) { + switch (b.TAG) { case /* Val */0 : throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", @@ -104,7 +104,7 @@ function compare(context, state, _a, _b) { } break; case /* Gcd */5 : - switch (b.TAG | 0) { + switch (b.TAG) { case /* Neg */1 : exit$3 = 5; break; @@ -149,7 +149,7 @@ function compare(context, state, _a, _b) { } } if (exit$1 === 3) { - switch (a.TAG | 0) { + switch (a.TAG) { case /* Sum */2 : exit = 1; break; @@ -164,7 +164,7 @@ function compare(context, state, _a, _b) { } switch (exit) { case 1 : - switch (b.TAG | 0) { + switch (b.TAG) { case /* Pow */3 : return 1; case /* Gcd */5 : diff --git a/jscomp/test/dist/jscomp/test/gpr_1946_test.js b/jscomp/test/dist/jscomp/test/gpr_1946_test.js index a933c43c18..4aeb10996a 100644 --- a/jscomp/test/dist/jscomp/test/gpr_1946_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_1946_test.js @@ -50,7 +50,7 @@ eq("File \"jscomp/test/gpr_1946_test.ml\", line 29, characters 6-13", [ console.log(({ "5": 3 - }).TAG | 0); + }).TAG); Mt.from_pair_suites("File \"jscomp/test/gpr_1946_test.ml\", line 32, characters 23-30", suites.contents); diff --git a/jscomp/test/dist/jscomp/test/gpr_2250_test.js b/jscomp/test/dist/jscomp/test/gpr_2250_test.js index 42ced36bb4..f8c9d69adb 100644 --- a/jscomp/test/dist/jscomp/test/gpr_2250_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_2250_test.js @@ -31,7 +31,8 @@ function eq(loc, x, y) { }; } -const object_tables = /* Cons */{ +const object_tables = { + TAG: /* Cons */0, key: undefined, data: undefined, next: undefined diff --git a/jscomp/test/dist/jscomp/test/gpr_2413_test.js b/jscomp/test/dist/jscomp/test/gpr_2413_test.js index 102719ff3c..800ae13493 100644 --- a/jscomp/test/dist/jscomp/test/gpr_2413_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_2413_test.js @@ -3,7 +3,7 @@ function f(param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* A */0 : const a = param._0; if (a.TAG === /* P */0) { diff --git a/jscomp/test/dist/jscomp/test/gpr_2642_test.js b/jscomp/test/dist/jscomp/test/gpr_2642_test.js index 6038e4ff2b..ee9e54b805 100644 --- a/jscomp/test/dist/jscomp/test/gpr_2642_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_2642_test.js @@ -5,7 +5,7 @@ function isfree(id, _id$p) { while(true) { const id$p = _id$p; - switch (id$p.TAG | 0) { + switch (id$p.TAG) { case /* Pident */0 : return id === id$p._0; case /* Pdot */1 : diff --git a/jscomp/test/dist/jscomp/test/gpr_3209_test.js b/jscomp/test/dist/jscomp/test/gpr_3209_test.js index caf69a6e83..d9348e5f4b 100644 --- a/jscomp/test/dist/jscomp/test/gpr_3209_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_3209_test.js @@ -3,7 +3,7 @@ function f9(param) { - if (typeof param === "number") { + if (/* tag */typeof param === "number" || typeof param === "string") { switch (param) { case /* T60 */0 : case /* T61 */1 : @@ -13,7 +13,7 @@ function f9(param) { return 3; } } else { - switch (param.TAG | 0) { + switch (param.TAG) { case /* T64 */0 : case /* T65 */1 : return 2; diff --git a/jscomp/test/dist/jscomp/test/gpr_3536_test.js b/jscomp/test/dist/jscomp/test/gpr_3536_test.js index c5f2f142ed..007c670343 100644 --- a/jscomp/test/dist/jscomp/test/gpr_3536_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_3536_test.js @@ -36,7 +36,8 @@ Mt.from_pair_suites("Gpr_3536_test", suites.contents); const v = 5; -const u = /* Some */{ +const u = { + TAG: /* Some */0, _0: 3 }; diff --git a/jscomp/test/dist/jscomp/test/gpr_3546_test.js b/jscomp/test/dist/jscomp/test/gpr_3546_test.js index a2a9118a35..a1c0bd6f9a 100644 --- a/jscomp/test/dist/jscomp/test/gpr_3546_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_3546_test.js @@ -3,7 +3,8 @@ function t_error3(param_0) { - return /* T_error3 */{ + return { + TAG: /* T_error3 */0, _0: param_0 }; } diff --git a/jscomp/test/dist/jscomp/test/gpr_3609_test.js b/jscomp/test/dist/jscomp/test/gpr_3609_test.js index c37f11e498..e6802eab10 100644 --- a/jscomp/test/dist/jscomp/test/gpr_3609_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_3609_test.js @@ -3,7 +3,7 @@ function func(state) { - if (typeof state === "number") { + if (/* tag */typeof state === "number" || typeof state === "string") { return 0; } else { return 0 + state._0 | 0; diff --git a/jscomp/test/dist/jscomp/test/gpr_3697_test.js b/jscomp/test/dist/jscomp/test/gpr_3697_test.js index 4ba7aac218..d7a6e5d21f 100644 --- a/jscomp/test/dist/jscomp/test/gpr_3697_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_3697_test.js @@ -4,7 +4,8 @@ const CamlinternalLazy = require("melange/camlinternalLazy.js"); function fix(param) { - return /* Fix */{ + return { + TAG: /* Fix */0, _0: { LAZY_DONE: false, VAL: (function () { diff --git a/jscomp/test/dist/jscomp/test/gpr_4407_test.js b/jscomp/test/dist/jscomp/test/gpr_4407_test.js index f082a6aceb..2cec5d2473 100644 --- a/jscomp/test/dist/jscomp/test/gpr_4407_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_4407_test.js @@ -16,7 +16,8 @@ function eq(loc, x, y) { Mt.eq_suites(test_id, suites, loc, x, y); } -const non_debug_u = /* A */{ +const non_debug_u = { + TAG: /* A */0, _0: 1, _1: 2 }; diff --git a/jscomp/test/dist/jscomp/test/gpr_4519_test.js b/jscomp/test/dist/jscomp/test/gpr_4519_test.js index be9bae9068..0b0c3ee123 100644 --- a/jscomp/test/dist/jscomp/test/gpr_4519_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_4519_test.js @@ -17,17 +17,17 @@ function eq(loc, x, y) { function nextFor(x) { if (x !== undefined) { - if (x) { - return ; - } else { + if (x === /* Required */0) { return /* Optional */1; + } else { + return ; } } else { return /* Required */0; } } -eq("File \"jscomp/test/gpr_4519_test.ml\", line 17, characters 6-13", /* Optional */1, /* Optional */1); +eq("File \"jscomp/test/gpr_4519_test.ml\", line 17, characters 6-13", nextFor(/* Required */0), /* Optional */1); Mt.from_pair_suites("Gpr_4519_test", suites.contents); diff --git a/jscomp/test/dist/jscomp/test/gpr_4900_test.js b/jscomp/test/dist/jscomp/test/gpr_4900_test.js index 00f331dab2..09fbf8ffd4 100644 --- a/jscomp/test/dist/jscomp/test/gpr_4900_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_4900_test.js @@ -12,20 +12,18 @@ const id = { }; function showToJs(x) { - if (typeof x === "number" && !x) { + if (/* tag */(typeof x === "number" || typeof x === "string") && x === /* No */0) { return false; } else { return true; } } -Mt.eq_suites(id, suites, "File \"jscomp/test/gpr_4900_test.ml\", line 13, characters 33-40", showToJs(/* Yes */1), true); +Mt.eq_suites(id, suites, "File \"jscomp/test/gpr_4900_test.ml\", line 13, characters 33-40", true, true); -Mt.eq_suites(id, suites, "File \"jscomp/test/gpr_4900_test.ml\", line 14, characters 33-40", showToJs(/* No */0), false); +Mt.eq_suites(id, suites, "File \"jscomp/test/gpr_4900_test.ml\", line 14, characters 33-40", false, false); -Mt.eq_suites(id, suites, "File \"jscomp/test/gpr_4900_test.ml\", line 15, characters 33-40", showToJs(/* After */{ - _0: 3 - }), true); +Mt.eq_suites(id, suites, "File \"jscomp/test/gpr_4900_test.ml\", line 15, characters 33-40", true, true); Mt.from_pair_suites("File \"jscomp/test/gpr_4900_test.ml\", line 17, characters 20-27", suites.contents); diff --git a/jscomp/test/dist/jscomp/test/gpr_4924_test.js b/jscomp/test/dist/jscomp/test/gpr_4924_test.js index da32a09632..ec8f5a22b0 100644 --- a/jscomp/test/dist/jscomp/test/gpr_4924_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_4924_test.js @@ -12,7 +12,7 @@ const id = { }; function u(b) { - if (typeof b === "number" && !b) { + if (/* tag */(typeof b === "number" || typeof b === "string") && b === /* A */0) { return 0; } else { return 1; @@ -20,7 +20,7 @@ function u(b) { } function u1(b) { - if (typeof b === "number" && !b) { + if (/* tag */(typeof b === "number" || typeof b === "string") && b === /* A */0) { return true; } else { return false; @@ -28,23 +28,21 @@ function u1(b) { } function u2(b) { - if (typeof b === "number" && !b) { + if (/* tag */(typeof b === "number" || typeof b === "string") && b === /* A */0) { return false; } else { return true; } } -Mt.eq_suites(id, suites, "File \"jscomp/test/gpr_4924_test.ml\", line 25, characters 33-40", u2(/* A */0), false); +Mt.eq_suites(id, suites, "File \"jscomp/test/gpr_4924_test.ml\", line 25, characters 33-40", false, false); -Mt.eq_suites(id, suites, "File \"jscomp/test/gpr_4924_test.ml\", line 26, characters 33-40", u2(/* B */1), true); +Mt.eq_suites(id, suites, "File \"jscomp/test/gpr_4924_test.ml\", line 26, characters 33-40", true, true); -Mt.eq_suites(id, suites, "File \"jscomp/test/gpr_4924_test.ml\", line 27, characters 33-40", u2(/* C */{ - _0: 2 - }), true); +Mt.eq_suites(id, suites, "File \"jscomp/test/gpr_4924_test.ml\", line 27, characters 33-40", true, true); function u3(b) { - if (typeof b === "number" && !b) { + if (/* tag */(typeof b === "number" || typeof b === "string") && b === /* A */0) { return 3; } else { return 4; @@ -52,7 +50,7 @@ function u3(b) { } function u4(b) { - if (typeof b === "number" && !b) { + if (/* tag */(typeof b === "number" || typeof b === "string") && b === /* A */0) { return 3; } else { return 4; @@ -60,7 +58,7 @@ function u4(b) { } function u5(b) { - if (typeof b === "number" && !b) { + if (/* tag */(typeof b === "number" || typeof b === "string") && b === /* A */0) { return false; } else { return true; @@ -68,7 +66,7 @@ function u5(b) { } function u6(b) { - if (typeof b === "number" && !b) { + if (/* tag */(typeof b === "number" || typeof b === "string") && b === /* A */0) { return true; } else { return false; diff --git a/jscomp/test/dist/jscomp/test/gpr_5169_test.js b/jscomp/test/dist/jscomp/test/gpr_5169_test.js index 0e1145ab5c..03e78d5f64 100644 --- a/jscomp/test/dist/jscomp/test/gpr_5169_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_5169_test.js @@ -26,13 +26,15 @@ const h = 1; const i = /* None */0; -const j = /* Some */{ +const j = { + TAG: /* Some */0, _0: 1 }; const k = /* None */0; -const l = /* Some */{ +const l = { + TAG: /* Some */0, _0: 1 }; diff --git a/jscomp/test/dist/jscomp/test/gpr_5280_optimize_test.js b/jscomp/test/dist/jscomp/test/gpr_5280_optimize_test.js index 7281d8a471..c733d205bc 100644 --- a/jscomp/test/dist/jscomp/test/gpr_5280_optimize_test.js +++ b/jscomp/test/dist/jscomp/test/gpr_5280_optimize_test.js @@ -2,12 +2,15 @@ 'use strict'; -const a = /* Color */{ +const a = { + TAG: /* Color */0, _0: "#ffff" }; -const c = "white"; +let c; + +c = /* tag */typeof a === "number" || typeof a === "string" ? "orange" : "white"; exports.a = a; exports.c = c; -/* No side effect */ +/* c Not a pure module */ diff --git a/jscomp/test/dist/jscomp/test/hamming_test.js b/jscomp/test/dist/jscomp/test/hamming_test.js index f9a08df578..c7ca2377bc 100644 --- a/jscomp/test/dist/jscomp/test/hamming_test.js +++ b/jscomp/test/dist/jscomp/test/hamming_test.js @@ -90,7 +90,8 @@ function pr(param) { const nh = param[1]; const nl = param[0]; if (Caml_int64.compare(nh, n0) === 0) { - return Curry._1(Stdlib__Printf.bprintf(buf, /* Format */{ + return Curry._1(Stdlib__Printf.bprintf(buf, { + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_d */0, @@ -105,7 +106,8 @@ function pr(param) { _1: "%Ld\n" }), nl); } else { - return Curry._2(Stdlib__Printf.bprintf(buf, /* Format */{ + return Curry._2(Stdlib__Printf.bprintf(buf, { + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_d */0, @@ -137,7 +139,8 @@ function map(f, l) { LAZY_DONE: false, VAL: (function () { const match = CamlinternalLazy.force(l); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: Curry._1(f, match._0), _1: map(f, match._1) }; @@ -157,17 +160,20 @@ function merge(cmp, l1, l2) { const x1 = match._0; const c = Curry._2(cmp, x1, x2); if (c === 0) { - return /* Cons */{ + return { + TAG: /* Cons */0, _0: x1, _1: merge(cmp, ll1, ll2) }; } else if (c < 0) { - return /* Cons */{ + return { + TAG: /* Cons */0, _0: x1, _1: merge(cmp, ll1, l2) }; } else { - return /* Cons */{ + return { + TAG: /* Cons */0, _0: x2, _1: merge(cmp, l1, ll2) }; @@ -201,7 +207,8 @@ function iter_interval(f, _l, _param) { const hamming = { LAZY_DONE: false, VAL: (function () { - return /* Cons */{ + return { + TAG: /* Cons */0, _0: nn1, _1: merge(cmp, ham2, merge(cmp, ham3, ham5)) }; diff --git a/jscomp/test/dist/jscomp/test/inline_map2_test.js b/jscomp/test/dist/jscomp/test/inline_map2_test.js index 3a1d130162..6dc34ae715 100644 --- a/jscomp/test/dist/jscomp/test/inline_map2_test.js +++ b/jscomp/test/dist/jscomp/test/inline_map2_test.js @@ -11,16 +11,17 @@ const Stdlib__List = require("melange/list.js"); function Make(Ord) { const height = function (param) { - if (param) { - return param._4; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param._4; } }; const create = function (l, x, d, r) { const hl = height(l); const hr = height(r); - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: x, _2: d, @@ -29,7 +30,8 @@ function Make(Ord) { }; }; const singleton = function (x, d) { - return /* Node */{ + return { + TAG: /* Node */0, _0: /* Empty */0, _1: x, _2: d, @@ -38,32 +40,35 @@ function Make(Ord) { }; }; const bal = function (l, x, d, r) { - const hl = l ? l._4 : 0; - const hr = r ? r._4 : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l._4; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r._4; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l._3; - const ld = l._2; - const lv = l._1; - const ll = l._0; - if (height(ll) >= height(lr)) { - return create(ll, lv, ld, create(lr, x, d, r)); - } - if (lr) { - return create(create(ll, lv, ld, lr._0), lr._1, lr._2, create(lr._3, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l._3; + const ld = l._2; + const lv = l._1; + const ll = l._0; + if (height(ll) >= height(lr)) { + return create(ll, lv, ld, create(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, ld, lr._0), lr._1, lr._2, create(lr._3, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: x, _2: d, @@ -71,37 +76,38 @@ function Make(Ord) { _4: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r._3; - const rd = r._2; - const rv = r._1; - const rl = r._0; - if (height(rr) >= height(rl)) { - return create(create(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create(create(l, x, d, rl._0), rl._1, rl._2, create(rl._3, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r._3; + const rd = r._2; + const rv = r._1; + const rl = r._0; + if (height(rr) >= height(rl)) { + return create(create(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, x, d, rl._0), rl._1, rl._2, create(rl._3, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); }; const is_empty = function (param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } }; const add = function (x, data, param) { - if (!param) { - return /* Node */{ + if (/* tag */typeof param === "number" || typeof param === "string") { + return { + TAG: /* Node */0, _0: /* Empty */0, _1: x, _2: data, @@ -115,7 +121,8 @@ function Make(Ord) { const l = param._0; const c = Curry._2(Ord.compare, x, v); if (c === 0) { - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: x, _2: data, @@ -131,23 +138,23 @@ function Make(Ord) { const find = function (x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(Ord.compare, x, param._1); - if (c === 0) { - return param._2; - } - _param = c < 0 ? param._0 : param._3; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(Ord.compare, x, param._1); + if (c === 0) { + return param._2; + } + _param = c < 0 ? param._0 : param._3; + continue ; }; }; const mem = function (x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(Ord.compare, x, param._1); @@ -161,56 +168,57 @@ function Make(Ord) { const min_binding = function (_param) { while(true) { const param = _param; - if (param) { - const l = param._0; - if (!l) { - return [ - param._1, - param._2 - ]; - } - _param = l; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const l = param._0; + if (/* tag */typeof l === "number" || typeof l === "string") { + return [ + param._1, + param._2 + ]; + } + _param = l; + continue ; }; }; const max_binding = function (_param) { while(true) { const param = _param; - if (param) { - if (!param._3) { - return [ - param._1, - param._2 - ]; - } - _param = param._3; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + let tmp = param._3; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return [ + param._1, + param._2 + ]; + } + _param = param._3; + continue ; }; }; const remove_min_binding = function (param) { - if (param) { - const l = param._0; - if (l) { - return bal(remove_min_binding(l), param._1, param._2, param._3); - } else { - return param._3; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Invalid_argument", { + MEL_EXN_ID: "Invalid_argument", + _1: "Map.remove_min_elt" + }); + } + const l = param._0; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param._3; + } else { + return bal(remove_min_binding(l), param._1, param._2, param._3); } - throw new Caml_js_exceptions.MelangeError("Invalid_argument", { - MEL_EXN_ID: "Invalid_argument", - _1: "Map.remove_min_elt" - }); }; const remove = function (x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const r = param._3; @@ -219,10 +227,10 @@ function Make(Ord) { const l = param._0; const c = Curry._2(Ord.compare, x, v); if (c === 0) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return r; } - if (!r) { + if (/* tag */typeof r === "number" || typeof r === "string") { return l; } const match = min_binding(r); @@ -236,7 +244,7 @@ function Make(Ord) { const iter = function (f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } iter(f, param._0); @@ -246,13 +254,14 @@ function Make(Ord) { }; }; const map = function (f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const l$p = map(f, param._0); const d$p = Curry._1(f, param._2); const r$p = map(f, param._3); - return /* Node */{ + return { + TAG: /* Node */0, _0: l$p, _1: param._1, _2: d$p, @@ -261,14 +270,15 @@ function Make(Ord) { }; }; const mapi = function (f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param._1; const l$p = mapi(f, param._0); const d$p = Curry._2(f, v, param._2); const r$p = mapi(f, param._3); - return /* Node */{ + return { + TAG: /* Node */0, _0: l$p, _1: v, _2: d$p, @@ -280,7 +290,7 @@ function Make(Ord) { while(true) { const accu = _accu; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return accu; } _accu = Curry._3(f, m._1, m._2, fold(f, m._0, accu)); @@ -291,7 +301,7 @@ function Make(Ord) { const for_all = function (p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; } if (!Curry._2(p, param._1, param._2)) { @@ -307,7 +317,7 @@ function Make(Ord) { const exists = function (p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } if (Curry._2(p, param._1, param._2)) { @@ -321,28 +331,28 @@ function Make(Ord) { }; }; const add_min_binding = function (k, v, param) { - if (param) { - return bal(add_min_binding(k, v, param._0), param._1, param._2, param._3); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(k, v); + } else { + return bal(add_min_binding(k, v, param._0), param._1, param._2, param._3); } }; const add_max_binding = function (k, v, param) { - if (param) { - return bal(param._0, param._1, param._2, add_max_binding(k, v, param._3)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(k, v); + } else { + return bal(param._0, param._1, param._2, add_max_binding(k, v, param._3)); } }; const join = function (l, v, d, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_binding(v, d, r); } - if (!r) { + const lh = l._4; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_binding(v, d, l); } const rh = r._4; - const lh = l._4; if (lh > (rh + 2 | 0)) { return bal(l._0, l._1, l._2, join(l._3, v, d, r)); } else if (rh > (lh + 2 | 0)) { @@ -352,10 +362,10 @@ function Make(Ord) { } }; const concat = function (t1, t2) { - if (!t1) { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; } - if (!t2) { + if (/* tag */typeof t2 === "number" || typeof t2 === "string") { return t1; } const match = min_binding(t2); @@ -369,7 +379,7 @@ function Make(Ord) { } }; const split = function (x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, undefined, @@ -404,32 +414,35 @@ function Make(Ord) { ]; }; const merge = function (f, s1, s2) { - if (s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + return /* Empty */0; + } + + } else { const v1 = s1._1; if (s1._4 >= height(s2)) { const match = split(v1, s2); return concat_or_join(merge(f, s1._0, match[0]), v1, Curry._3(f, v1, Caml_option.some(s1._2), match[1]), merge(f, s1._3, match[2])); } - } else if (!s2) { - return /* Empty */0; } - if (s2) { - const v2 = s2._1; - const match$1 = split(v2, s1); - return concat_or_join(merge(f, match$1[0], s2._0), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2._2)), merge(f, match$1[2], s2._3)); + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/test/inline_map2_test.ml", + 270, + 10 + ] + }); } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/test/inline_map2_test.ml", - 270, - 10 - ] - }); + const v2 = s2._1; + const match$1 = split(v2, s1); + return concat_or_join(merge(f, match$1[0], s2._0), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2._2)), merge(f, match$1[2], s2._3)); }; const filter = function (p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const d = param._2; @@ -444,7 +457,7 @@ function Make(Ord) { } }; const partition = function (p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, /* Empty */0 @@ -475,10 +488,11 @@ function Make(Ord) { while(true) { const e = _e; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: m._1, _1: m._2, _2: m._3, @@ -494,14 +508,14 @@ function Make(Ord) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return -1; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 0; + } else { + return -1; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 1; } const c = Curry._2(Ord.compare, e1._0, e2._0); @@ -523,14 +537,14 @@ function Make(Ord) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return false; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return true; + } else { + return false; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return false; } if (Curry._2(Ord.compare, e1._0, e2._0) !== 0) { @@ -545,17 +559,17 @@ function Make(Ord) { }; }; const cardinal = function (param) { - if (param) { - return (cardinal(param._0) + 1 | 0) + cardinal(param._3) | 0; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return (cardinal(param._0) + 1 | 0) + cardinal(param._3) | 0; } }; const bindings_aux = function (_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param._0; @@ -612,17 +626,18 @@ function Make(Ord) { } function height(param) { - if (param) { - return param._4; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param._4; } } function create(l, x, d, r) { const hl = height(l); const hr = height(r); - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: x, _2: d, @@ -632,7 +647,8 @@ function create(l, x, d, r) { } function singleton(x, d) { - return /* Node */{ + return { + TAG: /* Node */0, _0: /* Empty */0, _1: x, _2: d, @@ -642,32 +658,35 @@ function singleton(x, d) { } function bal(l, x, d, r) { - const hl = l ? l._4 : 0; - const hr = r ? r._4 : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l._4; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r._4; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l._3; - const ld = l._2; - const lv = l._1; - const ll = l._0; - if (height(ll) >= height(lr)) { - return create(ll, lv, ld, create(lr, x, d, r)); - } - if (lr) { - return create(create(ll, lv, ld, lr._0), lr._1, lr._2, create(lr._3, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l._3; + const ld = l._2; + const lv = l._1; + const ll = l._0; + if (height(ll) >= height(lr)) { + return create(ll, lv, ld, create(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, ld, lr._0), lr._1, lr._2, create(lr._3, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: x, _2: d, @@ -675,22 +694,22 @@ function bal(l, x, d, r) { _4: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r._3; - const rd = r._2; - const rv = r._1; - const rl = r._0; - if (height(rr) >= height(rl)) { - return create(create(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create(create(l, x, d, rl._0), rl._1, rl._2, create(rl._3, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r._3; + const rd = r._2; + const rv = r._1; + const rl = r._0; + if (height(rr) >= height(rl)) { + return create(create(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, x, d, rl._0), rl._1, rl._2, create(rl._3, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -698,16 +717,17 @@ function bal(l, x, d, r) { } function is_empty(param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } } function add(x, data, param) { - if (!param) { - return /* Node */{ + if (/* tag */typeof param === "number" || typeof param === "string") { + return { + TAG: /* Node */0, _0: /* Empty */0, _1: x, _2: data, @@ -721,7 +741,8 @@ function add(x, data, param) { const l = param._0; const c = Caml.caml_int_compare(x, v); if (c === 0) { - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: x, _2: data, @@ -738,24 +759,24 @@ function add(x, data, param) { function find(x, _param) { while(true) { const param = _param; - if (param) { - const c = Caml.caml_int_compare(x, param._1); - if (c === 0) { - return param._2; - } - _param = c < 0 ? param._0 : param._3; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Caml.caml_int_compare(x, param._1); + if (c === 0) { + return param._2; + } + _param = c < 0 ? param._0 : param._3; + continue ; }; } function mem(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Caml.caml_int_compare(x, param._1); @@ -770,59 +791,60 @@ function mem(x, _param) { function min_binding(_param) { while(true) { const param = _param; - if (param) { - const l = param._0; - if (!l) { - return [ - param._1, - param._2 - ]; - } - _param = l; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const l = param._0; + if (/* tag */typeof l === "number" || typeof l === "string") { + return [ + param._1, + param._2 + ]; + } + _param = l; + continue ; }; } function max_binding(_param) { while(true) { const param = _param; - if (param) { - if (!param._3) { - return [ - param._1, - param._2 - ]; - } - _param = param._3; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + let tmp = param._3; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return [ + param._1, + param._2 + ]; + } + _param = param._3; + continue ; }; } function remove_min_binding(param) { - if (param) { - const l = param._0; - if (l) { - return bal(remove_min_binding(l), param._1, param._2, param._3); - } else { - return param._3; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Invalid_argument", { + MEL_EXN_ID: "Invalid_argument", + _1: "Map.remove_min_elt" + }); + } + const l = param._0; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param._3; + } else { + return bal(remove_min_binding(l), param._1, param._2, param._3); } - throw new Caml_js_exceptions.MelangeError("Invalid_argument", { - MEL_EXN_ID: "Invalid_argument", - _1: "Map.remove_min_elt" - }); } function remove(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const r = param._3; @@ -831,10 +853,10 @@ function remove(x, param) { const l = param._0; const c = Caml.caml_int_compare(x, v); if (c === 0) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return r; } - if (!r) { + if (/* tag */typeof r === "number" || typeof r === "string") { return l; } const match = min_binding(r); @@ -849,7 +871,7 @@ function remove(x, param) { function iter(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } iter(f, param._0); @@ -860,13 +882,14 @@ function iter(f, _param) { } function map(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const l$p = map(f, param._0); const d$p = Curry._1(f, param._2); const r$p = map(f, param._3); - return /* Node */{ + return { + TAG: /* Node */0, _0: l$p, _1: param._1, _2: d$p, @@ -876,14 +899,15 @@ function map(f, param) { } function mapi(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param._1; const l$p = mapi(f, param._0); const d$p = Curry._2(f, v, param._2); const r$p = mapi(f, param._3); - return /* Node */{ + return { + TAG: /* Node */0, _0: l$p, _1: v, _2: d$p, @@ -896,7 +920,7 @@ function fold(f, _m, _accu) { while(true) { const accu = _accu; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return accu; } _accu = Curry._3(f, m._1, m._2, fold(f, m._0, accu)); @@ -908,7 +932,7 @@ function fold(f, _m, _accu) { function for_all(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; } if (!Curry._2(p, param._1, param._2)) { @@ -925,7 +949,7 @@ function for_all(p, _param) { function exists(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } if (Curry._2(p, param._1, param._2)) { @@ -940,30 +964,30 @@ function exists(p, _param) { } function add_min_binding(k, v, param) { - if (param) { - return bal(add_min_binding(k, v, param._0), param._1, param._2, param._3); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(k, v); + } else { + return bal(add_min_binding(k, v, param._0), param._1, param._2, param._3); } } function add_max_binding(k, v, param) { - if (param) { - return bal(param._0, param._1, param._2, add_max_binding(k, v, param._3)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(k, v); + } else { + return bal(param._0, param._1, param._2, add_max_binding(k, v, param._3)); } } function join(l, v, d, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_binding(v, d, r); } - if (!r) { + const lh = l._4; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_binding(v, d, l); } const rh = r._4; - const lh = l._4; if (lh > (rh + 2 | 0)) { return bal(l._0, l._1, l._2, join(l._3, v, d, r)); } else if (rh > (lh + 2 | 0)) { @@ -974,10 +998,10 @@ function join(l, v, d, r) { } function concat(t1, t2) { - if (!t1) { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; } - if (!t2) { + if (/* tag */typeof t2 === "number" || typeof t2 === "string") { return t1; } const match = min_binding(t2); @@ -993,7 +1017,7 @@ function concat_or_join(t1, v, d, t2) { } function split(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, undefined, @@ -1029,33 +1053,36 @@ function split(x, param) { } function merge(f, s1, s2) { - if (s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + return /* Empty */0; + } + + } else { const v1 = s1._1; if (s1._4 >= height(s2)) { const match = split(v1, s2); return concat_or_join(merge(f, s1._0, match[0]), v1, Curry._3(f, v1, Caml_option.some(s1._2), match[1]), merge(f, s1._3, match[2])); } - } else if (!s2) { - return /* Empty */0; } - if (s2) { - const v2 = s2._1; - const match$1 = split(v2, s1); - return concat_or_join(merge(f, match$1[0], s2._0), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2._2)), merge(f, match$1[2], s2._3)); + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/test/inline_map2_test.ml", + 270, + 10 + ] + }); } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/test/inline_map2_test.ml", - 270, - 10 - ] - }); + const v2 = s2._1; + const match$1 = split(v2, s1); + return concat_or_join(merge(f, match$1[0], s2._0), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2._2)), merge(f, match$1[2], s2._3)); } function filter(p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const d = param._2; @@ -1071,7 +1098,7 @@ function filter(p, param) { } function partition(p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, /* Empty */0 @@ -1103,10 +1130,11 @@ function cons_enum(_m, _e) { while(true) { const e = _e; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: m._1, _1: m._2, _2: m._3, @@ -1123,14 +1151,14 @@ function compare(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return -1; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 0; + } else { + return -1; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 1; } const c = Caml.caml_int_compare(e1._0, e2._0); @@ -1153,14 +1181,14 @@ function equal(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return false; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return true; + } else { + return false; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return false; } if (e1._0 !== e2._0) { @@ -1176,10 +1204,10 @@ function equal(cmp, m1, m2) { } function cardinal(param) { - if (param) { - return (cardinal(param._0) + 1 | 0) + cardinal(param._3) | 0; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return (cardinal(param._0) + 1 | 0) + cardinal(param._3) | 0; } } @@ -1187,7 +1215,7 @@ function bindings_aux(_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param._0; @@ -1273,17 +1301,18 @@ const m = Stdlib__List.fold_left((function (acc, param) { }); function height$1(param) { - if (param) { - return param._4; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param._4; } } function create$1(l, x, d, r) { const hl = height$1(l); const hr = height$1(r); - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: x, _2: d, @@ -1293,7 +1322,8 @@ function create$1(l, x, d, r) { } function singleton$1(x, d) { - return /* Node */{ + return { + TAG: /* Node */0, _0: /* Empty */0, _1: x, _2: d, @@ -1303,32 +1333,35 @@ function singleton$1(x, d) { } function bal$1(l, x, d, r) { - const hl = l ? l._4 : 0; - const hr = r ? r._4 : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l._4; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r._4; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l._3; - const ld = l._2; - const lv = l._1; - const ll = l._0; - if (height$1(ll) >= height$1(lr)) { - return create$1(ll, lv, ld, create$1(lr, x, d, r)); - } - if (lr) { - return create$1(create$1(ll, lv, ld, lr._0), lr._1, lr._2, create$1(lr._3, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l._3; + const ld = l._2; + const lv = l._1; + const ll = l._0; + if (height$1(ll) >= height$1(lr)) { + return create$1(ll, lv, ld, create$1(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$1(create$1(ll, lv, ld, lr._0), lr._1, lr._2, create$1(lr._3, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: x, _2: d, @@ -1336,22 +1369,22 @@ function bal$1(l, x, d, r) { _4: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r._3; - const rd = r._2; - const rv = r._1; - const rl = r._0; - if (height$1(rr) >= height$1(rl)) { - return create$1(create$1(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create$1(create$1(l, x, d, rl._0), rl._1, rl._2, create$1(rl._3, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r._3; + const rd = r._2; + const rv = r._1; + const rl = r._0; + if (height$1(rr) >= height$1(rl)) { + return create$1(create$1(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$1(create$1(l, x, d, rl._0), rl._1, rl._2, create$1(rl._3, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -1359,16 +1392,17 @@ function bal$1(l, x, d, r) { } function is_empty$1(param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } } function add$1(x, data, param) { - if (!param) { - return /* Node */{ + if (/* tag */typeof param === "number" || typeof param === "string") { + return { + TAG: /* Node */0, _0: /* Empty */0, _1: x, _2: data, @@ -1382,7 +1416,8 @@ function add$1(x, data, param) { const l = param._0; const c = Caml.caml_string_compare(x, v); if (c === 0) { - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: x, _2: data, @@ -1399,24 +1434,24 @@ function add$1(x, data, param) { function find$1(x, _param) { while(true) { const param = _param; - if (param) { - const c = Caml.caml_string_compare(x, param._1); - if (c === 0) { - return param._2; - } - _param = c < 0 ? param._0 : param._3; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Caml.caml_string_compare(x, param._1); + if (c === 0) { + return param._2; + } + _param = c < 0 ? param._0 : param._3; + continue ; }; } function mem$1(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Caml.caml_string_compare(x, param._1); @@ -1431,59 +1466,60 @@ function mem$1(x, _param) { function min_binding$1(_param) { while(true) { const param = _param; - if (param) { - const l = param._0; - if (!l) { - return [ - param._1, - param._2 - ]; - } - _param = l; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const l = param._0; + if (/* tag */typeof l === "number" || typeof l === "string") { + return [ + param._1, + param._2 + ]; + } + _param = l; + continue ; }; } function max_binding$1(_param) { while(true) { const param = _param; - if (param) { - if (!param._3) { - return [ - param._1, - param._2 - ]; - } - _param = param._3; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + let tmp = param._3; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return [ + param._1, + param._2 + ]; + } + _param = param._3; + continue ; }; } function remove_min_binding$1(param) { - if (param) { - const l = param._0; - if (l) { - return bal$1(remove_min_binding$1(l), param._1, param._2, param._3); - } else { - return param._3; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Invalid_argument", { + MEL_EXN_ID: "Invalid_argument", + _1: "Map.remove_min_elt" + }); + } + const l = param._0; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param._3; + } else { + return bal$1(remove_min_binding$1(l), param._1, param._2, param._3); } - throw new Caml_js_exceptions.MelangeError("Invalid_argument", { - MEL_EXN_ID: "Invalid_argument", - _1: "Map.remove_min_elt" - }); } function remove$1(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const r = param._3; @@ -1492,10 +1528,10 @@ function remove$1(x, param) { const l = param._0; const c = Caml.caml_string_compare(x, v); if (c === 0) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return r; } - if (!r) { + if (/* tag */typeof r === "number" || typeof r === "string") { return l; } const match = min_binding$1(r); @@ -1510,7 +1546,7 @@ function remove$1(x, param) { function iter$1(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } iter$1(f, param._0); @@ -1521,13 +1557,14 @@ function iter$1(f, _param) { } function map$1(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const l$p = map$1(f, param._0); const d$p = Curry._1(f, param._2); const r$p = map$1(f, param._3); - return /* Node */{ + return { + TAG: /* Node */0, _0: l$p, _1: param._1, _2: d$p, @@ -1537,14 +1574,15 @@ function map$1(f, param) { } function mapi$1(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param._1; const l$p = mapi$1(f, param._0); const d$p = Curry._2(f, v, param._2); const r$p = mapi$1(f, param._3); - return /* Node */{ + return { + TAG: /* Node */0, _0: l$p, _1: v, _2: d$p, @@ -1557,7 +1595,7 @@ function fold$1(f, _m, _accu) { while(true) { const accu = _accu; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return accu; } _accu = Curry._3(f, m._1, m._2, fold$1(f, m._0, accu)); @@ -1569,7 +1607,7 @@ function fold$1(f, _m, _accu) { function for_all$1(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; } if (!Curry._2(p, param._1, param._2)) { @@ -1586,7 +1624,7 @@ function for_all$1(p, _param) { function exists$1(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } if (Curry._2(p, param._1, param._2)) { @@ -1601,30 +1639,30 @@ function exists$1(p, _param) { } function add_min_binding$1(k, v, param) { - if (param) { - return bal$1(add_min_binding$1(k, v, param._0), param._1, param._2, param._3); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton$1(k, v); + } else { + return bal$1(add_min_binding$1(k, v, param._0), param._1, param._2, param._3); } } function add_max_binding$1(k, v, param) { - if (param) { - return bal$1(param._0, param._1, param._2, add_max_binding$1(k, v, param._3)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton$1(k, v); + } else { + return bal$1(param._0, param._1, param._2, add_max_binding$1(k, v, param._3)); } } function join$1(l, v, d, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_binding$1(v, d, r); } - if (!r) { + const lh = l._4; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_binding$1(v, d, l); } const rh = r._4; - const lh = l._4; if (lh > (rh + 2 | 0)) { return bal$1(l._0, l._1, l._2, join$1(l._3, v, d, r)); } else if (rh > (lh + 2 | 0)) { @@ -1635,10 +1673,10 @@ function join$1(l, v, d, r) { } function concat$1(t1, t2) { - if (!t1) { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; } - if (!t2) { + if (/* tag */typeof t2 === "number" || typeof t2 === "string") { return t1; } const match = min_binding$1(t2); @@ -1654,7 +1692,7 @@ function concat_or_join$1(t1, v, d, t2) { } function split$1(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, undefined, @@ -1690,33 +1728,36 @@ function split$1(x, param) { } function merge$1(f, s1, s2) { - if (s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + return /* Empty */0; + } + + } else { const v1 = s1._1; if (s1._4 >= height$1(s2)) { const match = split$1(v1, s2); return concat_or_join$1(merge$1(f, s1._0, match[0]), v1, Curry._3(f, v1, Caml_option.some(s1._2), match[1]), merge$1(f, s1._3, match[2])); } - } else if (!s2) { - return /* Empty */0; } - if (s2) { - const v2 = s2._1; - const match$1 = split$1(v2, s1); - return concat_or_join$1(merge$1(f, match$1[0], s2._0), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2._2)), merge$1(f, match$1[2], s2._3)); - } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/test/inline_map2_test.ml", - 270, - 10 - ] - }); + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/test/inline_map2_test.ml", + 270, + 10 + ] + }); + } + const v2 = s2._1; + const match$1 = split$1(v2, s1); + return concat_or_join$1(merge$1(f, match$1[0], s2._0), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2._2)), merge$1(f, match$1[2], s2._3)); } function filter$1(p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const d = param._2; @@ -1732,7 +1773,7 @@ function filter$1(p, param) { } function partition$1(p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, /* Empty */0 @@ -1764,10 +1805,11 @@ function cons_enum$1(_m, _e) { while(true) { const e = _e; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: m._1, _1: m._2, _2: m._3, @@ -1784,14 +1826,14 @@ function compare$1(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return -1; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 0; + } else { + return -1; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 1; } const c = Caml.caml_string_compare(e1._0, e2._0); @@ -1814,14 +1856,14 @@ function equal$1(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return false; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return true; + } else { + return false; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return false; } if (Caml.caml_string_compare(e1._0, e2._0) !== 0) { @@ -1837,10 +1879,10 @@ function equal$1(cmp, m1, m2) { } function cardinal$1(param) { - if (param) { - return (cardinal$1(param._0) + 1 | 0) + cardinal$1(param._3) | 0; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return (cardinal$1(param._0) + 1 | 0) + cardinal$1(param._3) | 0; } } @@ -1848,7 +1890,7 @@ function bindings_aux$1(_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param._0; diff --git a/jscomp/test/dist/jscomp/test/inline_map_test.js b/jscomp/test/dist/jscomp/test/inline_map_test.js index 1cb9575948..8310d456d8 100644 --- a/jscomp/test/dist/jscomp/test/inline_map_test.js +++ b/jscomp/test/dist/jscomp/test/inline_map_test.js @@ -8,17 +8,18 @@ const Stdlib = require("melange/stdlib.js"); const Stdlib__List = require("melange/list.js"); function height(param) { - if (param) { - return param._4; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param._4; } } function create(l, x, d, r) { const hl = height(l); const hr = height(r); - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: x, _2: d, @@ -28,32 +29,35 @@ function create(l, x, d, r) { } function bal(l, x, d, r) { - const hl = l ? l._4 : 0; - const hr = r ? r._4 : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l._4; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r._4; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l._3; - const ld = l._2; - const lv = l._1; - const ll = l._0; - if (height(ll) >= height(lr)) { - return create(ll, lv, ld, create(lr, x, d, r)); - } - if (lr) { - return create(create(ll, lv, ld, lr._0), lr._1, lr._2, create(lr._3, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l._3; + const ld = l._2; + const lv = l._1; + const ll = l._0; + if (height(ll) >= height(lr)) { + return create(ll, lv, ld, create(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, ld, lr._0), lr._1, lr._2, create(lr._3, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: x, _2: d, @@ -61,22 +65,22 @@ function bal(l, x, d, r) { _4: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r._3; - const rd = r._2; - const rv = r._1; - const rl = r._0; - if (height(rr) >= height(rl)) { - return create(create(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create(create(l, x, d, rl._0), rl._1, rl._2, create(rl._3, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r._3; + const rd = r._2; + const rv = r._1; + const rl = r._0; + if (height(rr) >= height(rl)) { + return create(create(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, x, d, rl._0), rl._1, rl._2, create(rl._3, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -84,8 +88,9 @@ function bal(l, x, d, r) { } function add(x, data, param) { - if (!param) { - return /* Node */{ + if (/* tag */typeof param === "number" || typeof param === "string") { + return { + TAG: /* Node */0, _0: /* Empty */0, _1: x, _2: data, @@ -99,7 +104,8 @@ function add(x, data, param) { const l = param._0; const c = Caml.caml_int_compare(x, v); if (c === 0) { - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: x, _2: data, @@ -116,17 +122,17 @@ function add(x, data, param) { function find(x, _param) { while(true) { const param = _param; - if (param) { - const c = Caml.caml_int_compare(x, param._1); - if (c === 0) { - return param._2; - } - _param = c < 0 ? param._0 : param._3; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Caml.caml_int_compare(x, param._1); + if (c === 0) { + return param._2; + } + _param = c < 0 ? param._0 : param._3; + continue ; }; } diff --git a/jscomp/test/dist/jscomp/test/inline_record_test.js b/jscomp/test/dist/jscomp/test/inline_record_test.js index 61920f602e..6ef699a489 100644 --- a/jscomp/test/dist/jscomp/test/inline_record_test.js +++ b/jscomp/test/dist/jscomp/test/inline_record_test.js @@ -179,24 +179,27 @@ if (v6.MEL_EXN_ID === A4) { eq("File \"jscomp/test/inline_record_test.ml\", line 82, characters 6-13", tmp$3, 11); function ff1(x) { - if (x) { - return /* A0 */{ + if (/* tag */typeof x === "number" || typeof x === "string") { + return /* A1 */0; + } else { + return { + TAG: /* A0 */0, lbl: x.lbl + 1 | 0, more: x.more }; - } else { - return /* A1 */0; } } Mt.from_pair_suites("Inline_record_test", suites.contents); -const v2 = /* A0 */{ +const v2 = { + TAG: /* A0 */0, lbl: 3, more: /* [] */0 }; -const vvv = /* A0 */{ +const vvv = { + TAG: /* A0 */0, lbl: 3, more: /* [] */0 }; diff --git a/jscomp/test/dist/jscomp/test/int32_test.js b/jscomp/test/dist/jscomp/test/int32_test.js index 37ba4faf87..9b5e7aa1e9 100644 --- a/jscomp/test/dist/jscomp/test/int32_test.js +++ b/jscomp/test/dist/jscomp/test/int32_test.js @@ -181,7 +181,8 @@ const suites = { } }, Stdlib.$at(Stdlib__Array.to_list(Ext_array_test.map2i((function (i, a, b) { return [ - Curry._1(Stdlib__Format.asprintf(/* Format */{ + Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "shift_right_logical_cases ", @@ -205,7 +206,8 @@ const suites = { ]; }), shift_right_logical_tests_0, shift_right_logical_tests_1)), Stdlib.$at(Stdlib__Array.to_list(Ext_array_test.map2i((function (i, a, b) { return [ - Curry._1(Stdlib__Format.asprintf(/* Format */{ + Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "shift_right_cases ", @@ -229,7 +231,8 @@ const suites = { ]; }), shift_right_tests_0, shift_right_tests_1)), Stdlib__Array.to_list(Ext_array_test.map2i((function (i, a, b) { return [ - Curry._1(Stdlib__Format.asprintf(/* Format */{ + Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "shift_left_cases ", diff --git a/jscomp/test/dist/jscomp/test/int64_mul_div_test.js b/jscomp/test/dist/jscomp/test/int64_mul_div_test.js index 5a29df4b5c..f620965263 100644 --- a/jscomp/test/dist/jscomp/test/int64_mul_div_test.js +++ b/jscomp/test/dist/jscomp/test/int64_mul_div_test.js @@ -314,7 +314,8 @@ function from_pairs(prefix, pairs) { const a = param[1]; const result = param[0]; return [ - Curry._2(Stdlib__Printf.sprintf(/* Format */{ + Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1535,7 +1536,8 @@ function from(xs) { const b = param[1]; const a = param[0]; return [ - Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "small_divs ", @@ -1602,7 +1604,8 @@ function from_compare(xs) { const b = param[1]; const a = param[0]; return [ - Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "int64_compare ", @@ -1630,7 +1633,8 @@ function from_to_string(xs) { const str_a = param[1]; const a = param[0]; return [ - Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "to_string ", @@ -1657,7 +1661,8 @@ Mt.from_pair_suites("Int64_mul_div_test", Stdlib.$at(from_pairs("random", pairs) const f = param[1]; const i64 = param[0]; return [ - Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "to_float_", @@ -1683,7 +1688,8 @@ Mt.from_pair_suites("Int64_mul_div_test", Stdlib.$at(from_pairs("random", pairs) const i64 = param[1]; const f = param[0]; return [ - Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "of_float_", diff --git a/jscomp/test/dist/jscomp/test/int64_test.js b/jscomp/test/dist/jscomp/test/int64_test.js index ea4588432c..6dd430874b 100644 --- a/jscomp/test/dist/jscomp/test/int64_test.js +++ b/jscomp/test/dist/jscomp/test/int64_test.js @@ -2107,7 +2107,8 @@ const suites = Stdlib.$at({ } }, Stdlib.$at(Stdlib__Array.to_list(Ext_array_test.map2i((function (i, a, b) { return [ - Curry._1(Stdlib__Format.asprintf(/* Format */{ + Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "shift_left_cases ", @@ -2131,7 +2132,8 @@ const suites = Stdlib.$at({ ]; }), shift_left_tests_0, shift_left_tests_1)), Stdlib.$at(Stdlib__Array.to_list(Ext_array_test.map2i((function (i, a, b) { return [ - Curry._1(Stdlib__Format.asprintf(/* Format */{ + Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "shift_right_cases ", @@ -2155,7 +2157,8 @@ const suites = Stdlib.$at({ ]; }), shift_right_tests_0, shift_right_tests_1)), Stdlib__Array.to_list(Ext_array_test.map2i((function (i, a, b) { return [ - Curry._1(Stdlib__Format.asprintf(/* Format */{ + Curry._1(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "shift_right_logical_cases ", @@ -2194,7 +2197,7 @@ function eq(loc, x, y) { function id(loc, x) { const float_value = Caml_int64.float_of_bits(x); const match = Stdlib.classify_float(float_value); - if (match >= 4) { + if (match === /* FP_nan */4) { return ; } else { return eq(loc, Caml_int64.bits_of_float(float_value), x); diff --git a/jscomp/test/dist/jscomp/test/int_map.js b/jscomp/test/dist/jscomp/test/int_map.js index 8f9a1e82ec..b61a080ab8 100644 --- a/jscomp/test/dist/jscomp/test/int_map.js +++ b/jscomp/test/dist/jscomp/test/int_map.js @@ -16,17 +16,18 @@ const funarg = { }; function height(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create(l, x, d, r) { const hl = height(l); const hr = height(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -36,7 +37,8 @@ function create(l, x, d, r) { } function singleton(x, d) { - return /* Node */{ + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: d, @@ -46,32 +48,35 @@ function singleton(x, d) { } function bal(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height(ll) >= height(lr)) { - return create(ll, lv, ld, create(lr, x, d, r)); - } - if (lr) { - return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height(ll) >= height(lr)) { + return create(ll, lv, ld, create(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -79,22 +84,22 @@ function bal(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height(rr) >= height(rl)) { - return create(create(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height(rr) >= height(rl)) { + return create(create(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -102,16 +107,17 @@ function bal(l, x, d, r) { } function is_empty(param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } } function add(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -128,7 +134,8 @@ function add(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -156,63 +163,63 @@ function add(x, data, m) { function find(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(funarg.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(funarg.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } function find_first(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _d0 = param.d; - let _param$1 = param.l; - while(true) { - const param$1 = _param$1; - const d0 = _d0; - const v0 = _v0; - if (!param$1) { - return [ - v0, - d0 - ]; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.l; - _d0 = param$1.d; - _v0 = v$1; - continue ; - } - _param$1 = param$1.r; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _d0 = param.d; + let _param$1 = param.l; + while(true) { + const param$1 = _param$1; + const d0 = _d0; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return [ + v0, + d0 + ]; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.l; + _d0 = param$1.d; + _v0 = v$1; continue ; - }; - } - _param = param.r; - continue ; + } + _param$1 = param$1.r; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.r; + continue ; }; } function find_first_opt(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -224,7 +231,7 @@ function find_first_opt(f, _param) { const param$1 = _param$1; const d0 = _d0; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return [ v0, d0 @@ -249,46 +256,46 @@ function find_first_opt(f, _param) { function find_last(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _d0 = param.d; - let _param$1 = param.r; - while(true) { - const param$1 = _param$1; - const d0 = _d0; - const v0 = _v0; - if (!param$1) { - return [ - v0, - d0 - ]; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.r; - _d0 = param$1.d; - _v0 = v$1; - continue ; - } - _param$1 = param$1.l; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _d0 = param.d; + let _param$1 = param.r; + while(true) { + const param$1 = _param$1; + const d0 = _d0; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return [ + v0, + d0 + ]; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.r; + _d0 = param$1.d; + _v0 = v$1; continue ; - }; - } - _param = param.l; - continue ; + } + _param$1 = param$1.l; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.l; + continue ; }; } function find_last_opt(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -300,7 +307,7 @@ function find_last_opt(f, _param) { const param$1 = _param$1; const d0 = _d0; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return [ v0, d0 @@ -325,7 +332,7 @@ function find_last_opt(f, _param) { function find_opt(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const c = Curry._2(funarg.compare, x, param.v); @@ -340,7 +347,7 @@ function find_opt(x, _param) { function mem(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(funarg.compare, x, param.v); @@ -355,31 +362,31 @@ function mem(x, _param) { function min_binding(_param) { while(true) { const param = _param; - if (param) { - const l = param.l; - if (!l) { - return [ - param.v, - param.d - ]; - } - _param = l; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return [ + param.v, + param.d + ]; + } + _param = l; + continue ; }; } function min_binding_opt(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const l = param.l; - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return [ param.v, param.d @@ -393,29 +400,31 @@ function min_binding_opt(_param) { function max_binding(_param) { while(true) { const param = _param; - if (param) { - if (!param.r) { - return [ - param.v, - param.d - ]; - } - _param = param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return [ + param.v, + param.d + ]; + } + _param = param.r; + continue ; }; } function max_binding_opt(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } - if (!param.r) { + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { return [ param.v, param.d @@ -427,25 +436,25 @@ function max_binding_opt(_param) { } function remove_min_binding(param) { - if (param) { - const l = param.l; - if (l) { - return bal(remove_min_binding(l), param.v, param.d, param.r); - } else { - return param.r; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Invalid_argument", { + MEL_EXN_ID: "Invalid_argument", + _1: "Map.remove_min_elt" + }); + } + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param.r; + } else { + return bal(remove_min_binding(l), param.v, param.d, param.r); } - throw new Caml_js_exceptions.MelangeError("Invalid_argument", { - MEL_EXN_ID: "Invalid_argument", - _1: "Map.remove_min_elt" - }); } function merge(t1, t2) { - if (!t1) { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; } - if (!t2) { + if (/* tag */typeof t2 === "number" || typeof t2 === "string") { return t1; } const match = min_binding(t2); @@ -453,7 +462,7 @@ function merge(t1, t2) { } function remove(x, m) { - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return /* Empty */0; } const r = m.r; @@ -481,56 +490,58 @@ function remove(x, m) { } function update(x, f, m) { - if (m) { - const r = m.r; - const d = m.d; - const v = m.v; - const l = m.l; - const c = Curry._2(funarg.compare, x, v); - if (c === 0) { - const data = Curry._1(f, Caml_option.some(d)); - if (data === undefined) { - return merge(l, r); - } - const data$1 = Caml_option.valFromOption(data); - if (d === data$1) { - return m; - } else { - return /* Node */{ - l: l, - v: x, - d: data$1, - r: r, - h: m.h - }; - } + if (/* tag */typeof m === "number" || typeof m === "string") { + const data = Curry._1(f, undefined); + if (data !== undefined) { + return { + TAG: /* Node */0, + l: /* Empty */0, + v: x, + d: Caml_option.valFromOption(data), + r: /* Empty */0, + h: 1 + }; + } else { + return /* Empty */0; } - if (c < 0) { - const ll = update(x, f, l); - if (l === ll) { - return m; - } else { - return bal(ll, v, d, r); - } + } + const r = m.r; + const d = m.d; + const v = m.v; + const l = m.l; + const c = Curry._2(funarg.compare, x, v); + if (c === 0) { + const data$1 = Curry._1(f, Caml_option.some(d)); + if (data$1 === undefined) { + return merge(l, r); } - const rr = update(x, f, r); - if (r === rr) { + const data$2 = Caml_option.valFromOption(data$1); + if (d === data$2) { return m; } else { - return bal(l, v, d, rr); + return { + TAG: /* Node */0, + l: l, + v: x, + d: data$2, + r: r, + h: m.h + }; } } - const data$2 = Curry._1(f, undefined); - if (data$2 !== undefined) { - return /* Node */{ - l: /* Empty */0, - v: x, - d: Caml_option.valFromOption(data$2), - r: /* Empty */0, - h: 1 - }; + if (c < 0) { + const ll = update(x, f, l); + if (l === ll) { + return m; + } else { + return bal(ll, v, d, r); + } + } + const rr = update(x, f, r); + if (r === rr) { + return m; } else { - return /* Empty */0; + return bal(l, v, d, rr); } } @@ -554,7 +565,7 @@ function add_to_list(x, data, m) { function iter(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } iter(f, param.l); @@ -565,13 +576,14 @@ function iter(f, _param) { } function map(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const l$p = map(f, param.l); const d$p = Curry._1(f, param.d); const r$p = map(f, param.r); - return /* Node */{ + return { + TAG: /* Node */0, l: l$p, v: param.v, d: d$p, @@ -581,14 +593,15 @@ function map(f, param) { } function mapi(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param.v; const l$p = mapi(f, param.l); const d$p = Curry._2(f, v, param.d); const r$p = mapi(f, param.r); - return /* Node */{ + return { + TAG: /* Node */0, l: l$p, v: v, d: d$p, @@ -601,7 +614,7 @@ function fold(f, _m, _accu) { while(true) { const accu = _accu; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return accu; } _accu = Curry._3(f, m.v, m.d, fold(f, m.l, accu)); @@ -613,7 +626,7 @@ function fold(f, _m, _accu) { function for_all(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; } if (!Curry._2(p, param.v, param.d)) { @@ -630,7 +643,7 @@ function for_all(p, _param) { function exists(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } if (Curry._2(p, param.v, param.d)) { @@ -645,30 +658,30 @@ function exists(p, _param) { } function add_min_binding(k, x, param) { - if (param) { - return bal(add_min_binding(k, x, param.l), param.v, param.d, param.r); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(k, x); + } else { + return bal(add_min_binding(k, x, param.l), param.v, param.d, param.r); } } function add_max_binding(k, x, param) { - if (param) { - return bal(param.l, param.v, param.d, add_max_binding(k, x, param.r)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(k, x); + } else { + return bal(param.l, param.v, param.d, add_max_binding(k, x, param.r)); } } function join(l, v, d, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_binding(v, d, r); } - if (!r) { + const lh = l.h; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_binding(v, d, l); } const rh = r.h; - const lh = l.h; if (lh > (rh + 2 | 0)) { return bal(l.l, l.v, l.d, join(l.r, v, d, r)); } else if (rh > (lh + 2 | 0)) { @@ -679,10 +692,10 @@ function join(l, v, d, r) { } function concat(t1, t2) { - if (!t1) { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; } - if (!t2) { + if (/* tag */typeof t2 === "number" || typeof t2 === "string") { return t1; } const match = min_binding(t2); @@ -698,7 +711,7 @@ function concat_or_join(t1, v, d, t2) { } function split(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, undefined, @@ -734,42 +747,45 @@ function split(x, param) { } function merge$1(f, s1, s2) { - if (s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + return /* Empty */0; + } + + } else { const v1 = s1.v; if (s1.h >= height(s2)) { const match = split(v1, s2); return concat_or_join(merge$1(f, s1.l, match[0]), v1, Curry._3(f, v1, Caml_option.some(s1.d), match[1]), merge$1(f, s1.r, match[2])); } - } else if (!s2) { - return /* Empty */0; } - if (s2) { - const v2 = s2.v; - const match$1 = split(v2, s1); - return concat_or_join(merge$1(f, match$1[0], s2.l), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2.d)), merge$1(f, match$1[2], s2.r)); + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/stdlib/map.ml", + 408, + 10 + ] + }); } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/stdlib/map.ml", - 408, - 10 - ] - }); + const v2 = s2.v; + const match$1 = split(v2, s1); + return concat_or_join(merge$1(f, match$1[0], s2.l), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2.d)), merge$1(f, match$1[2], s2.r)); } function union(f, s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return s2; } - if (!s2) { + const d1 = s1.d; + const v1 = s1.v; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const d2 = s2.d; const v2 = s2.v; - const d1 = s1.d; - const v1 = s1.v; if (s1.h >= s2.h) { const match = split(v1, s2); const d2$1 = match[1]; @@ -793,7 +809,7 @@ function union(f, s1, s2) { } function filter(p, m) { - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return /* Empty */0; } const r = m.r; @@ -815,7 +831,7 @@ function filter(p, m) { } function filter_map(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param.v; @@ -830,7 +846,7 @@ function filter_map(f, param) { } function partition(p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, /* Empty */0 @@ -862,10 +878,11 @@ function cons_enum(_m, _e) { while(true) { const e = _e; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: m.v, _1: m.d, _2: m.r, @@ -882,14 +899,14 @@ function compare$1(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return -1; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 0; + } else { + return -1; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 1; } const c = Curry._2(funarg.compare, e1._0, e2._0); @@ -912,14 +929,14 @@ function equal(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return false; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return true; + } else { + return false; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return false; } if (Curry._2(funarg.compare, e1._0, e2._0) !== 0) { @@ -935,10 +952,10 @@ function equal(cmp, m1, m2) { } function cardinal(param) { - if (param) { - return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; } } @@ -946,7 +963,7 @@ function bindings_aux(_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param.l; @@ -982,11 +999,12 @@ function of_seq(i) { } function seq_of_enum_(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = cons_enum(c._2, c._3); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: [ c._0, c._1 @@ -1008,10 +1026,11 @@ function snoc_enum(_s, _e) { while(true) { const e = _e; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: s.v, _1: s.d, _2: s.l, @@ -1023,11 +1042,12 @@ function snoc_enum(_s, _e) { } function rev_seq_of_enum_(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = snoc_enum(c._2, c._3); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: [ c._0, c._1 @@ -1050,7 +1070,7 @@ function to_seq_from(low, m) { while(true) { const c = _c; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return c; } const r = m.r; @@ -1058,7 +1078,8 @@ function to_seq_from(low, m) { const v = m.v; const n = Curry._2(funarg.compare, v, low); if (n === 0) { - return /* More */{ + return { + TAG: /* More */0, _0: v, _1: d, _2: r, @@ -1069,7 +1090,8 @@ function to_seq_from(low, m) { _m = r; continue ; } - _c = /* More */{ + _c = { + TAG: /* More */0, _0: v, _1: d, _2: r, diff --git a/jscomp/test/dist/jscomp/test/js_json_test.js b/jscomp/test/dist/jscomp/test/js_json_test.js index a95ceb8fa1..ca1ed87c37 100644 --- a/jscomp/test/dist/jscomp/test/js_json_test.js +++ b/jscomp/test/dist/jscomp/test/js_json_test.js @@ -63,7 +63,7 @@ const v = JSON.parse(" { \"x\" : [1, 2, 3 ] } "); add_test("File \"jscomp/test/js_json_test.ml\", line 24, characters 11-18", (function (param) { const ty = Js__Js_json.classify(v); - if (typeof ty === "number") { + if (/* tag */typeof ty === "number" || typeof ty === "string") { return { TAG: /* Ok */4, _0: false @@ -83,7 +83,7 @@ add_test("File \"jscomp/test/js_json_test.ml\", line 24, characters 11-18", (fun }; } const ty2 = Js__Js_json.classify(Caml_option.valFromOption(v$1)); - if (typeof ty2 === "number") { + if (/* tag */typeof ty2 === "number" || typeof ty2 === "string") { return { TAG: /* Ok */4, _0: false @@ -97,7 +97,7 @@ add_test("File \"jscomp/test/js_json_test.ml\", line 24, characters 11-18", (fun } ty2._0.forEach(function (x) { const ty3 = Js__Js_json.classify(x); - if (typeof ty3 === "number") { + if (/* tag */typeof ty3 === "number" || typeof ty3 === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -131,8 +131,8 @@ const json = JSON.parse(JSON.stringify(null)); const ty = Js__Js_json.classify(json); -if (typeof ty === "number") { - if (ty >= 2) { +if (/* tag */typeof ty === "number" || typeof ty === "string") { + if (ty === /* JSONNull */2) { add_test("File \"jscomp/test/js_json_test.ml\", line 55, characters 24-31", (function (param) { return { TAG: /* Ok */4, @@ -162,7 +162,7 @@ const json$1 = JSON.parse(JSON.stringify("test string")); const ty$1 = Js__Js_json.classify(json$1); -if (typeof ty$1 === "number") { +if (/* tag */typeof ty$1 === "number" || typeof ty$1 === "string") { add_test("File \"jscomp/test/js_json_test.ml\", line 66, characters 16-23", (function (param) { return { TAG: /* Ok */4, @@ -186,7 +186,7 @@ const ty$2 = Js__Js_json.classify(json$2); let exit = 0; -if (typeof ty$2 === "number" || ty$2.TAG !== /* JSONNumber */1) { +if (/* tag */typeof ty$2 === "number" || typeof ty$2 === "string" || ty$2.TAG !== /* JSONNumber */1) { exit = 1; } else { eq("File \"jscomp/test/js_json_test.ml\", line 75, characters 25-32", ty$2._0, 1.23456789); @@ -207,7 +207,7 @@ const ty$3 = Js__Js_json.classify(json$3); let exit$1 = 0; -if (typeof ty$3 === "number" || ty$3.TAG !== /* JSONNumber */1) { +if (/* tag */typeof ty$3 === "number" || typeof ty$3 === "string" || ty$3.TAG !== /* JSONNumber */1) { exit$1 = 1; } else { eq("File \"jscomp/test/js_json_test.ml\", line 85, characters 25-32", ty$3._0 | 0, -1347440721); @@ -225,7 +225,7 @@ if (exit$1 === 1) { function test(v) { const json = JSON.parse(JSON.stringify(v)); const ty = Js__Js_json.classify(json); - if (typeof ty !== "number") { + if (!/* tag */(typeof ty === "number" || typeof ty === "string")) { return add_test("File \"jscomp/test/js_json_test.ml\", line 97, characters 18-25", (function (param) { return { TAG: /* Ok */4, @@ -238,14 +238,13 @@ function test(v) { return eq("File \"jscomp/test/js_json_test.ml\", line 96, characters 25-32", false, v); case /* JSONTrue */1 : return eq("File \"jscomp/test/js_json_test.ml\", line 95, characters 24-31", true, v); - case /* JSONNull */2 : - return add_test("File \"jscomp/test/js_json_test.ml\", line 97, characters 18-25", (function (param) { - return { - TAG: /* Ok */4, - _0: false - }; - })); - + default: + return add_test("File \"jscomp/test/js_json_test.ml\", line 97, characters 18-25", (function (param) { + return { + TAG: /* Ok */4, + _0: false + }; + })); } } @@ -277,7 +276,7 @@ const json$4 = JSON.parse(JSON.stringify(dict)); const ty$4 = Js__Js_json.classify(json$4); -if (typeof ty$4 === "number") { +if (/* tag */typeof ty$4 === "number" || typeof ty$4 === "string") { add_test("File \"jscomp/test/js_json_test.ml\", line 135, characters 16-23", (function (param) { return { TAG: /* Ok */4, @@ -287,7 +286,7 @@ if (typeof ty$4 === "number") { } else if (ty$4.TAG === /* JSONObject */2) { const x = ty$4._0; const ta = Js__Js_json.classify(option_get(Js__Js_dict.get(x, "a"))); - if (typeof ta === "number") { + if (/* tag */typeof ta === "number" || typeof ta === "string") { add_test("File \"jscomp/test/js_json_test.ml\", line 133, characters 18-25", (function (param) { return { TAG: /* Ok */4, @@ -304,7 +303,7 @@ if (typeof ty$4 === "number") { })); } else { const ty$5 = Js__Js_json.classify(option_get(Js__Js_dict.get(x, "b"))); - if (typeof ty$5 === "number") { + if (/* tag */typeof ty$5 === "number" || typeof ty$5 === "string") { add_test("File \"jscomp/test/js_json_test.ml\", line 131, characters 22-29", (function (param) { return { TAG: /* Ok */4, @@ -348,7 +347,7 @@ if (typeof ty$4 === "number") { function eq_at_i(loc, json, i, kind, expected) { const ty = Js__Js_json.classify(json); - if (typeof ty === "number") { + if (/* tag */typeof ty === "number" || typeof ty === "string") { return add_test(loc, (function (param) { return { TAG: /* Ok */4, @@ -367,7 +366,7 @@ function eq_at_i(loc, json, i, kind, expected) { const ty$1 = Js__Js_json.classify(Caml_array.get(ty._0, i)); switch (kind) { case /* String */0 : - if (typeof ty$1 === "number") { + if (/* tag */typeof ty$1 === "number" || typeof ty$1 === "string") { return add_test(loc, (function (param) { return { TAG: /* Ok */4, @@ -385,7 +384,7 @@ function eq_at_i(loc, json, i, kind, expected) { })); } case /* Number */1 : - if (typeof ty$1 === "number") { + if (/* tag */typeof ty$1 === "number" || typeof ty$1 === "string") { return add_test(loc, (function (param) { return { TAG: /* Ok */4, @@ -403,7 +402,7 @@ function eq_at_i(loc, json, i, kind, expected) { })); } case /* Object */2 : - if (typeof ty$1 === "number") { + if (/* tag */typeof ty$1 === "number" || typeof ty$1 === "string") { return add_test(loc, (function (param) { return { TAG: /* Ok */4, @@ -421,7 +420,7 @@ function eq_at_i(loc, json, i, kind, expected) { })); } case /* Array */3 : - if (typeof ty$1 === "number") { + if (/* tag */typeof ty$1 === "number" || typeof ty$1 === "string") { return add_test(loc, (function (param) { return { TAG: /* Ok */4, @@ -439,7 +438,7 @@ function eq_at_i(loc, json, i, kind, expected) { })); } case /* Boolean */4 : - if (typeof ty$1 !== "number") { + if (!/* tag */(typeof ty$1 === "number" || typeof ty$1 === "string")) { return add_test(loc, (function (param) { return { TAG: /* Ok */4, @@ -452,18 +451,17 @@ function eq_at_i(loc, json, i, kind, expected) { return eq(loc, false, expected); case /* JSONTrue */1 : return eq(loc, true, expected); - case /* JSONNull */2 : - return add_test(loc, (function (param) { - return { - TAG: /* Ok */4, - _0: false - }; - })); - + default: + return add_test(loc, (function (param) { + return { + TAG: /* Ok */4, + _0: false + }; + })); } case /* Null */5 : - if (typeof ty$1 === "number") { - if (ty$1 >= 2) { + if (/* tag */typeof ty$1 === "number" || typeof ty$1 === "string") { + if (ty$1 === /* JSONNull */2) { return add_test(loc, (function (param) { return { TAG: /* Ok */4, @@ -576,7 +574,7 @@ const json$10 = JSON.parse(JSON.stringify(a$3)); const ty$6 = Js__Js_json.classify(json$10); -if (typeof ty$6 === "number") { +if (/* tag */typeof ty$6 === "number" || typeof ty$6 === "string") { add_test("File \"jscomp/test/js_json_test.ml\", line 283, characters 16-23", (function (param) { return { TAG: /* Ok */4, @@ -585,7 +583,7 @@ if (typeof ty$6 === "number") { })); } else if (ty$6.TAG === /* JSONArray */3) { const ty$7 = Js__Js_json.classify(Caml_array.get(ty$6._0, 1)); - if (typeof ty$7 === "number") { + if (/* tag */typeof ty$7 === "number" || typeof ty$7 === "string") { add_test("File \"jscomp/test/js_json_test.ml\", line 281, characters 18-25", (function (param) { return { TAG: /* Ok */4, @@ -594,7 +592,7 @@ if (typeof ty$6 === "number") { })); } else if (ty$7.TAG === /* JSONObject */2) { const ty$8 = Js__Js_json.classify(option_get(Js__Js_dict.get(ty$7._0, "a"))); - if (typeof ty$8 === "number") { + if (/* tag */typeof ty$8 === "number" || typeof ty$8 === "string") { add_test("File \"jscomp/test/js_json_test.ml\", line 279, characters 20-27", (function (param) { return { TAG: /* Ok */4, diff --git a/jscomp/test/dist/jscomp/test/js_obj_test.js b/jscomp/test/dist/jscomp/test/js_obj_test.js index 663c76bb3e..07b93a3891 100644 --- a/jscomp/test/dist/jscomp/test/js_obj_test.js +++ b/jscomp/test/dist/jscomp/test/js_obj_test.js @@ -14,7 +14,8 @@ function f_js(u) { return u.say(32); } -const object_tables = /* Cons */{ +const object_tables = { + TAG: /* Cons */0, key: undefined, data: undefined, next: undefined diff --git a/jscomp/test/dist/jscomp/test/large_record_duplication_test.js b/jscomp/test/dist/jscomp/test/large_record_duplication_test.js index 497abdcd6d..9fe80eb324 100644 --- a/jscomp/test/dist/jscomp/test/large_record_duplication_test.js +++ b/jscomp/test/dist/jscomp/test/large_record_duplication_test.js @@ -58,7 +58,8 @@ eq("File \"jscomp/test/large_record_duplication_test.ml\", line 74, characters 6 y: "" }), false); -const v1 = /* A0 */{ +const v1 = { + TAG: /* A0 */0, x0: 9, x1: 9, x2: 9, @@ -85,14 +86,15 @@ const v1 = /* A0 */{ }; function get_x0(x) { - if (x) { + if (/* tag */typeof x === "number" || typeof x === "string") { + return ; + } else { return x.x0; } - } function f1(x) { - if (!x) { + if (/* tag */typeof x === "number" || typeof x === "string") { return /* A1 */0; } const newrecord = Caml_obj.caml_obj_dup(x); diff --git a/jscomp/test/dist/jscomp/test/libarg_test.js b/jscomp/test/dist/jscomp/test/libarg_test.js index 85dca8e1d4..372bc9758c 100644 --- a/jscomp/test/dist/jscomp/test/libarg_test.js +++ b/jscomp/test/dist/jscomp/test/libarg_test.js @@ -26,7 +26,8 @@ function record(fmt) { } function f_unit(param) { - record(/* Format */{ + record({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unit()", @@ -37,7 +38,8 @@ function f_unit(param) { } function f_bool(b) { - Curry._1(record(/* Format */{ + Curry._1(record({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "bool(", @@ -64,7 +66,8 @@ const r_clear = { }; function f_string(s) { - Curry._1(record(/* Format */{ + Curry._1(record({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "string(", @@ -87,7 +90,8 @@ const r_string = { }; function f_int(i) { - Curry._1(record(/* Format */{ + Curry._1(record({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "int(", @@ -112,7 +116,8 @@ const r_int = { }; function f_float(f) { - Curry._1(record(/* Format */{ + Curry._1(record({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "float(", @@ -140,7 +145,8 @@ const r_float = { }; function f_symbol(s) { - Curry._1(record(/* Format */{ + Curry._1(record({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "symbol(", @@ -159,7 +165,8 @@ function f_symbol(s) { } function f_rest(s) { - Curry._1(record(/* Format */{ + Curry._1(record({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "rest(", @@ -178,7 +185,8 @@ function f_rest(s) { } function f_anon(s) { - Curry._1(record(/* Format */{ + Curry._1(record({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "anon(", @@ -421,7 +429,8 @@ const args2 = [ ]; function error(s) { - Curry._1(Stdlib__Printf.printf(/* Format */{ + Curry._1(Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "error (", @@ -504,7 +513,8 @@ function test(argv) { }; if (Caml_obj.caml_notequal(result, reference)) { const f = function (x, y) { - Curry._3(Stdlib__Printf.printf(/* Format */{ + Curry._3(Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: { diff --git a/jscomp/test/dist/jscomp/test/map_find_test.js b/jscomp/test/dist/jscomp/test/map_find_test.js index e1a44b6f33..6e5de5e2fb 100644 --- a/jscomp/test/dist/jscomp/test/map_find_test.js +++ b/jscomp/test/dist/jscomp/test/map_find_test.js @@ -15,17 +15,18 @@ const funarg = { }; function height(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create(l, x, d, r) { const hl = height(l); const hr = height(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -35,32 +36,35 @@ function create(l, x, d, r) { } function bal(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height(ll) >= height(lr)) { - return create(ll, lv, ld, create(lr, x, d, r)); - } - if (lr) { - return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height(ll) >= height(lr)) { + return create(ll, lv, ld, create(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -68,22 +72,22 @@ function bal(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height(rr) >= height(rl)) { - return create(create(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height(rr) >= height(rl)) { + return create(create(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -91,8 +95,9 @@ function bal(l, x, d, r) { } function add(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -109,7 +114,8 @@ function add(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -137,17 +143,17 @@ function add(x, data, m) { function find(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(funarg.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(funarg.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } @@ -186,17 +192,18 @@ const funarg$1 = { }; function height$1(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$1(l, x, d, r) { const hl = height$1(l); const hr = height$1(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -206,32 +213,35 @@ function create$1(l, x, d, r) { } function bal$1(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height$1(ll) >= height$1(lr)) { - return create$1(ll, lv, ld, create$1(lr, x, d, r)); - } - if (lr) { - return create$1(create$1(ll, lv, ld, lr.l), lr.v, lr.d, create$1(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height$1(ll) >= height$1(lr)) { + return create$1(ll, lv, ld, create$1(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$1(create$1(ll, lv, ld, lr.l), lr.v, lr.d, create$1(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -239,22 +249,22 @@ function bal$1(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height$1(rr) >= height$1(rl)) { - return create$1(create$1(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create$1(create$1(l, x, d, rl.l), rl.v, rl.d, create$1(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height$1(rr) >= height$1(rl)) { + return create$1(create$1(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$1(create$1(l, x, d, rl.l), rl.v, rl.d, create$1(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -262,8 +272,9 @@ function bal$1(l, x, d, r) { } function add$1(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -280,7 +291,8 @@ function add$1(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -308,17 +320,17 @@ function add$1(x, data, m) { function find$1(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(funarg$1.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(funarg$1.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } diff --git a/jscomp/test/dist/jscomp/test/map_test.js b/jscomp/test/dist/jscomp/test/map_test.js index 6c5169d879..5279a9b52e 100644 --- a/jscomp/test/dist/jscomp/test/map_test.js +++ b/jscomp/test/dist/jscomp/test/map_test.js @@ -16,17 +16,18 @@ const Int = { }; function height(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create(l, x, d, r) { const hl = height(l); const hr = height(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -36,32 +37,35 @@ function create(l, x, d, r) { } function bal(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height(ll) >= height(lr)) { - return create(ll, lv, ld, create(lr, x, d, r)); - } - if (lr) { - return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height(ll) >= height(lr)) { + return create(ll, lv, ld, create(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -69,22 +73,22 @@ function bal(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height(rr) >= height(rl)) { - return create(create(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height(rr) >= height(rl)) { + return create(create(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -92,8 +96,9 @@ function bal(l, x, d, r) { } function add(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -110,7 +115,8 @@ function add(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -139,10 +145,11 @@ function cons_enum(_m, _e) { while(true) { const e = _e; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: m.v, _1: m.d, _2: m.r, @@ -159,14 +166,14 @@ function compare$1(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return -1; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 0; + } else { + return -1; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 1; } const c = Curry._2(Int.compare, e1._0, e2._0); @@ -189,14 +196,14 @@ function equal(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return false; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return true; + } else { + return false; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return false; } if (Curry._2(Int.compare, e1._0, e2._0) !== 0) { @@ -212,10 +219,10 @@ function equal(cmp, m1, m2) { } function cardinal(param) { - if (param) { - return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; } } @@ -230,17 +237,18 @@ const funarg = { }; function height$1(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$1(l, x, d, r) { const hl = height$1(l); const hr = height$1(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -250,32 +258,35 @@ function create$1(l, x, d, r) { } function bal$1(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height$1(ll) >= height$1(lr)) { - return create$1(ll, lv, ld, create$1(lr, x, d, r)); - } - if (lr) { - return create$1(create$1(ll, lv, ld, lr.l), lr.v, lr.d, create$1(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height$1(ll) >= height$1(lr)) { + return create$1(ll, lv, ld, create$1(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$1(create$1(ll, lv, ld, lr.l), lr.v, lr.d, create$1(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -283,22 +294,22 @@ function bal$1(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height$1(rr) >= height$1(rl)) { - return create$1(create$1(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create$1(create$1(l, x, d, rl.l), rl.v, rl.d, create$1(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height$1(rr) >= height$1(rl)) { + return create$1(create$1(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$1(create$1(l, x, d, rl.l), rl.v, rl.d, create$1(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -306,8 +317,9 @@ function bal$1(l, x, d, r) { } function add$1(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -324,7 +336,8 @@ function add$1(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -352,17 +365,17 @@ function add$1(x, data, m) { function find(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(funarg.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(funarg.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } diff --git a/jscomp/test/dist/jscomp/test/mario_game.js b/jscomp/test/dist/jscomp/test/mario_game.js index 1136d76474..6377d6f8ab 100644 --- a/jscomp/test/dist/jscomp/test/mario_game.js +++ b/jscomp/test/dist/jscomp/test/mario_game.js @@ -61,9 +61,9 @@ function make_enemy(param) { 128 ]); case /* GKoopa */1 : - if (dir) { + if (dir === /* Left */0) { return setup_sprite(undefined, [ - 1, + 4, 10 ], [ 11, @@ -72,12 +72,12 @@ function make_enemy(param) { 16, 27 ], [ - 32, + 0, 69 ]); } else { return setup_sprite(undefined, [ - 4, + 1, 10 ], [ 11, @@ -86,14 +86,14 @@ function make_enemy(param) { 16, 27 ], [ - 0, + 32, 69 ]); } case /* RKoopa */2 : - if (dir) { + if (dir === /* Left */0) { return setup_sprite(undefined, [ - 1, + 4, 10 ], [ 11, @@ -102,12 +102,12 @@ function make_enemy(param) { 16, 27 ], [ - 32, + 0, 5 ]); } else { return setup_sprite(undefined, [ - 4, + 1, 10 ], [ 11, @@ -116,7 +116,7 @@ function make_enemy(param) { 16, 27 ], [ - 0, + 32, 5 ]); } @@ -247,72 +247,72 @@ function make_particle(param) { } function make_type(typ, dir) { - switch (typ.TAG | 0) { + switch (typ.TAG) { case /* SPlayer */0 : let pt = typ._0; let spr_type = [ typ._1, dir ]; - if (pt) { + if (pt === /* BigM */0) { const typ$1 = spr_type[0]; - if (spr_type[1]) { + if (spr_type[1] === /* Left */0) { switch (typ$1) { case /* Standing */0 : return setup_sprite(undefined, [ - 1, + 2, 1 ], [ - 11, - 15 - ], "mario-small.png", 1, 0, [ + 13, + 25 + ], "mario-big.png", 1, 0, [ 16, - 16 + 27 ], [ - 0, - 32 + 16, + 5 ]); case /* Jumping */1 : return setup_sprite(undefined, [ 2, 1 ], [ - 13, - 15 - ], "mario-small.png", 2, 10, [ + 12, + 25 + ], "mario-big.png", 1, 0, [ 16, - 16 + 26 ], [ - 16, - 48 + 48, + 6 ]); case /* Running */2 : return setup_sprite(undefined, [ 2, 1 ], [ - 12, - 15 - ], "mario-small.png", 3, 5, [ + 13, + 25 + ], "mario-big.png", 4, 10, [ 16, - 16 + 27 ], [ - 16, - 32 + 0, + 37 ]); case /* Crouching */3 : return setup_sprite(undefined, [ - 1, - 5 - ], [ - 14, + 2, 10 - ], "mario-small.png", 1, 0, [ + ], [ + 13, + 17 + ], "mario-big.png", 1, 0, [ 16, - 16 + 27 ], [ - 0, - 64 + 32, + 5 ]); } @@ -320,122 +320,122 @@ function make_type(typ, dir) { switch (typ$1) { case /* Standing */0 : return setup_sprite(undefined, [ - 3, + 1, 1 ], [ - 11, - 15 - ], "mario-small.png", 1, 0, [ + 13, + 25 + ], "mario-big.png", 1, 0, [ 16, - 16 + 26 ], [ - 0, - 0 + 16, + 69 ]); case /* Jumping */1 : return setup_sprite(undefined, [ 2, 1 ], [ - 13, - 15 - ], "mario-small.png", 2, 10, [ + 12, + 25 + ], "mario-big.png", 1, 0, [ 16, - 16 + 26 ], [ - 16, - 16 + 48, + 70 ]); case /* Running */2 : return setup_sprite(undefined, [ 2, 1 ], [ - 12, - 15 - ], "mario-small.png", 3, 5, [ + 13, + 25 + ], "mario-big.png", 4, 10, [ 16, - 16 + 27 ], [ - 16, - 0 + 0, + 101 ]); case /* Crouching */3 : return setup_sprite(undefined, [ - 1, - 5 - ], [ - 14, + 2, 10 - ], "mario-small.png", 1, 0, [ + ], [ + 13, + 17 + ], "mario-big.png", 1, 0, [ 16, - 16 + 27 ], [ - 0, - 64 + 32, + 69 ]); } } } else { const typ$2 = spr_type[0]; - if (spr_type[1]) { + if (spr_type[1] === /* Left */0) { switch (typ$2) { case /* Standing */0 : return setup_sprite(undefined, [ - 1, + 3, 1 ], [ - 13, - 25 - ], "mario-big.png", 1, 0, [ + 11, + 15 + ], "mario-small.png", 1, 0, [ 16, - 26 + 16 ], [ - 16, - 69 + 0, + 0 ]); case /* Jumping */1 : return setup_sprite(undefined, [ 2, 1 ], [ - 12, - 25 - ], "mario-big.png", 1, 0, [ + 13, + 15 + ], "mario-small.png", 2, 10, [ 16, - 26 + 16 ], [ - 48, - 70 + 16, + 16 ]); case /* Running */2 : return setup_sprite(undefined, [ 2, 1 ], [ - 13, - 25 - ], "mario-big.png", 4, 10, [ + 12, + 15 + ], "mario-small.png", 3, 5, [ 16, - 27 + 16 ], [ - 0, - 101 + 16, + 0 ]); case /* Crouching */3 : return setup_sprite(undefined, [ - 2, - 10 + 1, + 5 ], [ - 13, - 17 - ], "mario-big.png", 1, 0, [ + 14, + 10 + ], "mario-small.png", 1, 0, [ 16, - 27 + 16 ], [ - 32, - 69 + 0, + 64 ]); } @@ -443,59 +443,59 @@ function make_type(typ, dir) { switch (typ$2) { case /* Standing */0 : return setup_sprite(undefined, [ - 2, + 1, 1 ], [ - 13, - 25 - ], "mario-big.png", 1, 0, [ + 11, + 15 + ], "mario-small.png", 1, 0, [ 16, - 27 + 16 ], [ - 16, - 5 + 0, + 32 ]); case /* Jumping */1 : return setup_sprite(undefined, [ 2, 1 ], [ - 12, - 25 - ], "mario-big.png", 1, 0, [ + 13, + 15 + ], "mario-small.png", 2, 10, [ 16, - 26 + 16 ], [ - 48, - 6 + 16, + 48 ]); case /* Running */2 : return setup_sprite(undefined, [ 2, 1 ], [ - 13, - 25 - ], "mario-big.png", 4, 10, [ + 12, + 15 + ], "mario-small.png", 3, 5, [ 16, - 27 + 16 ], [ - 0, - 37 + 16, + 32 ]); case /* Crouching */3 : return setup_sprite(undefined, [ - 2, - 10 + 1, + 5 ], [ - 13, - 17 - ], "mario-big.png", 1, 0, [ + 14, + 10 + ], "mario-small.png", 1, 0, [ 16, - 27 + 16 ], [ - 32, - 5 + 0, + 64 ]); } @@ -557,7 +557,7 @@ function make_type(typ, dir) { } case /* SBlock */3 : let param$1 = typ._0; - if (typeof param$1 !== "number") { + if (!/* tag */(typeof param$1 === "number" || typeof param$1 === "string")) { return setup_sprite(undefined, undefined, undefined, "blocks.png", 4, 15, [ 16, 16 @@ -702,18 +702,20 @@ function pair_to_xy(pair) { } function make_type$1(typ, ctx) { - if (typ === 2 || typ === 1) { - return { - sprite: make_particle$1(typ, ctx), - rot: 0, - lifetime: 300 - }; - } else { - return { - sprite: make_particle$1(typ, ctx), - rot: 0, - lifetime: 30 - }; + switch (typ) { + case /* BrickChunkL */1 : + case /* BrickChunkR */2 : + return { + sprite: make_particle$1(typ, ctx), + rot: 0, + lifetime: 300 + }; + default: + return { + sprite: make_particle$1(typ, ctx), + rot: 0, + lifetime: 30 + }; } } @@ -804,27 +806,29 @@ function setup_obj(has_gravityOpt, speedOpt, param) { function set_vel_to_speed(obj) { const speed = obj.params.speed; const match = obj.dir; - if (match) { - obj.vel.x = speed; - } else { + if (match === /* Left */0) { obj.vel.x = - speed; + } else { + obj.vel.x = speed; } } function make_type$2(t) { - switch (t.TAG | 0) { + switch (t.TAG) { case /* SPlayer */0 : return setup_obj(undefined, 2.8, undefined); case /* SEnemy */1 : let param = t._0; - if (param >= 3) { - return setup_obj(undefined, 3, undefined); - } else { - return setup_obj(undefined, undefined, undefined); + switch (param) { + case /* GKoopaShell */3 : + case /* RKoopaShell */4 : + return setup_obj(undefined, 3, undefined); + default: + return setup_obj(undefined, undefined, undefined); } case /* SItem */2 : let param$1 = t._0; - if (param$1 >= 3) { + if (param$1 === /* Coin */3) { return setup_obj(false, undefined, undefined); } else { return setup_obj(undefined, undefined, undefined); @@ -879,7 +883,7 @@ function spawn(spawnable, context, param) { ]); const obj = match[1]; const spr = match[0]; - switch (spawnable.TAG | 0) { + switch (spawnable.TAG) { case /* SPlayer */0 : return { TAG: /* Player */0, @@ -1091,29 +1095,38 @@ function normalize_origin(pos, spr) { function collide_block(check_xOpt, dir, obj) { const check_x = check_xOpt !== undefined ? check_xOpt : true; - if (dir !== 1) { - if (dir) { - if (check_x) { - obj.vel.x = 0; + switch (dir) { + case /* North */0 : + obj.vel.y = -0.001; return ; - } else { + case /* South */1 : + obj.vel.y = 0; + obj.grounded = true; + obj.jumping = false; return ; - } - } else { - obj.vel.y = -0.001; - return ; - } - } else { - obj.vel.y = 0; - obj.grounded = true; - obj.jumping = false; + case /* East */2 : + case /* West */3 : + break; + + } + if (check_x) { + obj.vel.x = 0; return ; } + +} + +function opposite_dir(dir) { + if (dir === /* Left */0) { + return /* Right */1; + } else { + return /* Left */0; + } } function reverse_left_right(obj) { obj.vel.x = - obj.vel.x; - obj.dir = obj.dir ? /* Left */0 : /* Right */1; + obj.dir = opposite_dir(obj.dir); } function evolve_enemy(player_dir, typ, spr, obj, context) { @@ -1215,7 +1228,7 @@ function spawn_above(player_dir, obj, typ, context) { ]); const item_obj = item._2; item_obj.pos.y = item_obj.pos.y - item._1.params.frame_size[1]; - item_obj.dir = player_dir ? /* Left */0 : /* Right */1; + item_obj.dir = opposite_dir(player_dir); set_vel_to_speed(item_obj); return item; } @@ -1245,7 +1258,7 @@ function col_bypass(c1, c2) { const o1 = c1._2; const o2 = c2._2; let ctypes; - switch (c1.TAG | 0) { + switch (c1.TAG) { case /* Player */0 : ctypes = c2.TAG === /* Enemy */1 ? c1._2.invuln > 0 : false; break; @@ -1253,7 +1266,7 @@ function col_bypass(c1, c2) { ctypes = c2.TAG === /* Item */2 ? true : false; break; case /* Item */2 : - switch (c2.TAG | 0) { + switch (c2.TAG) { case /* Enemy */1 : case /* Item */2 : ctypes = true; @@ -1311,7 +1324,7 @@ function check_collision(c1, c2) { } function kill(collid, ctx) { - switch (collid.TAG | 0) { + switch (collid.TAG) { case /* Player */0 : return /* [] */0; case /* Enemy */1 : @@ -1326,16 +1339,15 @@ function kill(collid, ctx) { hd: make_score(o.score, pos, ctx), tl: /* [] */0 }) : /* [] */0; - const remains = collid._0 ? /* [] */0 : ({ + let remains; + remains = collid._0 === /* Goomba */0 ? ({ hd: make$1(undefined, undefined, /* GoombaSquish */0, pos, ctx), tl: /* [] */0 - }); + }) : /* [] */0; return Stdlib.$at(score, remains); case /* Item */2 : const o$1 = collid._2; - if (collid._0) { - return /* [] */0; - } else { + if (collid._0 === /* Mushroom */0) { return { hd: make_score(o$1.score, [ o$1.pos.x, @@ -1343,10 +1355,16 @@ function kill(collid, ctx) { ], ctx), tl: /* [] */0 }; + } else { + return /* [] */0; } case /* Block */3 : const o$2 = collid._2; - if (collid._0 !== 1) { + let tmp = collid._0; + if (!/* tag */(typeof tmp === "number" || typeof tmp === "string")) { + return /* [] */0; + } + if (tmp !== /* Brick */1) { return /* [] */0; } const pos_0$1 = o$2.pos.x; @@ -1628,11 +1646,11 @@ function process_collision(dir, c1, c2, state) { let o1$2; let t2$1; let o2$2; - switch (c1.TAG | 0) { + switch (c1.TAG) { case /* Player */0 : const o1$3 = c1._2; const s1$2 = c1._1; - switch (c2.TAG | 0) { + switch (c2.TAG) { case /* Player */0 : return [ undefined, @@ -1640,20 +1658,20 @@ function process_collision(dir, c1, c2, state) { ]; case /* Enemy */1 : const typ$1 = c2._0; - if (dir !== 1) { - s1$1 = s1$2; - o1$1 = o1$3; - t2 = typ$1; - s2$1 = c2._1; - o2$1 = c2._2; - exit = 2; - } else { + if (dir === /* South */1) { s1 = s1$2; o1 = o1$3; typ = typ$1; s2 = c2._1; o2 = c2._2; exit = 1; + } else { + s1$1 = s1$2; + o1$1 = o1$3; + t2 = typ$1; + s2$1 = c2._1; + o2$1 = c2._2; + exit = 2; } break; case /* Item */2 : @@ -1664,66 +1682,79 @@ function process_collision(dir, c1, c2, state) { break; case /* Block */3 : const t = c2._0; - if (dir) { - if (t === 4) { - game_win(state.ctx); - return [ - undefined, - undefined - ]; - } else if (dir !== 1) { - collide_block(undefined, dir, o1$3); - return [ - undefined, - undefined - ]; + if (dir === /* North */0) { + const o2$3 = c2._2; + if (/* tag */typeof t === "number" || typeof t === "string") { + switch (t) { + case /* Brick */1 : + if (c1._0 === /* BigM */0) { + collide_block(undefined, dir, o1$3); + dec_health(o2$3); + return [ + undefined, + undefined + ]; + } else { + collide_block(undefined, dir, o1$3); + return [ + undefined, + undefined + ]; + } + case /* Panel */4 : + game_win(state.ctx); + return [ + undefined, + undefined + ]; + default: + collide_block(undefined, dir, o1$3); + return [ + undefined, + undefined + ]; + } } else { - state.multiplier = 1; + const updated_block = evolve_block(o2$3, context); + const spawned_item = spawn_above(o1$3.dir, o2$3, t._0, context); collide_block(undefined, dir, o1$3); return [ - undefined, - undefined + spawned_item, + updated_block ]; } - } - const o2$3 = c2._2; - if (typeof t === "number") { - if (t !== 1) { - if (t !== 4) { - collide_block(undefined, dir, o1$3); + } else { + let exit$1 = 0; + if (/* tag */typeof t === "number" || typeof t === "string") { + if (t === /* Panel */4) { + game_win(state.ctx); return [ undefined, undefined ]; - } else { - game_win(state.ctx); + } + exit$1 = 4; + } else { + exit$1 = 4; + } + if (exit$1 === 4) { + if (dir === /* South */1) { + state.multiplier = 1; + collide_block(undefined, dir, o1$3); return [ undefined, undefined ]; } - } else if (c1._0 === /* BigM */0) { - collide_block(undefined, dir, o1$3); - dec_health(o2$3); - return [ - undefined, - undefined - ]; - } else { collide_block(undefined, dir, o1$3); return [ undefined, undefined ]; } + } - const updated_block = evolve_block(o2$3, context); - const spawned_item = spawn_above(o1$3.dir, o2$3, t._0, context); - collide_block(undefined, dir, o1$3); - return [ - spawned_item, - updated_block - ]; + break; } break; @@ -1731,31 +1762,105 @@ function process_collision(dir, c1, c2, state) { const o1$4 = c1._2; const s1$3 = c1._1; const t1 = c1._0; - switch (c2.TAG | 0) { + switch (c2.TAG) { case /* Player */0 : - if (dir) { - s1$1 = c2._1; - o1$1 = c2._2; - t2 = t1; - s2$1 = s1$3; - o2$1 = o1$4; - exit = 2; - } else { + if (dir === /* North */0) { s1 = c2._1; o1 = c2._2; typ = t1; s2 = s1$3; o2 = o1$4; exit = 1; + } else { + s1$1 = c2._1; + o1$1 = c2._2; + t2 = t1; + s2$1 = s1$3; + o2$1 = o1$4; + exit = 2; } break; case /* Enemy */1 : let t2$2 = c2._0; let s2$2 = c2._1; let o2$4 = c2._2; - if (t1 !== 3) { - if (t1 < 4) { - if (t2$2 >= 3) { + let exit$2 = 0; + switch (t1) { + case /* GKoopaShell */3 : + switch (t2$2) { + case /* GKoopaShell */3 : + case /* RKoopaShell */4 : + exit$2 = 1; + break; + default: + exit$2 = 2; + } + break; + case /* RKoopaShell */4 : + switch (t2$2) { + case /* GKoopaShell */3 : + case /* RKoopaShell */4 : + exit$2 = 1; + break; + default: + exit$2 = 2; + } + break; + default: + switch (t2$2) { + case /* GKoopaShell */3 : + case /* RKoopaShell */4 : + exit$2 = 3; + break; + default: + let exit$3 = 0; + switch (dir) { + case /* North */0 : + case /* South */1 : + return [ + undefined, + undefined + ]; + case /* East */2 : + case /* West */3 : + exit$3 = 4; + break; + + } + if (exit$3 === 4) { + rev_dir(o1$4, t1, s1$3); + rev_dir(o2$4, t2$2, s2$2); + return [ + undefined, + undefined + ]; + } + + } + } + switch (exit$2) { + case 1 : + dec_health(o1$4); + dec_health(o2$4); + return [ + undefined, + undefined + ]; + case 2 : + if (o1$4.vel.x === 0) { + rev_dir(o2$4, t2$2, s2$2); + return [ + undefined, + undefined + ]; + } else { + dec_health(o2$4); + return [ + undefined, + undefined + ]; + } + case 3 : if (o2$4.vel.x === 0) { rev_dir(o1$4, t1, s1$3); return [ @@ -1769,49 +1874,7 @@ function process_collision(dir, c1, c2, state) { undefined ]; } - } else if (dir >= 2) { - rev_dir(o1$4, t1, s1$3); - rev_dir(o2$4, t2$2, s2$2); - return [ - undefined, - undefined - ]; - } else { - return [ - undefined, - undefined - ]; - } - } - if (t2$2 >= 3) { - dec_health(o1$4); - dec_health(o2$4); - return [ - undefined, - undefined - ]; - } - } else if (t2$2 >= 3) { - dec_health(o1$4); - dec_health(o2$4); - return [ - undefined, - undefined - ]; - } - if (o1$4.vel.x === 0) { - rev_dir(o2$4, t2$2, s2$2); - return [ - undefined, - undefined - ]; - } else { - dec_health(o2$4); - return [ - undefined, - undefined - ]; } case /* Item */2 : return [ @@ -1821,49 +1884,85 @@ function process_collision(dir, c1, c2, state) { case /* Block */3 : const t2$3 = c2._0; const o2$5 = c2._2; - if (dir >= 2) { - if (t1 >= 3) { - if (typeof t2$3 === "number") { - if (t2$3 !== 1) { + let exit$4 = 0; + switch (dir) { + case /* North */0 : + case /* South */1 : + collide_block(undefined, dir, o1$4); + return [ + undefined, + undefined + ]; + case /* East */2 : + case /* West */3 : + exit$4 = 4; + break; + + } + if (exit$4 === 4) { + let exit$5 = 0; + let typ$2; + switch (t1) { + case /* GKoopaShell */3 : + if (/* tag */typeof t2$3 === "number" || typeof t2$3 === "string") { + if (t2$3 === /* Brick */1) { + dec_health(o2$5); + reverse_left_right(o1$4); + return [ + undefined, + undefined + ]; + } + exit$5 = 5; + } else { + typ$2 = t2$3._0; + exit$5 = 6; + } + break; + case /* RKoopaShell */4 : + if (/* tag */typeof t2$3 === "number" || typeof t2$3 === "string") { + if (t2$3 === /* Brick */1) { + dec_health(o2$5); + reverse_left_right(o1$4); + return [ + undefined, + undefined + ]; + } + exit$5 = 5; + } else { + typ$2 = t2$3._0; + exit$5 = 6; + } + break; + default: + exit$5 = 5; + } + switch (exit$5) { + case 5 : rev_dir(o1$4, t1, s1$3); return [ undefined, undefined ]; - } else { - dec_health(o2$5); - reverse_left_right(o1$4); + case 6 : + const updated_block$1 = evolve_block(o2$5, context); + const spawned_item$1 = spawn_above(o1$4.dir, o2$5, typ$2, context); + rev_dir(o1$4, t1, s1$3); return [ - undefined, - undefined + updated_block$1, + spawned_item$1 ]; - } - } - const updated_block$1 = evolve_block(o2$5, context); - const spawned_item$1 = spawn_above(o1$4.dir, o2$5, t2$3._0, context); - rev_dir(o1$4, t1, s1$3); - return [ - updated_block$1, - spawned_item$1 - ]; + } - rev_dir(o1$4, t1, s1$3); - return [ - undefined, - undefined - ]; } - collide_block(undefined, dir, o1$4); - return [ - undefined, - undefined - ]; + break; } break; case /* Item */2 : const o2$6 = c1._2; - switch (c2.TAG | 0) { + switch (c2.TAG) { case /* Player */0 : o1$2 = c2._2; t2$1 = c1._0; @@ -1877,18 +1976,22 @@ function process_collision(dir, c1, c2, state) { undefined ]; case /* Block */3 : - if (dir >= 2) { - reverse_left_right(o2$6); - return [ - undefined, - undefined - ]; - } else { - collide_block(undefined, dir, o2$6); - return [ - undefined, - undefined - ]; + switch (dir) { + case /* North */0 : + case /* South */1 : + collide_block(undefined, dir, o2$6); + return [ + undefined, + undefined + ]; + case /* East */2 : + case /* West */3 : + reverse_left_right(o2$6); + return [ + undefined, + undefined + ]; + } } @@ -1905,81 +2008,96 @@ function process_collision(dir, c1, c2, state) { o1.invuln = 10; o1.jumping = false; o1.grounded = true; - if (typ >= 3) { - const r2 = evolve_enemy(o1.dir, typ, s2, o2, context); - o1.vel.y = - 4; - o1.pos.y = o1.pos.y - 5; - return [ - undefined, - r2 - ]; + switch (typ) { + case /* GKoopaShell */3 : + case /* RKoopaShell */4 : + break; + default: + dec_health(o2); + o1.vel.y = - 4; + if (state.multiplier === 8) { + update_score(state, 800); + o2.score = 800; + return [ + undefined, + evolve_enemy(o1.dir, typ, s2, o2, context) + ]; + } + const score = Math.imul(100, state.multiplier); + update_score(state, score); + o2.score = score; + state.multiplier = (state.multiplier << 1); + return [ + undefined, + evolve_enemy(o1.dir, typ, s2, o2, context) + ]; } - dec_health(o2); + const r2 = evolve_enemy(o1.dir, typ, s2, o2, context); o1.vel.y = - 4; - if (state.multiplier === 8) { - update_score(state, 800); - o2.score = 800; - return [ - undefined, - evolve_enemy(o1.dir, typ, s2, o2, context) - ]; - } - const score = Math.imul(100, state.multiplier); - update_score(state, score); - o2.score = score; - state.multiplier = (state.multiplier << 1); + o1.pos.y = o1.pos.y - 5; return [ undefined, - evolve_enemy(o1.dir, typ, s2, o2, context) + r2 ]; case 2 : - if (t2 >= 3) { - const r2$1 = o2$1.vel.x === 0 ? evolve_enemy(o1$1.dir, t2, s2$1, o2$1, context) : (dec_health(o1$1), o1$1.invuln = 60, undefined); - return [ - undefined, - r2$1 - ]; + switch (t2) { + case /* GKoopaShell */3 : + case /* RKoopaShell */4 : + break; + default: + dec_health(o1$1); + o1$1.invuln = 60; + return [ + undefined, + undefined + ]; } - dec_health(o1$1); - o1$1.invuln = 60; + const r2$1 = o2$1.vel.x === 0 ? evolve_enemy(o1$1.dir, t2, s2$1, o2$1, context) : (dec_health(o1$1), o1$1.invuln = 60, undefined); return [ undefined, - undefined + r2$1 ]; case 3 : - if (t2$1) { - if (t2$1 >= 3) { - state.coins = state.coins + 1 | 0; - dec_health(o2$2); - update_score(state, 100); - return [ - undefined, - undefined - ]; - } else { - dec_health(o2$2); - update_score(state, 1000); - return [ - undefined, - undefined - ]; - } - } else { + let exit$6 = 0; + switch (t2$1) { + case /* Mushroom */0 : + dec_health(o2$2); + if (o1$2.health === 2) { + + } else { + o1$2.health = o1$2.health + 1 | 0; + } + o1$2.vel.x = 0; + o1$2.vel.y = 0; + update_score(state, 1000); + o2$2.score = 1000; + return [ + undefined, + undefined + ]; + case /* FireFlower */1 : + case /* Star */2 : + exit$6 = 4; + break; + case /* Coin */3 : + state.coins = state.coins + 1 | 0; + dec_health(o2$2); + update_score(state, 100); + return [ + undefined, + undefined + ]; + + } + if (exit$6 === 4) { dec_health(o2$2); - if (o1$2.health === 2) { - - } else { - o1$2.health = o1$2.health + 1 | 0; - } - o1$2.vel.x = 0; - o1$2.vel.y = 0; update_score(state, 1000); - o2$2.score = 1000; return [ undefined, undefined ]; } + break; } } @@ -2406,7 +2524,8 @@ function choose_sblock_typ(typ) { case 2 : return /* Cloud */3; case 3 : - return /* QBlock */{ + return { + TAG: /* QBlock */0, _0: /* Mushroom */0 }; case 4 : @@ -3197,7 +3316,8 @@ function load(param) { if (el !== null) { canvas = el; } else { - Curry._1(Stdlib__Printf.printf(/* Format */{ + Curry._1(Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "cant find canvas ", diff --git a/jscomp/test/dist/jscomp/test/miss_colon_test.js b/jscomp/test/dist/jscomp/test/miss_colon_test.js index 31f00f1009..297221da73 100644 --- a/jscomp/test/dist/jscomp/test/miss_colon_test.js +++ b/jscomp/test/dist/jscomp/test/miss_colon_test.js @@ -19,7 +19,7 @@ function $plus$colon(_f, _g) { } } - switch (g.TAG | 0) { + switch (g.TAG) { case /* Int */0 : if (g._0 !== 0) { return { @@ -86,7 +86,7 @@ function $star$colon(_f, _g) { if (exit === 2 && f.TAG === /* Int */0 && f._0 === 1) { return g; } - switch (g.TAG | 0) { + switch (g.TAG) { case /* Int */0 : if (g._0 !== 1) { return { @@ -114,7 +114,7 @@ function $star$colon(_f, _g) { } function simplify(f) { - switch (f.TAG | 0) { + switch (f.TAG) { case /* Int */0 : case /* Var */1 : return f; diff --git a/jscomp/test/dist/jscomp/test/mock_mt.js b/jscomp/test/dist/jscomp/test/mock_mt.js index 14dbf23b5c..843c441e8b 100644 --- a/jscomp/test/dist/jscomp/test/mock_mt.js +++ b/jscomp/test/dist/jscomp/test/mock_mt.js @@ -12,7 +12,7 @@ function from_pair_suites(name, suites) { Stdlib__List.iter((function (param) { const name = param[0]; const fn = Curry._1(param[1], undefined); - switch (fn.TAG | 0) { + switch (fn.TAG) { case /* Eq */0 : console.log([ name, diff --git a/jscomp/test/dist/jscomp/test/mt.js b/jscomp/test/dist/jscomp/test/mt.js index 19c3d096db..fb669e39f8 100644 --- a/jscomp/test/dist/jscomp/test/mt.js +++ b/jscomp/test/dist/jscomp/test/mt.js @@ -51,7 +51,7 @@ function close_enough(thresholdOpt, a, b) { } function handleCode(spec) { - switch (spec.TAG | 0) { + switch (spec.TAG) { case /* Eq */0 : Assert.deepEqual(spec._0, spec._1); return ; @@ -117,7 +117,7 @@ function from_pair_suites(name, suites) { return Stdlib__List.iter((function (param) { const name = param[0]; const _fn = Curry._1(param[1], undefined); - switch (_fn.TAG | 0) { + switch (_fn.TAG) { case /* Eq */0 : console.log([ name, diff --git a/jscomp/test/dist/jscomp/test/mutual_non_recursive_type.js b/jscomp/test/dist/jscomp/test/mutual_non_recursive_type.js index 14bf2f06ef..0300b15ccf 100644 --- a/jscomp/test/dist/jscomp/test/mutual_non_recursive_type.js +++ b/jscomp/test/dist/jscomp/test/mutual_non_recursive_type.js @@ -10,7 +10,8 @@ const U = { f: f }; -const v = /* H */{ +const v = { + TAG: /* H */0, _0: /* OT */0 }; diff --git a/jscomp/test/dist/jscomp/test/ocaml_parsetree_test.js b/jscomp/test/dist/jscomp/test/ocaml_parsetree_test.js index 886977bf7e..cd9282b41d 100644 --- a/jscomp/test/dist/jscomp/test/ocaml_parsetree_test.js +++ b/jscomp/test/dist/jscomp/test/ocaml_parsetree_test.js @@ -109,7 +109,7 @@ function ansi_of_color(param) { } function code_of_style(c) { - if (typeof c !== "number") { + if (!/* tag */(typeof c === "number" || typeof c === "string")) { if (c.TAG === /* FG */0) { return "3" + ansi_of_color(c._0); } else { @@ -332,7 +332,7 @@ const Misc_Color = { }; function number(param) { - if (typeof param === "number") { + if (/* tag */typeof param === "number" || typeof param === "string") { switch (param) { case /* Comment_start */0 : return 1; @@ -371,7 +371,7 @@ function number(param) { } } else { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Deprecated */0 : return 3; case /* Fragile_match */1 : @@ -815,7 +815,7 @@ parse_options(false, "+a-4-6-7-9-27-29-32..39-41..42-44-45-48-50-102"); parse_options(true, "-a"); function message(s) { - if (typeof s === "number") { + if (/* tag */typeof s === "number" || typeof s === "string") { switch (s) { case /* Comment_start */0 : return "this is the start of a comment."; @@ -854,7 +854,7 @@ function message(s) { } } else { - switch (s.TAG | 0) { + switch (s.TAG) { case /* Deprecated */0 : return "deprecated: " + s._0; case /* Fragile_match */1 : @@ -943,7 +943,8 @@ function message(s) { case /* Unused_var_strict */13 : return "unused variable " + (s._0 + "."); case /* Duplicate_definitions */14 : - return Curry._4(Stdlib__Printf.sprintf(/* Format */{ + return Curry._4(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "the ", @@ -984,7 +985,8 @@ function message(s) { _1: "the %s %s is defined in both types %s and %s." }), s._0, s._1, s._2, s._3); case /* Multiple_definition */15 : - return Curry._3(Stdlib__Printf.sprintf(/* Format */{ + return Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "files ", @@ -1080,7 +1082,8 @@ function message(s) { case /* Nonoptional_label */26 : return "the label " + (s._0 + " is not optional."); case /* Open_shadow_identifier */27 : - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "this open statement shadows the ", @@ -1105,7 +1108,8 @@ function message(s) { _1: "this open statement shadows the %s identifier %s (which is later used)" }), s._0, s._1); case /* Open_shadow_label_constructor */28 : - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "this open statement shadows the ", @@ -1130,7 +1134,8 @@ function message(s) { _1: "this open statement shadows the %s %s (which is later used)" }), s._0, s._1); case /* Bad_env_variable */29 : - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "illegal environment variable ", @@ -1151,7 +1156,8 @@ function message(s) { _1: "illegal environment variable %s : %s" }), s._0, s._1); case /* Attribute_payload */30 : - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "illegal payload for attribute '", @@ -1173,7 +1179,8 @@ function message(s) { }), s._0, s._1); case /* Eliminated_optional_arguments */31 : const sl = s._0; - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "implicit elimination of optional argument", @@ -1219,7 +1226,8 @@ const nerrors = { function print(ppf, w) { const msg = message(w); const num = number(w); - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -1385,7 +1393,8 @@ function highlight_dumb(ppf, lb, loc) { } } - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Characters ", @@ -1446,7 +1455,8 @@ function highlight_dumb(ppf, lb, loc) { } else { if (line === line_start && line === line_end) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: /* Flush_newline */4, @@ -1466,7 +1476,8 @@ function highlight_dumb(ppf, lb, loc) { } } if (line >= line_start && line <= line_end) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: /* Flush_newline */4, @@ -1488,42 +1499,41 @@ function highlight_dumb(ppf, lb, loc) { function highlight_locations(ppf, locs) { while(true) { const num_lines = status.contents; - if (typeof num_lines === "number") { - if (num_lines) { - const lb = input_lexbuf.contents; - if (lb === undefined) { - return false; - } - let norepeat; - try { - norepeat = Caml_sys.caml_sys_getenv("TERM") === "norepeat"; - } - catch (raw_exn){ - const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); - if (exn.MEL_EXN_ID === Stdlib.Not_found) { - norepeat = false; - } else { - throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); - } + if (/* tag */typeof num_lines === "number" || typeof num_lines === "string") { + if (num_lines === /* Uninitialised */0) { + status.contents = Caml_external_polyfill.resolve("caml_terminfo_setup")(Stdlib.stdout); + continue ; + } + const lb = input_lexbuf.contents; + if (lb === undefined) { + return false; + } + let norepeat; + try { + norepeat = Caml_sys.caml_sys_getenv("TERM") === "norepeat"; + } + catch (raw_exn){ + const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); + if (exn.MEL_EXN_ID === Stdlib.Not_found) { + norepeat = false; + } else { + throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } - if (norepeat) { + } + if (norepeat) { + return false; + } + const loc1 = Stdlib__List.hd(locs); + try { + highlight_dumb(ppf, lb, loc1); + return true; + } + catch (raw_exn$1){ + const exn$1 = Caml_js_exceptions.internalToOCamlException(raw_exn$1); + if (exn$1.MEL_EXN_ID === Stdlib.Exit) { return false; } - const loc1 = Stdlib__List.hd(locs); - try { - highlight_dumb(ppf, lb, loc1); - return true; - } - catch (raw_exn$1){ - const exn$1 = Caml_js_exceptions.internalToOCamlException(raw_exn$1); - if (exn$1.MEL_EXN_ID === Stdlib.Exit) { - return false; - } - throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); - } - } else { - status.contents = Caml_external_polyfill.resolve("caml_terminfo_setup")(Stdlib.stdout); - continue ; + throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); } } else { const lb$1 = input_lexbuf.contents; @@ -1574,7 +1584,8 @@ function show_filename(file) { } function print_filename(ppf, file) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1606,7 +1617,8 @@ function print_loc(ppf, loc) { })) { return ; } else { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Characters ", @@ -1632,7 +1644,8 @@ function print_loc(ppf, loc) { }), loc.loc_start.pos_cnum, loc.loc_end.pos_cnum); } } else { - Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1640,7 +1653,8 @@ function print_loc(ppf, loc) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_tag */0, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -1668,7 +1682,8 @@ function print_loc(ppf, loc) { _1: "%s@{%a%s%i" }), "File \"", print_filename, file, "\", line ", match[1]); if (startchar$1 >= 0) { - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1693,7 +1708,8 @@ function print_loc(ppf, loc) { _1: "%s%i%s%i" }), ", characters ", startchar$1, "-", endchar); } - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: /* Close_tag */1, @@ -1712,12 +1728,14 @@ function print$1(ppf, loc) { })) { return ; } else { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_tag */0, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -1753,12 +1771,14 @@ const error_prefix = "Error"; function print_error(ppf, loc) { print$1(ppf, loc); Curry._1(Misc_Color.setup, color.contents); - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_tag */0, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -1789,12 +1809,14 @@ function default_warning_printer(loc, ppf, w) { if (is_active(w)) { Curry._1(Misc_Color.setup, color.contents); print$1(ppf, loc); - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_tag */0, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -1915,7 +1937,8 @@ function register_error_of_exn(f) { } function error_of_printer(loc, print, x) { - return Curry._2(errorf(loc, undefined, undefined, /* Format */{ + return Curry._2(errorf(loc, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -1930,7 +1953,8 @@ function error_of_printer(loc, print, x) { register_error_of_exn(function (msg) { if (msg.MEL_EXN_ID === Stdlib.Sys_error) { - return Curry._1(errorf(in_file(input_name.contents), undefined, undefined, /* Format */{ + return Curry._1(errorf(in_file(input_name.contents), undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "I/O error: ", @@ -1943,7 +1967,8 @@ register_error_of_exn(function (msg) { _1: "I/O error: %s" }), msg._1); } else if (msg.MEL_EXN_ID === Errors) { - return Curry._1(errorf(in_file(input_name.contents), undefined, undefined, /* Format */{ + return Curry._1(errorf(in_file(input_name.contents), undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Some fatal warnings were triggered (", @@ -1976,7 +2001,7 @@ register_error_of_exn(function (e) { }); function last(s) { - switch (s.TAG | 0) { + switch (s.TAG) { case /* Lident */0 : return s._0; case /* Ldot */1 : @@ -2022,7 +2047,7 @@ function from_pair_suites(name, suites) { const code = param[1]; it(param[0], (function () { let spec = Curry._1(code, undefined); - switch (spec.TAG | 0) { + switch (spec.TAG) { case /* Eq */0 : Assert.deepEqual(spec._0, spec._1); return ; @@ -2077,7 +2102,7 @@ function from_pair_suites(name, suites) { return Stdlib__List.iter((function (param) { const name = param[0]; const fn = Curry._1(param[1], undefined); - switch (fn.TAG | 0) { + switch (fn.TAG) { case /* Eq */0 : console.log([ name, @@ -2175,13 +2200,16 @@ function warn_bad_docstrings(param) { return ; case /* Docs */2 : const match$1 = ds.ds_associated; - if (match$1 >= 2) { - return prerr_warning(ds.ds_loc, { - TAG: /* Bad_docstring */33, - _0: false - }); - } else { - return ; + switch (match$1) { + case /* Zero */0 : + case /* One */1 : + return ; + case /* Many */2 : + return prerr_warning(ds.ds_loc, { + TAG: /* Bad_docstring */33, + _0: false + }); + } } @@ -2334,12 +2362,17 @@ function get_docstring(info, dsl) { } const ds = param.hd; const match = ds.ds_attached; - if (match !== 1) { - ds.ds_attached = info ? /* Info */1 : /* Docs */2; - return ds; + switch (match) { + case /* Info */1 : + _param = param.tl; + continue ; + case /* Unattached */0 : + case /* Docs */2 : + break; + } - _param = param.tl; - continue ; + ds.ds_attached = info ? /* Info */1 : /* Docs */2; + return ds; }; } @@ -2354,16 +2387,21 @@ function get_docstrings(dsl) { } const ds = param.hd; const match = ds.ds_attached; - if (match !== 1) { - ds.ds_attached = /* Docs */2; - _param = param.tl; - _acc = { - hd: ds, - tl: acc - }; - continue ; + switch (match) { + case /* Info */1 : + _param = param.tl; + continue ; + case /* Unattached */0 : + case /* Docs */2 : + break; + } + ds.ds_attached = /* Docs */2; _param = param.tl; + _acc = { + hd: ds, + tl: acc + }; continue ; }; } @@ -2371,10 +2409,15 @@ function get_docstrings(dsl) { function associate_docstrings(dsl) { Stdlib__List.iter((function (ds) { const match = ds.ds_associated; - if (match) { - ds.ds_associated = /* Many */2; - } else { - ds.ds_associated = /* One */1; + switch (match) { + case /* Zero */0 : + ds.ds_associated = /* One */1; + return ; + case /* One */1 : + case /* Many */2 : + ds.ds_associated = /* Many */2; + return ; + } }), dsl); } @@ -3522,12 +3565,13 @@ const $$Error$1 = /* @__PURE__ */Caml_exceptions.create("Ocaml_parsetree_test.Sy const Escape_error = /* @__PURE__ */Caml_exceptions.create("Ocaml_parsetree_test.Syntaxerr.Escape_error"); function prepare_error(loc) { - switch (loc.TAG | 0) { + switch (loc.TAG) { case /* Unclosed */0 : const closing = loc._3; const opening = loc._1; return Curry._1(errorf(loc._2, { - hd: Curry._1(errorf(loc._0, undefined, undefined, /* Format */{ + hd: Curry._1(errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This '", @@ -3544,7 +3588,8 @@ function prepare_error(loc) { _1: "This '%s' might be unmatched" }), opening), tl: /* [] */0 - }, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + }, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error: '", @@ -3567,7 +3612,8 @@ function prepare_error(loc) { } }, _1: "Syntax error: '%s' expected, the highlighted '%s' might be unmatched" - }), closing, opening), /* Format */{ + }), closing, opening), { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error: '", @@ -3584,7 +3630,8 @@ function prepare_error(loc) { _1: "Syntax error: '%s' expected" }), closing); case /* Expecting */1 : - return Curry._1(errorf(loc._0, undefined, undefined, /* Format */{ + return Curry._1(errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error: ", @@ -3601,7 +3648,8 @@ function prepare_error(loc) { _1: "Syntax error: %s expected." }), loc._1); case /* Not_expecting */2 : - return Curry._1(errorf(loc._0, undefined, undefined, /* Format */{ + return Curry._1(errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error: ", @@ -3618,7 +3666,8 @@ function prepare_error(loc) { _1: "Syntax error: %s not expected." }), loc._1); case /* Applicative_path */3 : - return errorf(loc._0, undefined, undefined, /* Format */{ + return errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error: applicative paths of the form F(X).t are not supported when the option -no-app-func is set.", @@ -3628,7 +3677,8 @@ function prepare_error(loc) { }); case /* Variable_in_scope */4 : const $$var = loc._1; - return Curry._2(errorf(loc._0, undefined, undefined, /* Format */{ + return Curry._2(errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "In this scoped type, variable '", @@ -3653,7 +3703,8 @@ function prepare_error(loc) { _1: "In this scoped type, variable '%s is reserved for the local type %s." }), $$var, $$var); case /* Other */5 : - return errorf(loc._0, undefined, undefined, /* Format */{ + return errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error", @@ -3662,7 +3713,8 @@ function prepare_error(loc) { _1: "Syntax error" }); case /* Ill_formed_ast */6 : - return Curry._1(errorf(loc._0, undefined, undefined, /* Format */{ + return Curry._1(errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "broken invariant in parsetree: ", @@ -4134,10 +4186,10 @@ function varify_constructors(var_names, t) { const loop = function (t) { const x = t.ptyp_desc; let desc; - if (typeof x === "number") { + if (/* tag */typeof x === "number" || typeof x === "string") { desc = /* Ptyp_any */0; } else { - switch (x.TAG | 0) { + switch (x.TAG) { case /* Ptyp_var */0 : const x$1 = x._0; check_variable(var_names, t.ptyp_loc, x$1); @@ -4164,7 +4216,7 @@ function varify_constructors(var_names, t) { const longident = x._0; let exit = 0; const s = longident.txt; - switch (s.TAG | 0) { + switch (s.TAG) { case /* Lident */0 : if (x._1) { exit = 1; @@ -4373,7 +4425,7 @@ function extra_csig(pos, items) { } function add_nonrec(rf, attrs, pos) { - if (rf) { + if (rf !== /* Nonrecursive */0) { return attrs; } const name_loc = rhs_loc(pos); @@ -4930,7 +4982,8 @@ const yyact = [ let exit = 0; if (bindings) { const lb = bindings.hd; - if (typeof lb.lb_pattern.ppat_desc === "number" && !bindings.tl) { + let tmp = lb.lb_pattern.ppat_desc; + if (/* tag */(typeof tmp === "number" || typeof tmp === "string") && !bindings.tl) { const exp = wrap_exp_attrs(lb.lb_expression, [ undefined, lbs.lbs_attributes @@ -6751,7 +6804,7 @@ const yyact = [ case "-" : if (match.TAG === /* Pexp_constant */1) { const n = match._0; - switch (n.TAG | 0) { + switch (n.TAG) { case /* Const_int */0 : return mkexp({ TAG: /* Pexp_constant */1, @@ -6830,7 +6883,7 @@ const yyact = [ switch (_1) { case "+" : if (desc.TAG === /* Pexp_constant */1) { - switch (desc._0.TAG | 0) { + switch (desc._0.TAG) { case /* Const_char */1 : case /* Const_string */2 : case /* Const_float */3 : @@ -10627,10 +10680,10 @@ function implementation(lexfun, lexbuf) { } function type_of_directive(x) { - if (typeof x === "number") { + if (/* tag */typeof x === "number" || typeof x === "string") { return /* Dir_type_null */4; } - switch (x.TAG | 0) { + switch (x.TAG) { case /* Dir_bool */0 : return /* Dir_type_bool */0; case /* Dir_float */1 : @@ -10787,7 +10840,7 @@ function defined(str) { return false; } } - if (typeof val === "number") { + if (/* tag */typeof val === "number" || typeof val === "string") { return false; } else { return true; @@ -10853,7 +10906,7 @@ function query(loc, str) { throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } } - if (typeof v === "number") { + if (/* tag */typeof v === "number" || typeof v === "string") { return { TAG: /* Dir_bool */0, _0: false @@ -10864,7 +10917,7 @@ function query(loc, str) { } function value_of_token(loc, t) { - if (typeof t === "number") { + if (/* tag */typeof t === "number" || typeof t === "string") { switch (t) { case /* FALSE */29 : return { @@ -10884,7 +10937,7 @@ function value_of_token(loc, t) { }); } } else { - switch (t.TAG | 0) { + switch (t.TAG) { case /* FLOAT */1 : return { TAG: /* Dir_float */1, @@ -10925,7 +10978,7 @@ function directive_parse(token_with_comments, lexbuf) { let _param; while(true) { const t = Curry._1(token_with_comments, lexbuf); - if (typeof t === "number") { + if (/* tag */typeof t === "number" || typeof t === "string") { switch (t) { case /* EOF */25 : throw new Caml_js_exceptions.MelangeError($$Error$2, { @@ -10940,7 +10993,7 @@ function directive_parse(token_with_comments, lexbuf) { return t; } } else { - switch (t.TAG | 0) { + switch (t.TAG) { case /* COMMENT */18 : case /* DOCSTRING */19 : _param = undefined; @@ -10967,7 +11020,7 @@ function directive_parse(token_with_comments, lexbuf) { const token_op = function (calc, no, lhs) { const op = token(undefined); let exit = 0; - if (typeof op === "number") { + if (/* tag */typeof op === "number" || typeof op === "string") { switch (op) { case /* EQUAL */26 : case /* GREATER */34 : @@ -10987,13 +11040,13 @@ function directive_parse(token_with_comments, lexbuf) { return true; } let exit$1 = 0; - if (typeof lhs === "number" || lhs.TAG !== /* Dir_string */3) { + if (/* tag */typeof lhs === "number" || typeof lhs === "string" || lhs.TAG !== /* Dir_string */3) { exit$1 = 2; } else { const curr_loc = curr(lexbuf); const rhs = value_of_token(curr_loc, token(undefined)); let exit$2 = 0; - if (typeof rhs === "number") { + if (/* tag */typeof rhs === "number" || typeof rhs === "string") { exit$2 = 3; } else { if (rhs.TAG === /* Dir_string */3) { @@ -11151,7 +11204,7 @@ function directive_parse(token_with_comments, lexbuf) { if (exit === 1) { let f; let exit$4 = 0; - if (typeof op === "number") { + if (/* tag */typeof op === "number" || typeof op === "string") { switch (op) { case /* EQUAL */26 : f = Caml_obj.caml_equal; @@ -11201,54 +11254,68 @@ function directive_parse(token_with_comments, lexbuf) { }; const parse_and_aux = function (calc, v) { const e = token(undefined); - if (typeof e === "number") { - if (e) { - push(e); - return v; - } - const calc$1 = calc && v; - const b = parse_and_aux(calc$1, parse_relation(calc$1)); - if (v) { - return b; - } else { - return false; + if (/* tag */typeof e === "number" || typeof e === "string") { + if (e === /* AMPERAMPER */0) { + const calc$1 = calc && v; + const b = parse_and_aux(calc$1, parse_relation(calc$1)); + if (v) { + return b; + } else { + return false; + } } + push(e); + return v; + } else { + push(e); + return v; } - push(e); - return v; }; const parse_or_aux = function (calc, v) { const e = token(undefined); - if (e === 8) { - const calc$1 = calc && !v; - const b = parse_or_aux(calc$1, parse_and_aux(calc$1, parse_relation(calc$1))); - if (v) { - return true; - } else { - return b; + if (/* tag */typeof e === "number" || typeof e === "string") { + if (e === /* BARBAR */8) { + const calc$1 = calc && !v; + const b = parse_or_aux(calc$1, parse_and_aux(calc$1, parse_relation(calc$1))); + if (v) { + return true; + } else { + return b; + } } + push(e); + return v; + } else { + push(e); + return v; } - push(e); - return v; }; const parse_relation = function (calc) { const curr_token = token(undefined); const curr_loc = curr(lexbuf); - if (typeof curr_token === "number") { + if (/* tag */typeof curr_token === "number" || typeof curr_token === "string") { switch (curr_token) { case /* FALSE */29 : return false; case /* LPAREN */54 : const v = parse_or_aux(calc, parse_and_aux(calc, parse_relation(calc))); const match = token(undefined); - if (match === 81) { - return v; + if (/* tag */typeof match === "number" || typeof match === "string") { + if (match === /* RPAREN */81) { + return v; + } + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unterminated_paren_in_conditional */1, + _2: curr(lexbuf) + }); + } else { + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unterminated_paren_in_conditional */1, + _2: curr(lexbuf) + }); } - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unterminated_paren_in_conditional */1, - _2: curr(lexbuf) - }); case /* TRUE */91 : return true; default: @@ -11259,7 +11326,7 @@ function directive_parse(token_with_comments, lexbuf) { }); } } else { - switch (curr_token.TAG | 0) { + switch (curr_token.TAG) { case /* FLOAT */1 : return token_op(calc, (function (e) { throw new Caml_js_exceptions.MelangeError($$Error$2, { @@ -11299,7 +11366,7 @@ function directive_parse(token_with_comments, lexbuf) { } const t = token(undefined); const loc = curr(lexbuf); - if (typeof t === "number") { + if (/* tag */typeof t === "number" || typeof t === "string") { throw new Caml_js_exceptions.MelangeError($$Error$2, { MEL_EXN_ID: $$Error$2, _1: /* Unexpected_token_in_conditional */4, @@ -11343,7 +11410,7 @@ function directive_parse(token_with_comments, lexbuf) { const value_v = query(curr_loc, curr_token._0); return token_op(calc, (function (e) { push(e); - if (typeof value_v !== "number" && value_v.TAG === /* Dir_bool */0) { + if (!/* tag */(typeof value_v === "number" || typeof value_v === "string") && value_v.TAG === /* Dir_bool */0) { return value_v._0; } const ty = type_of_directive(value_v); @@ -11368,18 +11435,26 @@ function directive_parse(token_with_comments, lexbuf) { }; const v = parse_or_aux(true, parse_and_aux(true, parse_relation(true))); const match = token(undefined); - if (match === 88) { - return v; + if (/* tag */typeof match === "number" || typeof match === "string") { + if (match === /* THEN */88) { + return v; + } + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Expect_hash_then_in_conditional */5, + _2: curr(lexbuf) + }); + } else { + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Expect_hash_then_in_conditional */5, + _2: curr(lexbuf) + }); } - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Expect_hash_then_in_conditional */5, - _2: curr(lexbuf) - }); } function is_elif(i) { - if (typeof i === "number" || !(i.TAG === /* LIDENT */11 && i._0 === "elif")) { + if (/* tag */typeof i === "number" || typeof i === "string" || !(i.TAG === /* LIDENT */11 && i._0 === "elif")) { return false; } else { return true; @@ -11991,10 +12066,11 @@ function add_docstring_comment(ds) { } function report_error(ppf, c) { - if (typeof c === "number") { + if (/* tag */typeof c === "number" || typeof c === "string") { switch (c) { case /* Unterminated_string */0 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "String literal not terminated", @@ -12003,7 +12079,8 @@ function report_error(ppf, c) { _1: "String literal not terminated" }); case /* Unterminated_paren_in_conditional */1 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unterminated parens in conditional predicate", @@ -12012,7 +12089,8 @@ function report_error(ppf, c) { _1: "Unterminated parens in conditional predicate" }); case /* Unterminated_if */2 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "#if not terminated", @@ -12021,7 +12099,8 @@ function report_error(ppf, c) { _1: "#if not terminated" }); case /* Unterminated_else */3 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "#else not terminated", @@ -12030,7 +12109,8 @@ function report_error(ppf, c) { _1: "#else not terminated" }); case /* Unexpected_token_in_conditional */4 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unexpected token in conditional predicate", @@ -12039,7 +12119,8 @@ function report_error(ppf, c) { _1: "Unexpected token in conditional predicate" }); case /* Expect_hash_then_in_conditional */5 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Expect `then` after conditional predicate", @@ -12048,7 +12129,8 @@ function report_error(ppf, c) { _1: "Expect `then` after conditional predicate" }); case /* Unexpected_directive */6 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unexpected directive", @@ -12059,9 +12141,10 @@ function report_error(ppf, c) { } } else { - switch (c.TAG | 0) { + switch (c.TAG) { case /* Illegal_character */0 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Illegal character (", @@ -12078,7 +12161,8 @@ function report_error(ppf, c) { _1: "Illegal character (%s)" }), Stdlib__Char.escaped(c._0)); case /* Illegal_escape */1 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Illegal backslash escape in string or character (", @@ -12095,7 +12179,8 @@ function report_error(ppf, c) { _1: "Illegal backslash escape in string or character (%s)" }), c._0); case /* Unterminated_comment */2 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Comment not terminated", @@ -12104,7 +12189,8 @@ function report_error(ppf, c) { _1: "Comment not terminated" }); case /* Unterminated_string_in_comment */3 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This comment contains an unterminated string literal", @@ -12124,7 +12210,8 @@ function report_error(ppf, c) { _1: "This comment contains an unterminated string literal@.%aString literal begins here" }), print_error, c._1); case /* Keyword_as_label */4 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '`' */96, @@ -12141,7 +12228,8 @@ function report_error(ppf, c) { _1: "`%s' is a keyword, it cannot be used as label name" }), c._0); case /* Literal_overflow */5 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Integer literal exceeds the range of representable integers of type ", @@ -12154,7 +12242,8 @@ function report_error(ppf, c) { _1: "Integer literal exceeds the range of representable integers of type %s" }), c._0); case /* Illegal_semver */6 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Illegal semantic version string ", @@ -12167,7 +12256,8 @@ function report_error(ppf, c) { _1: "Illegal semantic version string %s" }), c._0); case /* Conditional_expr_expected_type */7 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Conditional expression type mismatch (", @@ -12847,37 +12937,39 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { catch (raw_exn){ const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); if (exn.MEL_EXN_ID === $$Error$2) { - const match$1 = exn._1; - if (typeof match$1 === "number") { - if (match$1) { - throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); - } - const match$2 = comment_start_loc.contents; - if (match$2) { - const start = Stdlib__List.hd(Stdlib__List.rev(comment_start_loc.contents)); - comment_start_loc.contents = /* [] */0; - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: { - TAG: /* Unterminated_string_in_comment */3, - _0: start, - _1: exn._2 - }, - _2: match$2.hd + let tmp = exn._1; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + if (tmp === /* Unterminated_string */0) { + const match$1 = comment_start_loc.contents; + if (match$1) { + const start = Stdlib__List.hd(Stdlib__List.rev(comment_start_loc.contents)); + comment_start_loc.contents = /* [] */0; + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: { + TAG: /* Unterminated_string_in_comment */3, + _0: start, + _1: exn._2 + }, + _2: match$1.hd + }); + } + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "parsing/lexer.mll", + 1006, + 18 + ] }); } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "parsing/lexer.mll", - 1006, - 18 - ] - }); + throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); + } else { + throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } + } else { throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } - throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } is_in_string.contents = false; store_string_char(/* '"' */34); @@ -12895,37 +12987,39 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { catch (raw_exn$1){ const exn$1 = Caml_js_exceptions.internalToOCamlException(raw_exn$1); if (exn$1.MEL_EXN_ID === $$Error$2) { - const match$3 = exn$1._1; - if (typeof match$3 === "number") { - if (match$3) { - throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); - } - const match$4 = comment_start_loc.contents; - if (match$4) { - const start$1 = Stdlib__List.hd(Stdlib__List.rev(comment_start_loc.contents)); - comment_start_loc.contents = /* [] */0; - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: { - TAG: /* Unterminated_string_in_comment */3, - _0: start$1, - _1: exn$1._2 - }, - _2: match$4.hd + let tmp$1 = exn$1._1; + if (/* tag */typeof tmp$1 === "number" || typeof tmp$1 === "string") { + if (tmp$1 === /* Unterminated_string */0) { + const match$2 = comment_start_loc.contents; + if (match$2) { + const start$1 = Stdlib__List.hd(Stdlib__List.rev(comment_start_loc.contents)); + comment_start_loc.contents = /* [] */0; + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: { + TAG: /* Unterminated_string_in_comment */3, + _0: start$1, + _1: exn$1._2 + }, + _2: match$2.hd + }); + } + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "parsing/lexer.mll", + 1026, + 18 + ] }); } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "parsing/lexer.mll", - 1026, - 18 - ] - }); + throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); + } else { + throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); } + } else { throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); } - throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); } is_in_string.contents = false; store_string_char(/* '|' */124); @@ -12939,8 +13033,8 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { ___ocaml_lex_state = 132; continue ; case 10 : - const match$5 = comment_start_loc.contents; - if (match$5) { + const match$3 = comment_start_loc.contents; + if (match$3) { const start$2 = Stdlib__List.hd(Stdlib__List.rev(comment_start_loc.contents)); comment_start_loc.contents = /* [] */0; throw new Caml_js_exceptions.MelangeError($$Error$2, { @@ -12949,7 +13043,7 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { TAG: /* Unterminated_comment */2, _0: start$2 }, - _2: match$5.hd + _2: match$3.hd }); } throw new Caml_js_exceptions.MelangeError("Assert_failure", { @@ -12999,41 +13093,49 @@ function token_with_comments(lexbuf) { function token$1(lexbuf) { const post_pos = lexbuf.lex_curr_p; const attach = function (lines, docs, pre_pos) { - if (typeof docs === "number") { + if (/* tag */typeof docs === "number" || typeof docs === "string") { return ; } if (docs.TAG === /* After */0) { const a = docs._0; - if (lines >= 2) { - set_post_docstrings(post_pos, Stdlib__List.rev(a)); - return set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a)); - } else { - set_post_docstrings(post_pos, Stdlib__List.rev(a)); - return set_pre_docstrings(pre_pos, a); + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + break; + case /* BlankLine */2 : + set_post_docstrings(post_pos, Stdlib__List.rev(a)); + return set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a)); + } + set_post_docstrings(post_pos, Stdlib__List.rev(a)); + return set_pre_docstrings(pre_pos, a); } const b = docs._2; const f = docs._1; const a$1 = docs._0; - if (lines >= 2) { - set_post_docstrings(post_pos, Stdlib__List.rev(a$1)); - set_post_extra_docstrings(post_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); - set_floating_docstrings(pre_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); - return set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a$1)); - } else { - set_post_docstrings(post_pos, Stdlib__List.rev(a$1)); - set_post_extra_docstrings(post_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); - set_floating_docstrings(pre_pos, Stdlib__List.rev(f)); - set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a$1)); - return set_pre_docstrings(pre_pos, b); + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + break; + case /* BlankLine */2 : + set_post_docstrings(post_pos, Stdlib__List.rev(a$1)); + set_post_extra_docstrings(post_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); + set_floating_docstrings(pre_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); + return set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a$1)); + } + set_post_docstrings(post_pos, Stdlib__List.rev(a$1)); + set_post_extra_docstrings(post_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); + set_floating_docstrings(pre_pos, Stdlib__List.rev(f)); + set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a$1)); + set_pre_docstrings(pre_pos, b); }; const loop = function (_lines, _docs, lexbuf) { while(true) { const docs = _docs; const lines = _lines; const doc = token_with_comments(lexbuf); - if (typeof doc === "number") { + if (/* tag */typeof doc === "number" || typeof doc === "string") { switch (doc) { case /* SHARP */84 : if (at_bol(lexbuf)) { @@ -13046,81 +13148,93 @@ function token$1(lexbuf) { }; const if_then_else$1 = if_then_else.contents; const match = token_with_comments(lexbuf); - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { switch (match) { case /* ELSE */23 : - if (if_then_else$1) { - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); + switch (if_then_else$1) { + case /* Dir_if_true */0 : + break; + case /* Dir_if_false */1 : + case /* Dir_out */2 : + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + } break; case /* END */24 : - if (if_then_else$1 >= 2) { - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); + switch (if_then_else$1) { + case /* Dir_if_true */0 : + case /* Dir_if_false */1 : + if_then_else.contents = /* Dir_out */2; + return Curry._1(cont, lexbuf); + case /* Dir_out */2 : + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + } - if_then_else.contents = /* Dir_out */2; - return Curry._1(cont, lexbuf); case /* IF */37 : - if (if_then_else$1 >= 2) { - if (directive_parse(token_with_comments, lexbuf)) { - if_then_else.contents = /* Dir_if_true */0; - return Curry._1(cont, lexbuf); - } else { - let _param; - while(true) { - const token = token_with_comments(lexbuf); - if (Caml_obj.caml_equal(token, /* EOF */25)) { - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unterminated_if */2, - _2: curr(lexbuf) - }); - } - if (Caml_obj.caml_equal(token, /* SHARP */84) && at_bol(lexbuf)) { - const token$1 = token_with_comments(lexbuf); - if (typeof token$1 === "number") { - if (token$1 === 24 || token$1 === 23) { - if (token$1 >= 24) { - if_then_else.contents = /* Dir_out */2; - return Curry._1(cont, lexbuf); - } else { - if_then_else.contents = /* Dir_if_false */1; - return Curry._1(cont, lexbuf); - } - } - if (token$1 === 37) { + switch (if_then_else$1) { + case /* Dir_if_true */0 : + case /* Dir_if_false */1 : + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + case /* Dir_out */2 : + if (directive_parse(token_with_comments, lexbuf)) { + if_then_else.contents = /* Dir_if_true */0; + return Curry._1(cont, lexbuf); + } else { + let _param; + while(true) { + const token = token_with_comments(lexbuf); + if (Caml_obj.caml_equal(token, /* EOF */25)) { throw new Caml_js_exceptions.MelangeError($$Error$2, { MEL_EXN_ID: $$Error$2, - _1: /* Unexpected_directive */6, + _1: /* Unterminated_if */2, _2: curr(lexbuf) }); } - - } - if (is_elif(token$1) && directive_parse(token_with_comments, lexbuf)) { - if_then_else.contents = /* Dir_if_true */0; - return Curry._1(cont, lexbuf); - } - _param = undefined; - continue ; + if (Caml_obj.caml_equal(token, /* SHARP */84) && at_bol(lexbuf)) { + const token$1 = token_with_comments(lexbuf); + if (/* tag */typeof token$1 === "number" || typeof token$1 === "string") { + switch (token$1) { + case /* ELSE */23 : + if_then_else.contents = /* Dir_if_false */1; + return Curry._1(cont, lexbuf); + case /* END */24 : + if_then_else.contents = /* Dir_out */2; + return Curry._1(cont, lexbuf); + case /* IF */37 : + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + default: + + } + } + if (is_elif(token$1) && directive_parse(token_with_comments, lexbuf)) { + if_then_else.contents = /* Dir_if_true */0; + return Curry._1(cont, lexbuf); + } + _param = undefined; + continue ; + } + _param = undefined; + continue ; + }; } - _param = undefined; - continue ; - }; - } + } - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); default: return Curry._1(look_ahead, match); } @@ -13131,145 +13245,200 @@ function token$1(lexbuf) { if (match._0 !== "elif") { return Curry._1(look_ahead, match); } - if (if_then_else$1) { - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); + switch (if_then_else$1) { + case /* Dir_if_true */0 : + break; + case /* Dir_if_false */1 : + case /* Dir_out */2 : + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + } - } - if (if_then_else$1) { - return Curry._1(look_ahead, match); - } - let _else_seen = Caml_obj.caml_equal(match, /* ELSE */23); - while(true) { - const else_seen = _else_seen; - const token$2 = token_with_comments(lexbuf); - if (Caml_obj.caml_equal(token$2, /* EOF */25)) { - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unterminated_else */3, - _2: curr(lexbuf) - }); - } - if (Caml_obj.caml_equal(token$2, /* SHARP */84) && at_bol(lexbuf)) { - const token$3 = token_with_comments(lexbuf); - if (typeof token$3 === "number") { - if (token$3 === 24 || token$3 === 23) { - if (token$3 >= 24) { - if_then_else.contents = /* Dir_out */2; - return Curry._1(cont, lexbuf); - } - if (else_seen) { + switch (if_then_else$1) { + case /* Dir_if_true */0 : + let _else_seen = Caml_obj.caml_equal(match, /* ELSE */23); + while(true) { + const else_seen = _else_seen; + const token$2 = token_with_comments(lexbuf); + if (Caml_obj.caml_equal(token$2, /* EOF */25)) { throw new Caml_js_exceptions.MelangeError($$Error$2, { MEL_EXN_ID: $$Error$2, - _1: /* Unexpected_directive */6, + _1: /* Unterminated_else */3, _2: curr(lexbuf) }); } - _else_seen = true; + if (Caml_obj.caml_equal(token$2, /* SHARP */84) && at_bol(lexbuf)) { + const token$3 = token_with_comments(lexbuf); + if (/* tag */typeof token$3 === "number" || typeof token$3 === "string") { + switch (token$3) { + case /* ELSE */23 : + if (else_seen) { + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + } + _else_seen = true; + continue ; + case /* END */24 : + if_then_else.contents = /* Dir_out */2; + return Curry._1(cont, lexbuf); + case /* IF */37 : + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + default: + + } + } + if (else_seen && is_elif(token$3)) { + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + } + continue ; + } continue ; - } - if (token$3 === 37) { - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); - } - - } - if (else_seen && is_elif(token$3)) { - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); - } - continue ; - } - continue ; - }; + }; + case /* Dir_if_false */1 : + case /* Dir_out */2 : + return Curry._1(look_ahead, match); + + } } break; case /* EOL */100 : - const lines$p = lines ? /* BlankLine */2 : /* NewLine */1; + let lines$p; + switch (lines) { + case /* NoLine */0 : + lines$p = /* NewLine */1; + break; + case /* NewLine */1 : + case /* BlankLine */2 : + lines$p = /* BlankLine */2; + break; + + } _lines = lines$p; continue ; default: } } else { - switch (doc.TAG | 0) { + switch (doc.TAG) { case /* COMMENT */18 : const match$1 = doc._0; add_comment([ match$1[0], match$1[1] ]); - const lines$p$1 = lines >= 2 ? /* BlankLine */2 : /* NoLine */0; + let lines$p$1; + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + lines$p$1 = /* NoLine */0; + break; + case /* BlankLine */2 : + lines$p$1 = /* BlankLine */2; + break; + + } _lines = lines$p$1; continue ; case /* DOCSTRING */19 : const doc$1 = doc._0; add_docstring_comment(doc$1); let docs$p; - if (typeof docs === "number") { - docs$p = lines >= 2 ? ({ - TAG: /* Before */1, - _0: /* [] */0, - _1: /* [] */0, - _2: { - hd: doc$1, - tl: /* [] */0 - } - }) : ({ - TAG: /* After */0, - _0: { - hd: doc$1, - tl: /* [] */0 - } - }); + if (/* tag */typeof docs === "number" || typeof docs === "string") { + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + docs$p = { + TAG: /* After */0, + _0: { + hd: doc$1, + tl: /* [] */0 + } + }; + break; + case /* BlankLine */2 : + docs$p = { + TAG: /* Before */1, + _0: /* [] */0, + _1: /* [] */0, + _2: { + hd: doc$1, + tl: /* [] */0 + } + }; + break; + + } } else if (docs.TAG === /* After */0) { const a = docs._0; - docs$p = lines >= 2 ? ({ - TAG: /* Before */1, - _0: a, - _1: /* [] */0, - _2: { - hd: doc$1, - tl: /* [] */0 - } - }) : ({ - TAG: /* After */0, - _0: { - hd: doc$1, - tl: a - } - }); + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + docs$p = { + TAG: /* After */0, + _0: { + hd: doc$1, + tl: a + } + }; + break; + case /* BlankLine */2 : + docs$p = { + TAG: /* Before */1, + _0: a, + _1: /* [] */0, + _2: { + hd: doc$1, + tl: /* [] */0 + } + }; + break; + + } } else { const b = docs._2; const f = docs._1; const a$1 = docs._0; - docs$p = lines >= 2 ? ({ - TAG: /* Before */1, - _0: a$1, - _1: Stdlib.$at(b, f), - _2: { - hd: doc$1, - tl: /* [] */0 - } - }) : ({ - TAG: /* Before */1, - _0: a$1, - _1: f, - _2: { - hd: doc$1, - tl: b - } - }); + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + docs$p = { + TAG: /* Before */1, + _0: a$1, + _1: f, + _2: { + hd: doc$1, + tl: b + } + }; + break; + case /* BlankLine */2 : + docs$p = { + TAG: /* Before */1, + _0: a$1, + _1: Stdlib.$at(b, f), + _2: { + hd: doc$1, + tl: /* [] */0 + } + }; + break; + + } } _docs = docs$p; _lines = /* NoLine */0; @@ -13308,23 +13477,28 @@ function skip_phrase(lexbuf) { while(true) { try { const match = token$1(lexbuf); - if (typeof match === "number" && !(match !== 25 && match !== 83)) { - return ; - } else { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { return skip_phrase(lexbuf); } + switch (match) { + case /* EOF */25 : + case /* SEMISEMI */83 : + return ; + default: + return skip_phrase(lexbuf); + } } catch (raw_exn){ const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); if (exn.MEL_EXN_ID === $$Error$2) { let tmp = exn._1; - if (typeof tmp === "number") { + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { if (tmp === /* Unterminated_string */0) { continue ; } throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } else { - switch (tmp.TAG | 0) { + switch (tmp.TAG) { case /* Illegal_character */0 : case /* Unterminated_comment */2 : case /* Unterminated_string_in_comment */3 : @@ -13361,7 +13535,7 @@ function wrap(parsing_fun, lexbuf) { const err = Caml_js_exceptions.internalToOCamlException(raw_err); if (err.MEL_EXN_ID === $$Error$2) { let tmp = err._1; - if (typeof tmp === "number") { + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { throw new Caml_js_exceptions.MelangeError(err.MEL_EXN_ID, err); } if (tmp.TAG === /* Illegal_character */0) { @@ -13428,13 +13602,13 @@ const match = wrap(implementation, Stdlib__Lexing.from_string(undefined, "let v if (match) { const match$1 = match.hd.pstr_desc; - if (match$1.TAG === /* Pstr_value */1 && !match$1._0) { + if (match$1.TAG === /* Pstr_value */1 && match$1._0 === /* Nonrecursive */0) { const match$2 = match$1._1; if (match$2) { const match$3 = match$2.hd; const match$4 = match$3.pvb_pat; const match$5 = match$4.ppat_desc; - if (typeof match$5 === "number" || match$5.TAG !== /* Ppat_var */0) { + if (/* tag */typeof match$5 === "number" || typeof match$5 === "string" || match$5.TAG !== /* Ppat_var */0) { eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } else { const match$6 = match$5._0; @@ -13454,7 +13628,7 @@ if (match) { if (match$14.TAG === /* Pexp_fun */4 && match$14._0 === "" && match$14._1 === undefined) { const match$15 = match$14._2; const match$16 = match$15.ppat_desc; - if (typeof match$16 === "number" || match$16.TAG !== /* Ppat_var */0) { + if (/* tag */typeof match$16 === "number" || typeof match$16 === "string" || match$16.TAG !== /* Ppat_var */0) { eq("File \"ocaml_parsetree_main_bspack.ml\", line 216, characters 12-19", true, false); } else { const match$17 = match$16._0; @@ -13477,7 +13651,7 @@ if (match) { if (match$27.TAG === /* Pexp_ident */0) { const match$28 = match$27._0; const match$29 = match$28.txt; - switch (match$29.TAG | 0) { + switch (match$29.TAG) { case /* Lident */0 : if (match$29._0 === "|>") { const match$30 = match$28.loc; @@ -13502,7 +13676,7 @@ if (match) { if (match$41.TAG === /* Pexp_ident */0) { const match$42 = match$41._0; const match$43 = match$42.txt; - switch (match$43.TAG | 0) { + switch (match$43.TAG) { case /* Lident */0 : if (match$43._0 === "|>") { const match$44 = match$42.loc; @@ -13524,7 +13698,7 @@ if (match) { if (match$53.TAG === /* Pexp_ident */0) { const match$54 = match$53._0; const match$55 = match$54.txt; - switch (match$55.TAG | 0) { + switch (match$55.TAG) { case /* Lident */0 : if (match$55._0 === "str") { const match$56 = match$54.loc; @@ -13546,10 +13720,10 @@ if (match) { if (match$65.TAG === /* Pexp_ident */0) { const match$66 = match$65._0; const match$67 = match$66.txt; - switch (match$67.TAG | 0) { + switch (match$67.TAG) { case /* Ldot */1 : const match$68 = match$67._0; - switch (match$68.TAG | 0) { + switch (match$68.TAG) { case /* Lident */0 : if (match$68._0 === "Lexing" && match$67._1 === "from_string") { const match$69 = match$66.loc; @@ -13576,10 +13750,10 @@ if (match) { if (match$81.TAG === /* Pexp_ident */0) { const match$82 = match$81._0; const match$83 = match$82.txt; - switch (match$83.TAG | 0) { + switch (match$83.TAG) { case /* Ldot */1 : const match$84 = match$83._0; - switch (match$84.TAG | 0) { + switch (match$84.TAG) { case /* Lident */0 : if (match$84._0 === "Parse" && match$83._1 === "implementation") { const match$85 = match$82.loc; diff --git a/jscomp/test/dist/jscomp/test/ocaml_proto_test.js b/jscomp/test/dist/jscomp/test/ocaml_proto_test.js index b7ea27f722..9151c999a4 100644 --- a/jscomp/test/dist/jscomp/test/ocaml_proto_test.js +++ b/jscomp/test/dist/jscomp/test/ocaml_proto_test.js @@ -60,7 +60,8 @@ const message_counter = { }; function extension_range_range(from, to_) { - const to_$1 = typeof to_ === "string" ? /* To_max */0 : /* To_number */({ + const to_$1 = typeof to_ === "string" ? /* To_max */0 : ({ + TAG: /* To_number */0, _0: to_.VAL }); return { @@ -261,7 +262,8 @@ function apply_until(f, _param) { } function string_of_string_list(l) { - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '[' */91, @@ -322,7 +324,8 @@ function line(param) { } function to_string(param) { - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "File ", @@ -373,8 +376,9 @@ function string_of_programmatic_error(e) { const Compilation_error = /* @__PURE__ */Caml_exceptions.create("Ocaml_proto_test.Exception.Compilation_error"); function prepare_error(e) { - if (typeof e === "number") { - return Stdlib__Printf.sprintf(/* Format */{ + if (/* tag */typeof e === "number" || typeof e === "string") { + return Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error", @@ -383,10 +387,11 @@ function prepare_error(e) { _1: "Syntax error" }); } - switch (e.TAG | 0) { + switch (e.TAG) { case /* Unresolved_type */0 : const match = e._0; - return Curry._3(Stdlib__Printf.sprintf(/* Format */{ + return Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unresolved type for field name : ", @@ -420,7 +425,8 @@ function prepare_error(e) { }), match.field_name, match.type_, match.message_name); case /* Duplicated_field_number */1 : const match$1 = e._0; - return Curry._3(Stdlib__Printf.sprintf(/* Format */{ + return Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "duplicated field number for field name: ", @@ -454,7 +460,8 @@ function prepare_error(e) { }), match$1.field_name, match$1.previous_field_name, match$1.message_name); case /* Invalid_default_value */2 : const match$2 = e._0; - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "invalid default value for field name:", @@ -480,7 +487,8 @@ function prepare_error(e) { }), option_default("", match$2.field_name), match$2.info); case /* Unsupported_field_type */3 : const match$3 = e._0; - return Curry._3(Stdlib__Printf.sprintf(/* Format */{ + return Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unsupported field type for field name:", @@ -509,7 +517,8 @@ function prepare_error(e) { _1: "unsupported field type for field name:%s with type:%s in bakend: %s" }), option_default("", match$3.field_name), match$3.field_type, match$3.backend_name); case /* Programatic_error */4 : - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "programmatic error: ", @@ -522,7 +531,8 @@ function prepare_error(e) { _1: "programmatic error: %s" }), string_of_programmatic_error(e._0)); case /* Invalid_import_qualifier */5 : - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -535,7 +545,8 @@ function prepare_error(e) { _1: "%sInvalid import qualified, only 'public' supported" }), to_string(e._0)); case /* Invalid_file_name */6 : - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Invalid file name: ", @@ -552,7 +563,8 @@ function prepare_error(e) { _1: "Invalid file name: %s, format must .proto" }), e._0); case /* Import_file_not_found */7 : - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "File: ", @@ -569,7 +581,8 @@ function prepare_error(e) { _1: "File: %s, could not be found." }), e._0); case /* Invalid_packed_option */8 : - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Invalid packed option for field: ", @@ -582,7 +595,8 @@ function prepare_error(e) { _1: "Invalid packed option for field: %s" }), e._0); case /* Missing_semicolon_for_enum_value */9 : - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -599,7 +613,8 @@ function prepare_error(e) { _1: "%sMissing semicolon for enum value: %s" }), to_string(e._1), e._0); case /* Invalid_enum_specification */10 : - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -616,7 +631,8 @@ function prepare_error(e) { _1: "%sMissing enum specification ( = ;) for enum value: %s" }), to_string(e._1), e._0); case /* Invalid_mutable_option */11 : - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Invalid mutable option for field ", @@ -629,7 +645,8 @@ function prepare_error(e) { _1: "Invalid mutable option for field %s" }), option_default("", e._0)); case /* Missing_one_of_name */12 : - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -642,7 +659,8 @@ function prepare_error(e) { _1: "%sMissing oneof name" }), to_string(e._0)); case /* Invalid_field_label */13 : - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -655,7 +673,8 @@ function prepare_error(e) { _1: "%sInvalid field label. [required|repeated|optional] expected" }), to_string(e._0)); case /* Missing_field_label */14 : - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -668,7 +687,8 @@ function prepare_error(e) { _1: "%sMissing field label. [required|repeated|optional] expected" }), to_string(e._0)); case /* Parsing_error */15 : - return Curry._3(Stdlib__Printf.sprintf(/* Format */{ + return Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "File ", @@ -705,8 +725,8 @@ function prepare_error(e) { function add_loc(loc, exn) { if (exn.MEL_EXN_ID === Compilation_error) { let tmp = exn._1; - if (typeof tmp !== "number") { - switch (tmp.TAG | 0) { + if (!/* tag */(typeof tmp === "number" || typeof tmp === "string")) { + switch (tmp.TAG) { case /* Invalid_import_qualifier */5 : case /* Missing_semicolon_for_enum_value */9 : case /* Invalid_enum_specification */10 : @@ -1580,7 +1600,8 @@ function __ocaml_lex_comment_rec(_l, lexbuf, ___ocaml_lex_state) { switch (__ocaml_lex_state$1) { case 0 : update_loc(lexbuf); - return /* Comment_value */{ + return { + TAG: /* Comment_value */0, _0: Stdlib__String.concat("", Stdlib__List.rev(l)) }; case 1 : @@ -1615,7 +1636,8 @@ function __ocaml_lex_string_rec(_l, lexbuf, ___ocaml_lex_state) { }; continue ; case 1 : - return /* String_value */{ + return { + TAG: /* String_value */0, _0: Stdlib__String.concat("", Stdlib__List.rev(l)) }; case 2 : @@ -1647,7 +1669,8 @@ function __ocaml_lex_multi_line_comment_rec(_l, lexbuf, ___ocaml_lex_state) { continue ; case 1 : Stdlib__Lexing.lexeme(lexbuf); - return /* Comment_value */{ + return { + TAG: /* Comment_value */0, _0: Stdlib__String.concat("", Stdlib__List.rev(l)) }; case 2 : @@ -1697,27 +1720,27 @@ function lexer(lexbuf) { return /* COMMA */24; case 11 : const match = __ocaml_lex_comment_rec(/* [] */0, lexbuf, 41); - if (!match) { + if (/* tag */typeof match === "number" || typeof match === "string") { return /* EOF */25; } ___ocaml_lex_state = 0; continue ; case 12 : const match$1 = __ocaml_lex_multi_line_comment_rec(/* [] */0, lexbuf, 47); - if (!match$1) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return /* EOF */25; } ___ocaml_lex_state = 0; continue ; case 13 : const s = __ocaml_lex_string_rec(/* [] */0, lexbuf, 55); - if (s) { + if (/* tag */typeof s === "number" || typeof s === "string") { + return /* EOF */25; + } else { return { TAG: /* STRING */2, _0: s._0 }; - } else { - return /* EOF */25; } case 14 : return { @@ -1795,7 +1818,8 @@ function lexer(lexbuf) { case 20 : return /* EOF */25; case 21 : - const s$1 = Curry._1(Stdlib__Printf.sprintf(/* Format */{ + const s$1 = Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unknown character found ", @@ -1848,7 +1872,7 @@ function string_of_basic_type(param) { } function string_of_field_type(bt) { - if (typeof bt === "number") { + if (/* tag */typeof bt === "number" || typeof bt === "string") { return "unit"; } else if (bt.TAG === /* Ft_basic_type */0) { return string_of_basic_type(bt._0); @@ -1863,21 +1887,28 @@ function string_of_field_type(bt) { } } +function string_of_repeated_type(param) { + if (param === /* Rt_list */0) { + return "list"; + } else { + return "Pbrt.Repeated_field.t"; + } +} + function string_of_record_field_type(param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Rft_required */0 : return string_of_field_type(param._0[0]); case /* Rft_optional */1 : return string_of_field_type(param._0[0]) + " option"; case /* Rft_repeated_field */2 : const match = param._0; - return string_of_field_type(match[1]) + (" " + ( - match[0] ? "Pbrt.Repeated_field.t" : "list" - )); + return string_of_field_type(match[1]) + (" " + string_of_repeated_type(match[0])); case /* Rft_associative_field */3 : const match$1 = param._0; - if (match$1[0]) { - return Curry._3(Stdlib__Printf.sprintf(/* Format */{ + if (match$1[0] === /* At_list */0) { + return Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '(' */40, @@ -1886,7 +1917,7 @@ function string_of_record_field_type(param) { _0: /* No_padding */0, _1: { TAG: /* String_literal */11, - _0: ", ", + _0: " * ", _1: { TAG: /* String */2, _0: /* No_padding */0, @@ -1903,10 +1934,11 @@ function string_of_record_field_type(param) { } } }, - _1: "(%s, %s) %s" - }), string_of_basic_type(match$1[2][0]), string_of_field_type(match$1[3][0]), "Hashtbl.t"); + _1: "(%s * %s) %s" + }), string_of_basic_type(match$1[2][0]), string_of_field_type(match$1[3][0]), "list"); } else { - return Curry._3(Stdlib__Printf.sprintf(/* Format */{ + return Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '(' */40, @@ -1915,7 +1947,7 @@ function string_of_record_field_type(param) { _0: /* No_padding */0, _1: { TAG: /* String_literal */11, - _0: " * ", + _0: ", ", _1: { TAG: /* String */2, _0: /* No_padding */0, @@ -1932,8 +1964,8 @@ function string_of_record_field_type(param) { } } }, - _1: "(%s * %s) %s" - }), string_of_basic_type(match$1[2][0]), string_of_field_type(match$1[3][0]), "list"); + _1: "(%s, %s) %s" + }), string_of_basic_type(match$1[2][0]), string_of_field_type(match$1[3][0]), "Hashtbl.t"); } case /* Rft_variant_field */4 : return param._0.v_name; @@ -1944,7 +1976,8 @@ function string_of_record_field_type(param) { function function_name_of_user_defined(prefix, param) { const module_ = param.udt_module; if (module_ !== undefined) { - return Curry._3(Stdlib__Printf.sprintf(/* Format */{ + return Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1969,7 +2002,8 @@ function function_name_of_user_defined(prefix, param) { _1: "%s.%s_%s" }), module_, prefix, param.udt_type_name); } else { - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1990,7 +2024,7 @@ function function_name_of_user_defined(prefix, param) { function string_of_payload_kind(capitalize, payload_kind, packed) { let s; - if (typeof payload_kind === "number") { + if (/* tag */typeof payload_kind === "number" || typeof payload_kind === "string") { switch (payload_kind) { case /* Pk_bits32 */0 : s = packed ? "bytes" : "bits32"; @@ -2093,7 +2127,7 @@ function runtime_function(param) { const match = param[0]; if (match === "Decode") { const match$1 = param[1]; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { switch (match$1) { case /* Pk_bits32 */0 : switch (param[2]) { @@ -2103,15 +2137,11 @@ function runtime_function(param) { return "Pbrt.Decoder.int_as_bits32"; case /* Bt_int32 */3 : return "Pbrt.Decoder.int32_as_bits32"; - case /* Bt_string */0 : - case /* Bt_int64 */4 : - case /* Bt_bytes */5 : - case /* Bt_bool */6 : - throw new Caml_js_exceptions.MelangeError("Failure", { - MEL_EXN_ID: "Failure", - _1: "Invalid encoding/OCaml type combination" - }); - + default: + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "Invalid encoding/OCaml type combination" + }); } case /* Pk_bits64 */1 : switch (param[2]) { @@ -2121,28 +2151,24 @@ function runtime_function(param) { return "Pbrt.Decoder.int_as_bits64"; case /* Bt_int64 */4 : return "Pbrt.Decoder.int64_as_bits64"; - case /* Bt_string */0 : - case /* Bt_int32 */3 : - case /* Bt_bytes */5 : - case /* Bt_bool */6 : - throw new Caml_js_exceptions.MelangeError("Failure", { - MEL_EXN_ID: "Failure", - _1: "Invalid encoding/OCaml type combination" - }); - + default: + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "Invalid encoding/OCaml type combination" + }); } case /* Pk_bytes */2 : - const match$2 = param[2]; - if (match$2 === 5) { - return "Pbrt.Decoder.bytes"; - } - if (!match$2) { - return "Pbrt.Decoder.string"; + switch (param[2]) { + case /* Bt_string */0 : + return "Pbrt.Decoder.string"; + case /* Bt_bytes */5 : + return "Pbrt.Decoder.bytes"; + default: + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "Invalid encoding/OCaml type combination" + }); } - throw new Caml_js_exceptions.MelangeError("Failure", { - MEL_EXN_ID: "Failure", - _1: "Invalid encoding/OCaml type combination" - }); } } else if (match$1._0) { @@ -2153,15 +2179,11 @@ function runtime_function(param) { return "Pbrt.Decoder.int32_as_zigzag"; case /* Bt_int64 */4 : return "Pbrt.Decoder.int64_as_zigzag"; - case /* Bt_string */0 : - case /* Bt_float */1 : - case /* Bt_bytes */5 : - case /* Bt_bool */6 : - throw new Caml_js_exceptions.MelangeError("Failure", { - MEL_EXN_ID: "Failure", - _1: "Invalid encoding/OCaml type combination" - }); - + default: + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "Invalid encoding/OCaml type combination" + }); } } else { switch (param[2]) { @@ -2171,22 +2193,19 @@ function runtime_function(param) { return "Pbrt.Decoder.int32_as_varint"; case /* Bt_int64 */4 : return "Pbrt.Decoder.int64_as_varint"; - case /* Bt_string */0 : - case /* Bt_float */1 : - case /* Bt_bytes */5 : - throw new Caml_js_exceptions.MelangeError("Failure", { - MEL_EXN_ID: "Failure", - _1: "Invalid encoding/OCaml type combination" - }); case /* Bt_bool */6 : return "Pbrt.Decoder.bool"; - + default: + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "Invalid encoding/OCaml type combination" + }); } } } else if (match === "Encode") { - const match$3 = param[1]; - if (typeof match$3 === "number") { - switch (match$3) { + const match$2 = param[1]; + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string") { + switch (match$2) { case /* Pk_bits32 */0 : switch (param[2]) { case /* Bt_float */1 : @@ -2195,15 +2214,11 @@ function runtime_function(param) { return "Pbrt.Encoder.int_as_bits32"; case /* Bt_int32 */3 : return "Pbrt.Encoder.int32_as_bits32"; - case /* Bt_string */0 : - case /* Bt_int64 */4 : - case /* Bt_bytes */5 : - case /* Bt_bool */6 : - throw new Caml_js_exceptions.MelangeError("Failure", { - MEL_EXN_ID: "Failure", - _1: "Invalid encoding/OCaml type combination" - }); - + default: + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "Invalid encoding/OCaml type combination" + }); } case /* Pk_bits64 */1 : switch (param[2]) { @@ -2213,31 +2228,27 @@ function runtime_function(param) { return "Pbrt.Encoder.int_as_bits64"; case /* Bt_int64 */4 : return "Pbrt.Encoder.int64_as_bits64"; - case /* Bt_string */0 : - case /* Bt_int32 */3 : - case /* Bt_bytes */5 : - case /* Bt_bool */6 : - throw new Caml_js_exceptions.MelangeError("Failure", { - MEL_EXN_ID: "Failure", - _1: "Invalid encoding/OCaml type combination" - }); - + default: + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "Invalid encoding/OCaml type combination" + }); } case /* Pk_bytes */2 : - const match$4 = param[2]; - if (match$4 === 5) { - return "Pbrt.Encoder.bytes"; - } - if (!match$4) { - return "Pbrt.Encoder.string"; + switch (param[2]) { + case /* Bt_string */0 : + return "Pbrt.Encoder.string"; + case /* Bt_bytes */5 : + return "Pbrt.Encoder.bytes"; + default: + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "Invalid encoding/OCaml type combination" + }); } - throw new Caml_js_exceptions.MelangeError("Failure", { - MEL_EXN_ID: "Failure", - _1: "Invalid encoding/OCaml type combination" - }); } - } else if (match$3._0) { + } else if (match$2._0) { switch (param[2]) { case /* Bt_int */2 : return "Pbrt.Encoder.int_as_zigzag"; @@ -2245,15 +2256,11 @@ function runtime_function(param) { return "Pbrt.Encoder.int32_as_zigzag"; case /* Bt_int64 */4 : return "Pbrt.Encoder.int64_as_zigzag"; - case /* Bt_string */0 : - case /* Bt_float */1 : - case /* Bt_bytes */5 : - case /* Bt_bool */6 : - throw new Caml_js_exceptions.MelangeError("Failure", { - MEL_EXN_ID: "Failure", - _1: "Invalid encoding/OCaml type combination" - }); - + default: + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "Invalid encoding/OCaml type combination" + }); } } else { switch (param[2]) { @@ -2263,16 +2270,13 @@ function runtime_function(param) { return "Pbrt.Encoder.int32_as_varint"; case /* Bt_int64 */4 : return "Pbrt.Encoder.int64_as_varint"; - case /* Bt_string */0 : - case /* Bt_float */1 : - case /* Bt_bytes */5 : - throw new Caml_js_exceptions.MelangeError("Failure", { - MEL_EXN_ID: "Failure", - _1: "Invalid encoding/OCaml type combination" - }); case /* Bt_bool */6 : return "Pbrt.Encoder.bool"; - + default: + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "Invalid encoding/OCaml type combination" + }); } } } else { @@ -2292,7 +2296,7 @@ function decode_basic_type(bt, pk) { } function decode_field_f(field_type, pk) { - if (typeof field_type === "number") { + if (/* tag */typeof field_type === "number" || typeof field_type === "string") { return "Pbrt.Decoder.empty_nested d"; } if (field_type.TAG === /* Ft_basic_type */0) { @@ -2312,24 +2316,33 @@ function gen_decode_record(and_, param, sc) { const r_name = param.r_name; const all_lists = Stdlib__List.fold_left((function (acc, param) { const rf_field_type = param.rf_field_type; - switch (rf_field_type.TAG | 0) { + const rf_label = param.rf_label; + switch (rf_field_type.TAG) { case /* Rft_repeated_field */2 : + if (rf_field_type._0[0] === /* Rt_list */0) { + return { + hd: rf_label, + tl: acc + }; + } else { + return acc; + } case /* Rft_associative_field */3 : - break; + if (rf_field_type._0[0] === /* At_list */0) { + return { + hd: rf_label, + tl: acc + }; + } else { + return acc; + } default: return acc; } - if (rf_field_type._0[0]) { - return acc; - } else { - return { - hd: param.rf_label, - tl: acc - }; - } }), /* [] */0, r_fields); const process_field_common = function (sc, encoding_number, pk_as_string, f) { - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| Some (", @@ -2360,7 +2373,8 @@ function gen_decode_record(and_, param, sc) { line$1(sc, "loop ()"); })); line$1(sc, ")"); - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| Some (", @@ -2379,7 +2393,8 @@ function gen_decode_record(and_, param, sc) { _1: "| Some (%i, pk) -> raise (" }), encoding_number)); scope(sc, (function (sc) { - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Protobuf.Decoder.Failure (Protobuf.Decoder.Unexpected_payload (", @@ -2394,7 +2409,8 @@ function gen_decode_record(and_, param, sc) { } }, _1: "Protobuf.Decoder.Failure (Protobuf.Decoder.Unexpected_payload (%s, pk))" - }), Curry._2(Stdlib__Printf.sprintf(/* Format */{ + }), Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "\"Message(", @@ -2424,7 +2440,8 @@ function gen_decode_record(and_, param, sc) { line$1(sc, ")"); }; const mutable_record_name = r_name + "_mutable"; - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -2445,7 +2462,8 @@ function gen_decode_record(and_, param, sc) { _1: "%s decode_%s d =" }), let_decl_of_and(and_), r_name)); scope(sc, (function (sc) { - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "let v = default_", @@ -2467,7 +2485,8 @@ function gen_decode_record(and_, param, sc) { line$1(sc, "| None -> ("); scope(sc, (function (sc) { Stdlib__List.iter((function (field_name) { - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "v.", @@ -2497,13 +2516,14 @@ function gen_decode_record(and_, param, sc) { Stdlib__List.iter((function (param) { const rf_field_type = param.rf_field_type; const rf_label = param.rf_label; - switch (rf_field_type.TAG | 0) { + switch (rf_field_type.TAG) { case /* Rft_required */0 : let param$1 = rf_field_type._0; const pk = param$1[2]; const field_type = param$1[0]; return process_field_common(sc, param$1[1], string_of_payload_kind(Caml_option.some(undefined), pk, false), (function (sc) { - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "v.", @@ -2533,7 +2553,8 @@ function gen_decode_record(and_, param, sc) { const pk$1 = param$2[2]; const field_type$1 = param$2[0]; return process_field_common(sc, param$2[1], string_of_payload_kind(Caml_option.some(undefined), pk$1, false), (function (sc) { - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "v.", @@ -2564,127 +2585,131 @@ function gen_decode_record(and_, param, sc) { const pk$2 = param$3[3]; const encoding_number = param$3[2]; const field_type$2 = param$3[1]; - if (param$3[0]) { + if (param$3[0] === /* Rt_list */0) { if (is_packed) { return process_field_common(sc, encoding_number, "Bytes", (function (sc) { - line$1(sc, "Pbrt.Decoder.packed_fold (fun () d -> "); - scope(sc, (function (sc) { - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ - _0: { + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, + _0: { + TAG: /* String_literal */11, + _0: "v.", + _1: { + TAG: /* String */2, + _0: /* No_padding */0, + _1: { + TAG: /* String_literal */11, + _0: " <- Pbrt.Decoder.packed_fold (fun l d -> (", + _1: { + TAG: /* String */2, + _0: /* No_padding */0, + _1: { TAG: /* String_literal */11, - _0: "Pbrt.Repeated_field.add (", - _1: { - TAG: /* String */2, - _0: /* No_padding */0, - _1: { - TAG: /* String_literal */11, - _0: ") v.", - _1: { - TAG: /* String */2, - _0: /* No_padding */0, - _1: { - TAG: /* Char_literal */12, - _0: /* ';' */59, - _1: /* End_of_format */0 - } - } - } - } - }, - _1: "Pbrt.Repeated_field.add (%s) v.%s;" - }), decode_field_f(field_type$2, pk$2), rf_label)); - })); - line$1(sc, ") () d;"); + _0: ")::l) [] d;", + _1: /* End_of_format */0 + } + } + } + } + }, + _1: "v.%s <- Pbrt.Decoder.packed_fold (fun l d -> (%s)::l) [] d;" + }), rf_label, decode_field_f(field_type$2, pk$2))); })); } else { return process_field_common(sc, encoding_number, string_of_payload_kind(Caml_option.some(undefined), pk$2, false), (function (sc) { - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, - _0: "Pbrt.Repeated_field.add (", + _0: "v.", _1: { TAG: /* String */2, _0: /* No_padding */0, _1: { TAG: /* String_literal */11, - _0: ") v.", + _0: " <- (", _1: { TAG: /* String */2, _0: /* No_padding */0, _1: { TAG: /* String_literal */11, - _0: "; ", - _1: /* End_of_format */0 + _0: ") :: v.", + _1: { + TAG: /* String */2, + _0: /* No_padding */0, + _1: { + TAG: /* Char_literal */12, + _0: /* ';' */59, + _1: /* End_of_format */0 + } + } } } } } }, - _1: "Pbrt.Repeated_field.add (%s) v.%s; " - }), decode_field_f(field_type$2, pk$2), rf_label)); + _1: "v.%s <- (%s) :: v.%s;" + }), rf_label, decode_field_f(field_type$2, pk$2), rf_label)); })); } } else if (is_packed) { return process_field_common(sc, encoding_number, "Bytes", (function (sc) { - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ - _0: { - TAG: /* String_literal */11, - _0: "v.", - _1: { - TAG: /* String */2, - _0: /* No_padding */0, - _1: { - TAG: /* String_literal */11, - _0: " <- Pbrt.Decoder.packed_fold (fun l d -> (", - _1: { - TAG: /* String */2, - _0: /* No_padding */0, - _1: { + line$1(sc, "Pbrt.Decoder.packed_fold (fun () d -> "); + scope(sc, (function (sc) { + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, + _0: { TAG: /* String_literal */11, - _0: ")::l) [] d;", - _1: /* End_of_format */0 - } - } - } - } - }, - _1: "v.%s <- Pbrt.Decoder.packed_fold (fun l d -> (%s)::l) [] d;" - }), rf_label, decode_field_f(field_type$2, pk$2))); + _0: "Pbrt.Repeated_field.add (", + _1: { + TAG: /* String */2, + _0: /* No_padding */0, + _1: { + TAG: /* String_literal */11, + _0: ") v.", + _1: { + TAG: /* String */2, + _0: /* No_padding */0, + _1: { + TAG: /* Char_literal */12, + _0: /* ';' */59, + _1: /* End_of_format */0 + } + } + } + } + }, + _1: "Pbrt.Repeated_field.add (%s) v.%s;" + }), decode_field_f(field_type$2, pk$2), rf_label)); + })); + line$1(sc, ") () d;"); })); } else { return process_field_common(sc, encoding_number, string_of_payload_kind(Caml_option.some(undefined), pk$2, false), (function (sc) { - line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, - _0: "v.", + _0: "Pbrt.Repeated_field.add (", _1: { TAG: /* String */2, _0: /* No_padding */0, _1: { TAG: /* String_literal */11, - _0: " <- (", + _0: ") v.", _1: { TAG: /* String */2, _0: /* No_padding */0, _1: { TAG: /* String_literal */11, - _0: ") :: v.", - _1: { - TAG: /* String */2, - _0: /* No_padding */0, - _1: { - TAG: /* Char_literal */12, - _0: /* ';' */59, - _1: /* End_of_format */0 - } - } + _0: "; ", + _1: /* End_of_format */0 } } } } }, - _1: "v.%s <- (%s) :: v.%s;" - }), rf_label, decode_field_f(field_type$2, pk$2), rf_label)); + _1: "Pbrt.Repeated_field.add (%s) v.%s; " + }), decode_field_f(field_type$2, pk$2), rf_label)); })); } case /* Rft_associative_field */3 : @@ -2701,7 +2726,8 @@ function gen_decode_record(and_, param, sc) { line$1(sc, decode_field_f(value_type, value_pk)); })); line$1(sc, ") in"); - const decode_expression = Curry._1(Stdlib__Printf.sprintf(/* Format */{ + const decode_expression = Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "(Pbrt.Decoder.map_entry d ~decode_key:", @@ -2717,41 +2743,9 @@ function gen_decode_record(and_, param, sc) { }, _1: "(Pbrt.Decoder.map_entry d ~decode_key:%s ~decode_value)" }), decode_key_f); - if (at) { - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ - _0: { - TAG: /* String_literal */11, - _0: "let a, b = ", - _1: { - TAG: /* String */2, - _0: /* No_padding */0, - _1: { - TAG: /* String_literal */11, - _0: " in", - _1: /* End_of_format */0 - } - } - }, - _1: "let a, b = %s in" - }), decode_expression)); - return line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ - _0: { - TAG: /* String_literal */11, - _0: "Hashtbl.add v.", - _1: { - TAG: /* String */2, - _0: /* No_padding */0, - _1: { - TAG: /* String_literal */11, - _0: " a b;", - _1: /* End_of_format */0 - } - } - }, - _1: "Hashtbl.add v.%s a b;" - }), rf_label)); - } else { - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + if (at === /* At_list */0) { + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "v.", @@ -2768,7 +2762,8 @@ function gen_decode_record(and_, param, sc) { _1: "v.%s <- (" }), rf_label)); scope(sc, (function (sc) { - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -2791,6 +2786,40 @@ function gen_decode_record(and_, param, sc) { })); return line$1(sc, ");"); } + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, + _0: { + TAG: /* String_literal */11, + _0: "let a, b = ", + _1: { + TAG: /* String */2, + _0: /* No_padding */0, + _1: { + TAG: /* String_literal */11, + _0: " in", + _1: /* End_of_format */0 + } + } + }, + _1: "let a, b = %s in" + }), decode_expression)); + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, + _0: { + TAG: /* String_literal */11, + _0: "Hashtbl.add v.", + _1: { + TAG: /* String */2, + _0: /* No_padding */0, + _1: { + TAG: /* String_literal */11, + _0: " a b;", + _1: /* End_of_format */0 + } + } + }, + _1: "Hashtbl.add v.%s a b;" + }), rf_label)); })); case /* Rft_variant_field */4 : let param$5 = rf_field_type._0; @@ -2799,8 +2828,9 @@ function gen_decode_record(and_, param, sc) { const vc_field_type = param.vc_field_type; const vc_constructor = param.vc_constructor; process_field_common(sc, param.vc_encoding_number, string_of_payload_kind(Caml_option.some(undefined), pk, false), (function (sc) { - if (vc_field_type) { - return line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + if (!/* tag */(typeof vc_field_type === "number" || typeof vc_field_type === "string")) { + return line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "v.", @@ -2832,33 +2862,33 @@ function gen_decode_record(and_, param, sc) { }, _1: "v.%s <- %s (%s);" }), rf_label, vc_constructor, decode_field_f(vc_field_type._0, pk))); - } else { - line$1(sc, "Pbrt.Decoder.empty_nested d;"); - return line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ - _0: { - TAG: /* String_literal */11, - _0: "v.", - _1: { - TAG: /* String */2, - _0: /* No_padding */0, - _1: { - TAG: /* String_literal */11, - _0: " <- ", - _1: { - TAG: /* String */2, - _0: /* No_padding */0, - _1: { - TAG: /* Char_literal */12, - _0: /* ';' */59, - _1: /* End_of_format */0 - } - } - } - } - }, - _1: "v.%s <- %s;" - }), rf_label, vc_constructor)); } + line$1(sc, "Pbrt.Decoder.empty_nested d;"); + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, + _0: { + TAG: /* String_literal */11, + _0: "v.", + _1: { + TAG: /* String */2, + _0: /* No_padding */0, + _1: { + TAG: /* String_literal */11, + _0: " <- ", + _1: { + TAG: /* String */2, + _0: /* No_padding */0, + _1: { + TAG: /* Char_literal */12, + _0: /* ';' */59, + _1: /* End_of_format */0 + } + } + } + } + }, + _1: "v.%s <- %s;" + }), rf_label, vc_constructor)); })); }), param$5.v_constructors); @@ -2868,7 +2898,8 @@ function gen_decode_record(and_, param, sc) { })); line$1(sc, "in"); line$1(sc, "loop ();"); - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "let v:", @@ -2891,7 +2922,8 @@ function gen_decode_record(and_, param, sc) { function gen_decode_variant(and_, param, sc) { const v_constructors = param.v_constructors; const v_name = param.v_name; - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -2912,7 +2944,8 @@ function gen_decode_variant(and_, param, sc) { _1: "%s decode_%s d = " }), let_decl_of_and(and_), v_name)); scope(sc, (function (sc) { - line$1(sc, Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "let rec loop () = ", @@ -2921,7 +2954,8 @@ function gen_decode_variant(and_, param, sc) { _1: "let rec loop () = " })); scope(sc, (function (sc) { - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "let ret:", @@ -2943,8 +2977,9 @@ function gen_decode_variant(and_, param, sc) { const vc_encoding_number = ctor.vc_encoding_number; const vc_field_type = ctor.vc_field_type; const vc_constructor = ctor.vc_constructor; - if (vc_field_type) { - return line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + if (/* tag */typeof vc_field_type === "number" || typeof vc_field_type === "string") { + return line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| Some (", @@ -2955,31 +2990,24 @@ function gen_decode_variant(and_, param, sc) { _2: /* No_precision */0, _3: { TAG: /* String_literal */11, - _0: ", _) -> ", + _0: ", _) -> (Pbrt.Decoder.empty_nested d ; ", _1: { TAG: /* String */2, _0: /* No_padding */0, _1: { - TAG: /* String_literal */11, - _0: " (", - _1: { - TAG: /* String */2, - _0: /* No_padding */0, - _1: { - TAG: /* Char_literal */12, - _0: /* ')' */41, - _1: /* End_of_format */0 - } - } + TAG: /* Char_literal */12, + _0: /* ')' */41, + _1: /* End_of_format */0 } } } } }, - _1: "| Some (%i, _) -> %s (%s)" - }), vc_encoding_number, vc_constructor, decode_field_f(vc_field_type._0, ctor.vc_payload_kind))); + _1: "| Some (%i, _) -> (Pbrt.Decoder.empty_nested d ; %s)" + }), vc_encoding_number, vc_constructor)); } else { - return line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| Some (", @@ -2990,21 +3018,29 @@ function gen_decode_variant(and_, param, sc) { _2: /* No_precision */0, _3: { TAG: /* String_literal */11, - _0: ", _) -> (Pbrt.Decoder.empty_nested d ; ", + _0: ", _) -> ", _1: { TAG: /* String */2, _0: /* No_padding */0, _1: { - TAG: /* Char_literal */12, - _0: /* ')' */41, - _1: /* End_of_format */0 + TAG: /* String_literal */11, + _0: " (", + _1: { + TAG: /* String */2, + _0: /* No_padding */0, + _1: { + TAG: /* Char_literal */12, + _0: /* ')' */41, + _1: /* End_of_format */0 + } + } } } } } }, - _1: "| Some (%i, _) -> (Pbrt.Decoder.empty_nested d ; %s)" - }), vc_encoding_number, vc_constructor)); + _1: "| Some (%i, _) -> %s (%s)" + }), vc_encoding_number, vc_constructor, decode_field_f(vc_field_type._0, ctor.vc_payload_kind))); } }), v_constructors); line$1(sc, "| Some (n, payload_kind) -> ("); @@ -3023,7 +3059,8 @@ function gen_decode_variant(and_, param, sc) { function gen_decode_const_variant(and_, param, sc) { const cv_constructors = param.cv_constructors; const cv_name = param.cv_name; - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -3046,7 +3083,8 @@ function gen_decode_const_variant(and_, param, sc) { scope(sc, (function (sc) { line$1(sc, "match Pbrt.Decoder.int_as_varint d with"); Stdlib__List.iter((function (param) { - line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| ", @@ -3081,7 +3119,8 @@ function gen_decode_const_variant(and_, param, sc) { _1: "| %i -> (%s:%s)" }), param[1], param[0], cv_name)); }), cv_constructors); - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| _ -> failwith \"Unknown value for enum ", @@ -3103,7 +3142,7 @@ function gen_decode_const_variant(and_, param, sc) { function gen_struct(and_, t, sc) { const r = t.spec; let tmp; - switch (r.TAG | 0) { + switch (r.TAG) { case /* Record */0 : tmp = [ gen_decode_record(and_, r._0, sc), @@ -3129,7 +3168,8 @@ function gen_struct(and_, t, sc) { function gen_sig(and_, t, sc) { const f = function (type_name) { - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "val decode_", @@ -3149,7 +3189,8 @@ function gen_sig(and_, t, sc) { }, _1: "val decode_%s : Pbrt.Decoder.t -> %s" }), type_name, type_name)); - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "(** [decode_", @@ -3176,7 +3217,7 @@ function gen_sig(and_, t, sc) { }; const match = t.spec; let tmp; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Record */0 : tmp = [ f(match._0.r_name), @@ -3220,7 +3261,8 @@ function log(x) { } function endline(s) { - Curry._1(log(/* Format */{ + Curry._1(log({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -3235,10 +3277,11 @@ function endline(s) { } function gen_pp_field(field_type) { - if (typeof field_type !== "number" && field_type.TAG !== /* Ft_basic_type */0) { + if (!/* tag */(typeof field_type === "number" || typeof field_type === "string") && field_type.TAG !== /* Ft_basic_type */0) { return function_name_of_user_defined("pp", field_type._0); } - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Pbrt.Pp.pp_", @@ -3255,7 +3298,8 @@ function gen_pp_field(field_type) { function gen_pp_record(and_, param, sc) { const r_fields = param.r_fields; const r_name = param.r_name; - Curry._1(log(/* Format */{ + Curry._1(log({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "gen_pp, record_name: ", @@ -3271,7 +3315,8 @@ function gen_pp_record(and_, param, sc) { }, _1: "gen_pp, record_name: %s\n" }), r_name); - line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -3306,7 +3351,8 @@ function gen_pp_record(and_, param, sc) { Stdlib__List.iter((function (record_field) { const rf_field_type = record_field.rf_field_type; const rf_label = record_field.rf_label; - const var_name = Curry._1(Stdlib__Printf.sprintf(/* Format */{ + const var_name = Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "v.", @@ -3318,10 +3364,11 @@ function gen_pp_record(and_, param, sc) { }, _1: "v.%s" }), rf_label); - switch (rf_field_type.TAG | 0) { + switch (rf_field_type.TAG) { case /* Rft_required */0 : const field_string_of = gen_pp_field(rf_field_type._0[0]); - return line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + return line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Pbrt.Pp.pp_record_field \"", @@ -3355,7 +3402,8 @@ function gen_pp_record(and_, param, sc) { }), rf_label, field_string_of, var_name)); case /* Rft_optional */1 : const field_string_of$1 = gen_pp_field(rf_field_type._0[0]); - return line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + return line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Pbrt.Pp.pp_record_field \"", @@ -3390,8 +3438,9 @@ function gen_pp_record(and_, param, sc) { case /* Rft_repeated_field */2 : const match = rf_field_type._0; const field_string_of$2 = gen_pp_field(match[1]); - if (match[0]) { - return line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + if (match[0] === /* Rt_list */0) { + return line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Pbrt.Pp.pp_record_field \"", @@ -3406,13 +3455,13 @@ function gen_pp_record(and_, param, sc) { _0: /* No_padding */0, _1: { TAG: /* String_literal */11, - _0: ") fmt (Pbrt.Repeated_field.to_list ", + _0: ") fmt ", _1: { TAG: /* String */2, _0: /* No_padding */0, _1: { - TAG: /* String_literal */11, - _0: ");", + TAG: /* Char_literal */12, + _0: /* ';' */59, _1: /* End_of_format */0 } } @@ -3421,10 +3470,11 @@ function gen_pp_record(and_, param, sc) { } } }, - _1: "Pbrt.Pp.pp_record_field \"%s\" (Pbrt.Pp.pp_list %s) fmt (Pbrt.Repeated_field.to_list %s);" + _1: "Pbrt.Pp.pp_record_field \"%s\" (Pbrt.Pp.pp_list %s) fmt %s;" }), rf_label, field_string_of$2, var_name)); } else { - return line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + return line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Pbrt.Pp.pp_record_field \"", @@ -3439,13 +3489,13 @@ function gen_pp_record(and_, param, sc) { _0: /* No_padding */0, _1: { TAG: /* String_literal */11, - _0: ") fmt ", + _0: ") fmt (Pbrt.Repeated_field.to_list ", _1: { TAG: /* String */2, _0: /* No_padding */0, _1: { - TAG: /* Char_literal */12, - _0: /* ';' */59, + TAG: /* String_literal */11, + _0: ");", _1: /* End_of_format */0 } } @@ -3454,18 +3504,20 @@ function gen_pp_record(and_, param, sc) { } } }, - _1: "Pbrt.Pp.pp_record_field \"%s\" (Pbrt.Pp.pp_list %s) fmt %s;" + _1: "Pbrt.Pp.pp_record_field \"%s\" (Pbrt.Pp.pp_list %s) fmt (Pbrt.Repeated_field.to_list %s);" }), rf_label, field_string_of$2, var_name)); } case /* Rft_associative_field */3 : const match$1 = rf_field_type._0; - const pp_runtime_function = match$1[0] ? "pp_hastable" : "pp_associative_list"; + let pp_runtime_function; + pp_runtime_function = match$1[0] === /* At_list */0 ? "pp_associative_list" : "pp_hastable"; const pp_key = gen_pp_field({ TAG: /* Ft_basic_type */0, _0: match$1[2][0] }); const pp_value = gen_pp_field(match$1[3][0]); - return line$1(sc, Curry._5(Stdlib__Printf.sprintf(/* Format */{ + return line$1(sc, Curry._5(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Pbrt.Pp.pp_record_field \"", @@ -3514,7 +3566,8 @@ function gen_pp_record(and_, param, sc) { _1: "Pbrt.Pp.pp_record_field \"%s\" (Pbrt.Pp.%s %s %s) fmt %s;" }), rf_label, pp_runtime_function, pp_key, pp_value, var_name)); case /* Rft_variant_field */4 : - return line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + return line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Pbrt.Pp.pp_record_field \"", @@ -3559,7 +3612,8 @@ function gen_pp_record(and_, param, sc) { function gen_pp_variant(and_, param, sc) { const v_constructors = param.v_constructors; const v_name = param.v_name; - line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -3592,8 +3646,9 @@ function gen_pp_variant(and_, param, sc) { Stdlib__List.iter((function (param) { const vc_field_type = param.vc_field_type; const vc_constructor = param.vc_constructor; - if (!vc_field_type) { - return line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + if (/* tag */typeof vc_field_type === "number" || typeof vc_field_type === "string") { + return line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| ", @@ -3619,7 +3674,8 @@ function gen_pp_variant(and_, param, sc) { }), vc_constructor, vc_constructor)); } const field_string_of = gen_pp_field(vc_field_type._0); - line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| ", @@ -3633,7 +3689,8 @@ function gen_pp_variant(and_, param, sc) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -3684,7 +3741,8 @@ function gen_pp_variant(and_, param, sc) { function gen_pp_const_variant(and_, param, sc) { const cv_constructors = param.cv_constructors; const cv_name = param.cv_name; - line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -3716,7 +3774,8 @@ function gen_pp_const_variant(and_, param, sc) { line$1(sc, "match v with"); Stdlib__List.iter((function (param) { const name = param[0]; - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| ", @@ -3746,7 +3805,7 @@ function gen_pp_const_variant(and_, param, sc) { function gen_struct$1(and_, t, sc) { const r = t.spec; - switch (r.TAG | 0) { + switch (r.TAG) { case /* Record */0 : gen_pp_record(and_, r._0, sc); break; @@ -3763,7 +3822,8 @@ function gen_struct$1(and_, t, sc) { function gen_sig$1(and_, t, sc) { const f = function (type_name) { - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "val pp_", @@ -3787,7 +3847,8 @@ function gen_sig$1(and_, t, sc) { }, _1: "val pp_%s : Format.formatter -> %s -> unit " }), type_name, type_name)); - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "(** [pp_", @@ -3805,7 +3866,7 @@ function gen_sig$1(and_, t, sc) { }), type_name)); }; const v = t.spec; - switch (v.TAG | 0) { + switch (v.TAG) { case /* Record */0 : f(v._0.r_name); break; @@ -3833,17 +3894,18 @@ const funarg = { }; function height(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create(l, x, d, r) { const hl = height(l); const hr = height(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -3853,32 +3915,35 @@ function create(l, x, d, r) { } function bal(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height(ll) >= height(lr)) { - return create(ll, lv, ld, create(lr, x, d, r)); - } - if (lr) { - return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height(ll) >= height(lr)) { + return create(ll, lv, ld, create(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -3886,22 +3951,22 @@ function bal(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height(rr) >= height(rl)) { - return create(create(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height(rr) >= height(rl)) { + return create(create(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -3909,8 +3974,9 @@ function bal(l, x, d, r) { } function add(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -3927,7 +3993,8 @@ function add(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -3955,28 +4022,29 @@ function add(x, data, m) { function find(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(funarg.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(funarg.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } function map$1(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const l$p = map$1(f, param.l); const d$p = Curry._1(f, param.d); const r$p = map$1(f, param.r); - return /* Node */{ + return { + TAG: /* Node */0, l: l$p, v: param.v, d: d$p, @@ -3989,7 +4057,7 @@ function fold(f, _m, _accu) { while(true) { const accu = _accu; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return accu; } _accu = Curry._3(f, m.v, m.d, fold(f, m.l, accu)); @@ -4038,7 +4106,8 @@ function eq_value(param) { function string_of_option(f, x) { if (x !== undefined) { - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Some(", @@ -4071,7 +4140,8 @@ function reset(g) { } function strong_connect(g, sccs, stack, index, v) { - Curry._2(log(/* Format */{ + Curry._2(log({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "[Graph] processing v [", @@ -4111,7 +4181,8 @@ function strong_connect(g, sccs, stack, index, v) { const stack = param[1]; const sccs = param[0]; const w = Curry._2(find, id, g); - Curry._2(log(/* Format */{ + Curry._2(log({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "[Graph] sub w [", @@ -4171,7 +4242,8 @@ function strong_connect(g, sccs, stack, index, v) { const index$1 = match[2]; const stack$2 = match[1]; const sccs$1 = match[0]; - Curry._3(log(/* Format */{ + Curry._3(log({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "[Graph] after sub for v [", @@ -4209,7 +4281,8 @@ function strong_connect(g, sccs, stack, index, v) { }), v.lowlink), string_of_option((function (prim) { return String(prim); }), v.index)); - Curry._1(log(/* Format */{ + Curry._1(log({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "[Graph] -> stack : ", @@ -4364,7 +4437,8 @@ function type_of_id(all_types, id) { } function string_of_unresolved(param) { - return Curry._3(Stdlib__Printf.sprintf(/* Format */{ + return Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unresolved:{scope ", @@ -4463,7 +4537,8 @@ function field_type_of_string(s) { case "uint64" : return /* Field_type_uint64 */5; default: - return /* Field_type_type */{ + return { + TAG: /* Field_type_type */0, _0: unresolved_of_string(s) }; } @@ -4477,7 +4552,7 @@ function compile_default_p2(all_types, field) { return ; } let exit = 0; - if (typeof field_type$1 === "number") { + if (/* tag */typeof field_type$1 === "number" || typeof field_type$1 === "string") { switch (field_type$1) { case /* Field_type_double */0 : case /* Field_type_float */1 : @@ -4485,16 +4560,6 @@ function compile_default_p2(all_types, field) { break; case /* Field_type_uint32 */4 : case /* Field_type_uint64 */5 : - exit = 3; - break; - case /* Field_type_int32 */2 : - case /* Field_type_int64 */3 : - case /* Field_type_sint32 */6 : - case /* Field_type_sint64 */7 : - case /* Field_type_fixed32 */8 : - case /* Field_type_fixed64 */9 : - case /* Field_type_sfixed32 */10 : - case /* Field_type_sfixed64 */11 : exit = 2; break; case /* Field_type_bool */12 : @@ -4511,7 +4576,12 @@ function compile_default_p2(all_types, field) { } case /* Field_type_bytes */14 : return invalid_default_value(field_name$1, "default value not supported for bytes", undefined); - + default: + if (field_default$1.TAG === /* Constant_int */2) { + return field_default$1; + } else { + return invalid_default_value(field_name$1, "invalid default type (int expected)", undefined); + } } } else { if (field_default$1.TAG !== /* Constant_litteral */4) { @@ -4538,7 +4608,7 @@ function compile_default_p2(all_types, field) { } switch (exit) { case 1 : - switch (field_default$1.TAG | 0) { + switch (field_default$1.TAG) { case /* Constant_int */2 : return { TAG: /* Constant_float */3, @@ -4550,12 +4620,6 @@ function compile_default_p2(all_types, field) { return invalid_default_value(field_name$1, "invalid default type (float/int expected)", undefined); } case 2 : - if (field_default$1.TAG === /* Constant_int */2) { - return field_default$1; - } else { - return invalid_default_value(field_name$1, "invalid default type (int expected)", undefined); - } - case 3 : if (field_default$1.TAG === /* Constant_int */2) { if (field_default$1._0 >= 0) { return field_default$1; @@ -4685,7 +4749,7 @@ function compile_message_p1(file_name, file_options, message_scope, param) { const all_types = param[2]; const extensions = param[1]; const message_body = param[0]; - switch (f.TAG | 0) { + switch (f.TAG) { case /* Message_field */0 : const field = { TAG: /* Message_field */0, @@ -4786,7 +4850,7 @@ function compile_message_p1(file_name, file_options, message_scope, param) { } }; Stdlib__List.fold_left((function (number_index, f) { - switch (f.TAG | 0) { + switch (f.TAG) { case /* Message_field */0 : return validate_duplicate(number_index, f._0); case /* Message_oneof_field */1 : @@ -4887,7 +4951,8 @@ function compile_message_p2(types, param, message) { return Stdlib__List.rev(loop(/* [] */0, message_scope)); }; const compile_field_p2 = function (field_name, field_type) { - Curry._1(log(/* Format */{ + Curry._1(log({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "[pbtt] field_name: ", @@ -4903,23 +4968,57 @@ function compile_message_p2(types, param, message) { }, _1: "[pbtt] field_name: %s\n" }), field_name); - if (typeof field_type === "number") { - if (typeof field_type === "number") { - return field_type; + if (/* tag */typeof field_type === "number" || typeof field_type === "string") { + if (/* tag */typeof field_type === "number" || typeof field_type === "string") { + switch (field_type) { + case /* Field_type_double */0 : + return /* Field_type_double */0; + case /* Field_type_float */1 : + return /* Field_type_float */1; + case /* Field_type_int32 */2 : + return /* Field_type_int32 */2; + case /* Field_type_int64 */3 : + return /* Field_type_int64 */3; + case /* Field_type_uint32 */4 : + return /* Field_type_uint32 */4; + case /* Field_type_uint64 */5 : + return /* Field_type_uint64 */5; + case /* Field_type_sint32 */6 : + return /* Field_type_sint32 */6; + case /* Field_type_sint64 */7 : + return /* Field_type_sint64 */7; + case /* Field_type_fixed32 */8 : + return /* Field_type_fixed32 */8; + case /* Field_type_fixed64 */9 : + return /* Field_type_fixed64 */9; + case /* Field_type_sfixed32 */10 : + return /* Field_type_sfixed32 */10; + case /* Field_type_sfixed64 */11 : + return /* Field_type_sfixed64 */11; + case /* Field_type_bool */12 : + return /* Field_type_bool */12; + case /* Field_type_string */13 : + return /* Field_type_string */13; + case /* Field_type_bytes */14 : + return /* Field_type_bytes */14; + + } + } else { + throw new Caml_js_exceptions.MelangeError(Compilation_error, { + MEL_EXN_ID: Compilation_error, + _1: { + TAG: /* Programatic_error */4, + _0: /* Unexpected_field_type */1 + } + }); } - throw new Caml_js_exceptions.MelangeError(Compilation_error, { - MEL_EXN_ID: Compilation_error, - _1: { - TAG: /* Programatic_error */4, - _0: /* Unexpected_field_type */1 - } - }); } const unresolved = field_type._0; const type_name = unresolved.type_name; endline("[pbtt] " + string_of_unresolved(unresolved)); const search_scopes$1 = search_scopes(unresolved.scope, unresolved.from_root); - Curry._1(log(/* Format */{ + Curry._1(log({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "[pbtt] message scope: ", @@ -4936,7 +5035,8 @@ function compile_message_p2(types, param, message) { _1: "[pbtt] message scope: %s\n" }), string_of_string_list(message_scope)); Stdlib__List.iteri((function (i, scope) { - Curry._2(log(/* Format */{ + Curry._2(log({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "[pbtt] search_scope[", @@ -4984,7 +5084,8 @@ function compile_message_p2(types, param, message) { } }), search_scopes$1); if (id !== undefined) { - return /* Field_type_type */{ + return { + TAG: /* Field_type_type */0, _0: id }; } else { @@ -5002,7 +5103,7 @@ function compile_message_p2(types, param, message) { } }; const message_body = Stdlib__List.fold_left((function (message_body, field) { - switch (field.TAG | 0) { + switch (field.TAG) { case /* Message_field */0 : const field$1 = field._0; const field_name$1 = field_name(field$1); @@ -5101,10 +5202,10 @@ function node_of_proto_type(param) { }; } const sub = Stdlib__List.flatten(Stdlib__List.map((function (param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Message_field */0 : const field_type = param._0.field_type; - if (typeof field_type === "number") { + if (/* tag */typeof field_type === "number" || typeof field_type === "string") { return /* [] */0; } else { return { @@ -5115,7 +5216,7 @@ function node_of_proto_type(param) { case /* Message_oneof_field */1 : return Stdlib__List.flatten(Stdlib__List.map((function (param) { const field_type = param.field_type; - if (typeof field_type === "number") { + if (/* tag */typeof field_type === "number" || typeof field_type === "string") { return /* [] */0; } else { return { @@ -5126,7 +5227,7 @@ function node_of_proto_type(param) { }), param._0.oneof_fields)); case /* Message_map_field */2 : const map_value_type = param._0.map_value_type; - if (typeof map_value_type === "number") { + if (/* tag */typeof map_value_type === "number" || typeof map_value_type === "string") { return /* [] */0; } else { return { @@ -5171,13 +5272,18 @@ function gen_type_record(mutable_, and_, param, sc) { const r_name = param.r_name; const mutable_$1 = mutable_ !== undefined; const is_imperative_type = function (param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Rft_repeated_field */2 : - case /* Rft_associative_field */3 : - if (param._0[0]) { - return true; + if (param._0[0] === /* Rt_list */0) { + return false; } else { + return true; + } + case /* Rft_associative_field */3 : + if (param._0[0] === /* At_list */0) { return false; + } else { + return true; } default: return false; @@ -5191,7 +5297,8 @@ function gen_type_record(mutable_, and_, param, sc) { } }; const r_name$1 = mutable_$1 ? r_name + "_mutable" : r_name; - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -5216,7 +5323,8 @@ function gen_type_record(mutable_, and_, param, sc) { const rf_field_type = param.rf_field_type; const prefix = field_prefix(rf_field_type, param.rf_mutable); const type_string = string_of_record_field_type(rf_field_type); - line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -5247,7 +5355,8 @@ function gen_type_record(mutable_, and_, param, sc) { function gen_type_variant(and_, variant, sc) { const v_constructors = variant.v_constructors; - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -5271,8 +5380,9 @@ function gen_type_variant(and_, variant, sc) { Stdlib__List.iter((function (param) { const vc_field_type = param.vc_field_type; const vc_constructor = param.vc_constructor; - if (!vc_field_type) { - return line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + if (/* tag */typeof vc_field_type === "number" || typeof vc_field_type === "string") { + return line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| ", @@ -5286,7 +5396,8 @@ function gen_type_variant(and_, variant, sc) { }), vc_constructor)); } const type_string = string_of_field_type(vc_field_type._0); - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| ", @@ -5312,7 +5423,8 @@ function gen_type_variant(and_, variant, sc) { function gen_type_const_variant(and_, param, sc) { const cv_constructors = param.cv_constructors; - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -5334,7 +5446,8 @@ function gen_type_const_variant(and_, param, sc) { }), type_decl_of_and(and_), param.cv_name)); scope(sc, (function (sc) { Stdlib__List.iter((function (param) { - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| ", @@ -5356,7 +5469,7 @@ function gen_type_const_variant(and_, param, sc) { function gen_struct$2(and_, t, scope) { const r = t.spec; - switch (r.TAG | 0) { + switch (r.TAG) { case /* Record */0 : const r$1 = r._0; gen_type_record(undefined, and_, r$1, scope); @@ -5376,7 +5489,7 @@ function gen_struct$2(and_, t, scope) { function gen_sig$2(and_, t, scope) { const r = t.spec; - switch (r.TAG | 0) { + switch (r.TAG) { case /* Record */0 : gen_type_record(undefined, and_, r._0, scope); break; @@ -5400,7 +5513,8 @@ const Codegen_type = { function gen_encode_field_key(sc, number, pk, is_packed) { const s = string_of_payload_kind(undefined, pk, is_packed); const s$1 = Caml_bytes.bytes_to_string(Stdlib__Bytes.lowercase_ascii(Caml_bytes.bytes_of_string(s))); - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Pbrt.Encoder.key (", @@ -5443,14 +5557,15 @@ function gen_encode_field_type(with_key, sc, var_name, encoding_number, pk, is_p } }; - if (typeof field_type === "number") { + if (/* tag */typeof field_type === "number" || typeof field_type === "string") { encode_key(sc); return line$1(sc, "Pbrt.Encoder.empty_nested encoder;"); } if (field_type.TAG === /* Ft_basic_type */0) { encode_key(sc); const rt = encode_basic_type(field_type._0, pk); - return line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -5475,7 +5590,8 @@ function gen_encode_field_type(with_key, sc, var_name, encoding_number, pk, is_p encode_key(sc); const f_name = function_name_of_user_defined("encode", ud); if (ud.udt_nested) { - return line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Pbrt.Encoder.nested (", @@ -5500,7 +5616,8 @@ function gen_encode_field_type(with_key, sc, var_name, encoding_number, pk, is_p _1: "Pbrt.Encoder.nested (%s %s) encoder;" }), f_name, var_name)); } else { - return line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -5526,7 +5643,8 @@ function gen_encode_field_type(with_key, sc, var_name, encoding_number, pk, is_p function gen_encode_record(and_, param, sc) { const r_fields = param.r_fields; const r_name = param.r_name; - Curry._1(log(/* Format */{ + Curry._1(log({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "gen_encode_record record_name: ", @@ -5542,7 +5660,8 @@ function gen_encode_record(and_, param, sc) { }, _1: "gen_encode_record record_name: %s\n" }), r_name); - line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -5574,10 +5693,11 @@ function gen_encode_record(and_, param, sc) { Stdlib__List.iter((function (record_field) { const rf_field_type = record_field.rf_field_type; const rf_label = record_field.rf_label; - switch (rf_field_type.TAG | 0) { + switch (rf_field_type.TAG) { case /* Rft_required */0 : const match = rf_field_type._0; - const var_name = Curry._1(Stdlib__Printf.sprintf(/* Format */{ + const var_name = Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "v.", @@ -5597,7 +5717,8 @@ function gen_encode_record(and_, param, sc) { const field_type = match$1[0]; line$1(sc, "("); scope(sc, (function (sc) { - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "match v.", @@ -5613,7 +5734,8 @@ function gen_encode_record(and_, param, sc) { }, _1: "match v.%s with " }), rf_label)); - line$1(sc, Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| Some x -> (", @@ -5634,16 +5756,17 @@ function gen_encode_record(and_, param, sc) { const pk$1 = match$2[3]; const encoding_number$1 = match$2[2]; const field_type$1 = match$2[1]; - if (match$2[0]) { + if (match$2[0] === /* Rt_list */0) { if (is_packed) { gen_encode_field_key(sc, encoding_number$1, pk$1, is_packed); line$1(sc, "Pbrt.Encoder.nested (fun encoder ->"); scope(sc, (function (sc) { - line$1(sc, "Pbrt.Repeated_field.iter (fun x -> "); + line$1(sc, "List.iter (fun x -> "); scope(sc, (function (sc) { gen_encode_field_type(undefined, sc, "x", encoding_number$1, pk$1, is_packed, field_type$1); })); - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: ") v.", @@ -5662,11 +5785,12 @@ function gen_encode_record(and_, param, sc) { })); return line$1(sc, ") encoder;"); } else { - line$1(sc, "Pbrt.Repeated_field.iter (fun x -> "); + line$1(sc, "List.iter (fun x -> "); scope(sc, (function (sc) { gen_encode_field_type(Caml_option.some(undefined), sc, "x", encoding_number$1, pk$1, is_packed, field_type$1); })); - return line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: ") v.", @@ -5687,11 +5811,12 @@ function gen_encode_record(and_, param, sc) { gen_encode_field_key(sc, encoding_number$1, pk$1, is_packed); line$1(sc, "Pbrt.Encoder.nested (fun encoder ->"); scope(sc, (function (sc) { - line$1(sc, "List.iter (fun x -> "); + line$1(sc, "Pbrt.Repeated_field.iter (fun x -> "); scope(sc, (function (sc) { gen_encode_field_type(undefined, sc, "x", encoding_number$1, pk$1, is_packed, field_type$1); })); - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: ") v.", @@ -5710,11 +5835,12 @@ function gen_encode_record(and_, param, sc) { })); return line$1(sc, ") encoder;"); } else { - line$1(sc, "List.iter (fun x -> "); + line$1(sc, "Pbrt.Repeated_field.iter (fun x -> "); scope(sc, (function (sc) { gen_encode_field_type(Caml_option.some(undefined), sc, "x", encoding_number$1, pk$1, is_packed, field_type$1); })); - return line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: ") v.", @@ -5739,7 +5865,8 @@ function gen_encode_record(and_, param, sc) { const match$5 = match$3[2]; const key_pk = match$5[1]; const encoding_number$2 = match$3[1]; - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "let encode_key = ", @@ -5760,14 +5887,15 @@ function gen_encode_record(and_, param, sc) { gen_encode_field_type(undefined, sc, "x", -1, value_pk, false, value_type); })); line$1(sc, ") in"); - if (match$3[0]) { - line$1(sc, "Hashtbl.iter (fun k v ->"); - } else { + if (match$3[0] === /* At_list */0) { line$1(sc, "List.iter (fun (k, v) ->"); + } else { + line$1(sc, "Hashtbl.iter (fun k v ->"); } scope(sc, (function (sc) { gen_encode_field_key(sc, encoding_number$2, /* Pk_bytes */2, false); - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "let map_entry = (k, Pbrt.", @@ -5793,7 +5921,8 @@ function gen_encode_record(and_, param, sc) { }), string_of_payload_kind(Caml_option.some(undefined), key_pk, false), string_of_payload_kind(Caml_option.some(undefined), value_pk, false))); line$1(sc, "Pbrt.Encoder.map_entry ~encode_key ~encode_value map_entry encoder"); })); - return line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: ") v.", @@ -5813,7 +5942,8 @@ function gen_encode_record(and_, param, sc) { const v_constructors = rf_field_type._0.v_constructors; line$1(sc, "("); scope(sc, (function (sc) { - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "match v.", @@ -5834,9 +5964,9 @@ function gen_encode_record(and_, param, sc) { const vc_encoding_number = param.vc_encoding_number; const vc_field_type = param.vc_field_type; const vc_constructor = param.vc_constructor; - if (vc_field_type) { - const field_type = vc_field_type._0; - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + if (/* tag */typeof vc_field_type === "number" || typeof vc_field_type === "string") { + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| ", @@ -5845,19 +5975,22 @@ function gen_encode_record(and_, param, sc) { _0: /* No_padding */0, _1: { TAG: /* String_literal */11, - _0: " x -> (", + _0: " -> (", _1: /* End_of_format */0 } } }, - _1: "| %s x -> (" + _1: "| %s -> (" }), vc_constructor)); scope(sc, (function (sc) { - gen_encode_field_type(Caml_option.some(undefined), sc, "x", vc_encoding_number, vc_payload_kind, false, field_type); + gen_encode_field_key(sc, vc_encoding_number, vc_payload_kind, false); + line$1(sc, "Pbrt.Encoder.empty_nested encoder"); })); return line$1(sc, ")"); } - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + const field_type = vc_field_type._0; + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| ", @@ -5866,16 +5999,15 @@ function gen_encode_record(and_, param, sc) { _0: /* No_padding */0, _1: { TAG: /* String_literal */11, - _0: " -> (", + _0: " x -> (", _1: /* End_of_format */0 } } }, - _1: "| %s -> (" + _1: "| %s x -> (" }), vc_constructor)); scope(sc, (function (sc) { - gen_encode_field_key(sc, vc_encoding_number, vc_payload_kind, false); - line$1(sc, "Pbrt.Encoder.empty_nested encoder"); + gen_encode_field_type(Caml_option.some(undefined), sc, "x", vc_encoding_number, vc_payload_kind, false, field_type); })); line$1(sc, ")"); }), v_constructors); @@ -5891,7 +6023,8 @@ function gen_encode_record(and_, param, sc) { function gen_encode_variant(and_, variant, sc) { const v_constructors = variant.v_constructors; const v_name = variant.v_name; - line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -5926,9 +6059,9 @@ function gen_encode_variant(and_, variant, sc) { const vc_encoding_number = param.vc_encoding_number; const vc_field_type = param.vc_field_type; const vc_constructor = param.vc_constructor; - if (vc_field_type) { - const field_type = vc_field_type._0; - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + if (/* tag */typeof vc_field_type === "number" || typeof vc_field_type === "string") { + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| ", @@ -5937,19 +6070,22 @@ function gen_encode_variant(and_, variant, sc) { _0: /* No_padding */0, _1: { TAG: /* String_literal */11, - _0: " x -> (", + _0: " -> (", _1: /* End_of_format */0 } } }, - _1: "| %s x -> (" + _1: "| %s -> (" }), vc_constructor)); scope(sc, (function (sc) { - gen_encode_field_type(Caml_option.some(undefined), sc, "x", vc_encoding_number, vc_payload_kind, false, field_type); + gen_encode_field_key(sc, vc_encoding_number, vc_payload_kind, false); + line$1(sc, "Pbrt.Encoder.empty_nested encoder"); })); return line$1(sc, ")"); } - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + const field_type = vc_field_type._0; + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| ", @@ -5958,16 +6094,15 @@ function gen_encode_variant(and_, variant, sc) { _0: /* No_padding */0, _1: { TAG: /* String_literal */11, - _0: " -> (", + _0: " x -> (", _1: /* End_of_format */0 } } }, - _1: "| %s -> (" + _1: "| %s x -> (" }), vc_constructor)); scope(sc, (function (sc) { - gen_encode_field_key(sc, vc_encoding_number, vc_payload_kind, false); - line$1(sc, "Pbrt.Encoder.empty_nested encoder"); + gen_encode_field_type(Caml_option.some(undefined), sc, "x", vc_encoding_number, vc_payload_kind, false, field_type); })); line$1(sc, ")"); }), v_constructors); @@ -5977,7 +6112,8 @@ function gen_encode_variant(and_, variant, sc) { function gen_encode_const_variant(and_, param, sc) { const cv_constructors = param.cv_constructors; const cv_name = param.cv_name; - line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -6010,7 +6146,8 @@ function gen_encode_const_variant(and_, param, sc) { Stdlib__List.iter((function (param) { const value = param[1]; const name = param[0]; - line$1(sc, value > 0 ? Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, value > 0 ? Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| ", @@ -6035,7 +6172,8 @@ function gen_encode_const_variant(and_, param, sc) { } }, _1: "| %s -> Pbrt.Encoder.int_as_varint %i encoder" - }), name, value) : Curry._2(Stdlib__Printf.sprintf(/* Format */{ + }), name, value) : Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "| ", @@ -6068,7 +6206,7 @@ function gen_encode_const_variant(and_, param, sc) { function gen_struct$3(and_, t, sc) { const r = t.spec; let tmp; - switch (r.TAG | 0) { + switch (r.TAG) { case /* Record */0 : tmp = [ gen_encode_record(and_, r._0, sc), @@ -6094,7 +6232,8 @@ function gen_struct$3(and_, t, sc) { function gen_sig$3(and_, t, sc) { const f = function (type_name) { - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "val encode_", @@ -6118,7 +6257,8 @@ function gen_sig$3(and_, t, sc) { }, _1: "val encode_%s : %s -> Pbrt.Encoder.t -> unit" }), type_name, type_name)); - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "(** [encode_", @@ -6137,7 +6277,7 @@ function gen_sig$3(and_, t, sc) { }; const v = t.spec; let tmp; - switch (v.TAG | 0) { + switch (v.TAG) { case /* Record */0 : tmp = [ f(v._0.r_name), @@ -6168,7 +6308,7 @@ const Codegen_encode = { }; function default_value_of_field_type(field_name, field_type, field_default) { - if (typeof field_type === "number") { + if (/* tag */typeof field_type === "number" || typeof field_type === "string") { return "()"; } else if (field_type.TAG === /* Ft_basic_type */0) { let basic_type = field_type._0; @@ -6176,7 +6316,8 @@ function default_value_of_field_type(field_name, field_type, field_default) { case /* Bt_string */0 : if (field_default !== undefined) { if (field_default.TAG === /* Constant_string */0) { - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '"' */34, @@ -6221,7 +6362,8 @@ function default_value_of_field_type(field_name, field_type, field_default) { case /* Bt_int32 */3 : if (field_default !== undefined) { if (field_default.TAG === /* Constant_int */2) { - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -6244,7 +6386,8 @@ function default_value_of_field_type(field_name, field_type, field_default) { case /* Bt_int64 */4 : if (field_default !== undefined) { if (field_default.TAG === /* Constant_int */2) { - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -6267,7 +6410,8 @@ function default_value_of_field_type(field_name, field_type, field_default) { case /* Bt_bytes */5 : if (field_default !== undefined) { if (field_default.TAG === /* Constant_string */0) { - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Bytes.of_string \"", @@ -6317,7 +6461,7 @@ function record_field_default_info(record_field) { return default_value_of_field_type(rf_label, field_type, defalut_value); }; let default_value; - switch (rf_field_type.TAG | 0) { + switch (rf_field_type.TAG) { case /* Rft_required */0 : const match = rf_field_type._0; default_value = dfvft(match[0], match[3]); @@ -6325,7 +6469,8 @@ function record_field_default_info(record_field) { case /* Rft_optional */1 : const match$1 = rf_field_type._0; const default_value$1 = match$1[3]; - default_value = default_value$1 !== undefined ? Curry._1(Stdlib__Printf.sprintf(/* Format */{ + default_value = default_value$1 !== undefined ? Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Some (", @@ -6344,7 +6489,8 @@ function record_field_default_info(record_field) { break; case /* Rft_repeated_field */2 : const match$2 = rf_field_type._0; - default_value = match$2[0] ? Curry._1(Stdlib__Printf.sprintf(/* Format */{ + default_value = match$2[0] === /* Rt_list */0 ? "[]" : Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Pbrt.Repeated_field.make (", @@ -6359,10 +6505,10 @@ function record_field_default_info(record_field) { } }, _1: "Pbrt.Repeated_field.make (%s)" - }), dfvft(match$2[1], undefined)) : "[]"; + }), dfvft(match$2[1], undefined)); break; case /* Rft_associative_field */3 : - default_value = rf_field_type._0[0] ? "Hashtbl.create 128" : "[]"; + default_value = rf_field_type._0[0] === /* At_list */0 ? "[]" : "Hashtbl.create 128"; break; case /* Rft_variant_field */4 : const v_constructors = rf_field_type._0.v_constructors; @@ -6370,7 +6516,8 @@ function record_field_default_info(record_field) { const match$3 = v_constructors.hd; const vc_field_type = match$3.vc_field_type; const vc_constructor = match$3.vc_constructor; - default_value = vc_field_type ? Curry._2(Stdlib__Printf.sprintf(/* Format */{ + default_value = /* tag */typeof vc_field_type === "number" || typeof vc_field_type === "string" ? vc_constructor : Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -6389,7 +6536,7 @@ function record_field_default_info(record_field) { } }, _1: "%s (%s)" - }), vc_constructor, dfvft(vc_field_type._0, undefined)) : vc_constructor; + }), vc_constructor, dfvft(vc_field_type._0, undefined)); } else { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", @@ -6415,7 +6562,8 @@ function gen_default_record(mutable_, and_, param, sc) { const fields_default_info = Stdlib__List.map(record_field_default_info, param.r_fields); if (mutable_ !== undefined) { const rn = r_name + "_mutable"; - line$1(sc, Curry._3(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -6445,7 +6593,8 @@ function gen_default_record(mutable_, and_, param, sc) { }), let_decl_of_and(and_), rn, rn)); scope(sc, (function (sc) { Stdlib__List.iter((function (param) { - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -6468,7 +6617,8 @@ function gen_default_record(mutable_, and_, param, sc) { }), fields_default_info); })); } else { - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -6491,7 +6641,8 @@ function gen_default_record(mutable_, and_, param, sc) { scope(sc, (function (sc) { Stdlib__List.iter((function (param) { const fname = param[0]; - line$1(sc, Curry._4(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._4(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '?' */63, @@ -6532,7 +6683,8 @@ function gen_default_record(mutable_, and_, param, sc) { _1: "?%s:((%s:%s) = %s)" }), fname, fname, param[2], param[1])); }), fields_default_info); - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "() : ", @@ -6551,7 +6703,8 @@ function gen_default_record(mutable_, and_, param, sc) { })); scope(sc, (function (sc) { Stdlib__List.iter((function (param) { - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -6577,8 +6730,9 @@ function gen_default_variant(and_, param, sc) { const vc_field_type = match.vc_field_type; const vc_constructor = match.vc_constructor; const decl = let_decl_of_and(and_); - if (!vc_field_type) { - return line$1(sc, Curry._4(Stdlib__Printf.sprintf(/* Format */{ + if (/* tag */typeof vc_field_type === "number" || typeof vc_field_type === "string") { + return line$1(sc, Curry._4(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -6612,7 +6766,8 @@ function gen_default_variant(and_, param, sc) { }), decl, v_name, v_name, vc_constructor)); } const default_value = default_value_of_field_type(v_name, vc_field_type._0, undefined); - return line$1(sc, Curry._5(Stdlib__Printf.sprintf(/* Format */{ + return line$1(sc, Curry._5(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -6675,7 +6830,8 @@ function gen_default_const_variant(and_, param, sc) { _1: "programmatic TODO error" }); } - line$1(sc, Curry._4(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._4(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -6716,7 +6872,7 @@ function gen_default_const_variant(and_, param, sc) { function gen_struct$4(and_, t, sc) { const r = t.spec; let tmp; - switch (r.TAG | 0) { + switch (r.TAG) { case /* Record */0 : const r$1 = r._0; tmp = [ @@ -6743,7 +6899,8 @@ function gen_struct$4(and_, t, sc) { function gen_sig_record(sc, param) { const r_name = param.r_name; - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "val default_", @@ -6762,7 +6919,8 @@ function gen_sig_record(sc, param) { const fields_default_info = Stdlib__List.map(record_field_default_info, param.r_fields); scope(sc, (function (sc) { Stdlib__List.iter((function (param) { - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '?' */63, @@ -6790,7 +6948,8 @@ function gen_sig_record(sc, param) { line$1(sc, "unit ->"); line$1(sc, r_name); })); - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "(** [default_", @@ -6818,7 +6977,8 @@ function gen_sig_record(sc, param) { function gen_sig$4(and_, t, sc) { const f = function (type_name) { - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "val default_", @@ -6838,7 +6998,8 @@ function gen_sig$4(and_, t, sc) { }, _1: "val default_%s : unit -> %s" }), type_name, type_name)); - line$1(sc, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "(** [default_", @@ -6865,7 +7026,7 @@ function gen_sig$4(and_, t, sc) { }; const r = t.spec; let tmp; - switch (r.TAG | 0) { + switch (r.TAG) { case /* Record */0 : tmp = [ gen_sig_record(sc, r._0), @@ -7066,11 +7227,12 @@ function type_name(message_scope, name) { } function encoding_info_of_field_type(all_types, field_type) { - if (typeof field_type === "number") { + if (/* tag */typeof field_type === "number" || typeof field_type === "string") { switch (field_type) { case /* Field_type_sint32 */6 : case /* Field_type_sint64 */7 : - return /* Pk_varint */{ + return { + TAG: /* Pk_varint */0, _0: true }; case /* Field_type_float */1 : @@ -7081,23 +7243,20 @@ function encoding_info_of_field_type(all_types, field_type) { case /* Field_type_fixed64 */9 : case /* Field_type_sfixed64 */11 : return /* Pk_bits64 */1; - case /* Field_type_int32 */2 : - case /* Field_type_int64 */3 : - case /* Field_type_uint32 */4 : - case /* Field_type_uint64 */5 : - case /* Field_type_bool */12 : - return /* Pk_varint */{ - _0: false - }; case /* Field_type_string */13 : case /* Field_type_bytes */14 : return /* Pk_bytes */2; - + default: + return { + TAG: /* Pk_varint */0, + _0: false + }; } } else { const match = type_of_id(all_types, field_type._0); if (match.spec.TAG === /* Enum */0) { - return /* Pk_varint */{ + return { + TAG: /* Pk_varint */0, _0: false }; } else { @@ -7153,7 +7312,7 @@ function compile_field_type(field_name, all_types, file_options, field_options, TAG: /* Ft_basic_type */0, _0: /* Bt_int64 */4 }); - if (typeof field_type !== "number") { + if (!/* tag */(typeof field_type === "number" || typeof field_type === "string")) { let i = field_type._0; const module_ = module_of_file_name(file_name); let t; @@ -7286,11 +7445,14 @@ function variant_of_oneof(include_oneof_name, outer_message_names, all_types, fi const field_type$1 = compile_field_type(field_name(field), all_types, file_options, field_options(field), file_name, pbtt_field_type); const match = encoding_of_field(all_types, field); const vc_constructor = constructor_name(field_name(field)); + let tmp; + tmp = /* tag */typeof field_type$1 === "number" || typeof field_type$1 === "string" ? /* Vct_nullary */0 : ({ + TAG: /* Vct_non_nullary_constructor */0, + _0: field_type$1 + }); return { vc_constructor: vc_constructor, - vc_field_type: typeof field_type$1 === "number" ? /* Vct_nullary */0 : /* Vct_non_nullary_constructor */({ - _0: field_type$1 - }), + vc_field_type: tmp, vc_encoding_number: match[1], vc_payload_kind: match[0] }; @@ -7401,7 +7563,7 @@ function compile(proto_definition) { return /* [] */0; } const f = message_body.hd; - switch (f.TAG | 0) { + switch (f.TAG) { case /* Message_oneof_field */1 : if (!message_body.tl) { const outer_message_names = Stdlib.$at(message_names, { @@ -7429,7 +7591,7 @@ function compile(proto_definition) { const match = Stdlib__List.fold_left((function (param, field) { const fields = param[1]; const variants = param[0]; - switch (field.TAG | 0) { + switch (field.TAG) { case /* Message_field */0 : const field$1 = field._0; const match = encoding_of_field(all_pbtt_msgs$1, field$1); @@ -7543,7 +7705,8 @@ function compile(proto_definition) { const map_value_type = mf.map_value_type; const map_key_type = mf.map_key_type; const map_name = mf.map_name; - const key_type = compile_field_type(Curry._1(Stdlib__Printf.sprintf(/* Format */{ + const key_type = compile_field_type(Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "key of ", @@ -7557,7 +7720,7 @@ function compile(proto_definition) { }), map_name), all_pbtt_msgs$1, file_options, map_options, file_name, map_key_type); const key_pk = encoding_info_of_field_type(all_pbtt_msgs$1, map_key_type); let key_type$1; - if (typeof key_type === "number") { + if (/* tag */typeof key_type === "number" || typeof key_type === "string") { throw new Caml_js_exceptions.MelangeError("Failure", { MEL_EXN_ID: "Failure", _1: "Only Basic Types are supported for map keys" @@ -7571,7 +7734,8 @@ function compile(proto_definition) { _1: "Only Basic Types are supported for map keys" }); } - const value_type = compile_field_type(Curry._1(Stdlib__Printf.sprintf(/* Format */{ + const value_type = compile_field_type(Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "value of ", @@ -7662,7 +7826,8 @@ function compile(proto_definition) { const f = param[0]; if (ocamldoc_title !== undefined) { line$1(sc, ""); - line$1(sc, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "(** {2 ", @@ -7708,7 +7873,8 @@ function compile(proto_definition) { const sc$1 = { items: /* [] */0 }; - line$1(sc$1, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + line$1(sc$1, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "(** ", diff --git a/jscomp/test/dist/jscomp/test/ocaml_re_test.js b/jscomp/test/dist/jscomp/test/ocaml_re_test.js index f89acea148..d4c5547143 100644 --- a/jscomp/test/dist/jscomp/test/ocaml_re_test.js +++ b/jscomp/test/dist/jscomp/test/ocaml_re_test.js @@ -299,17 +299,18 @@ const funarg = { }; function height(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create(l, x, d, r) { const hl = height(l); const hr = height(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -319,32 +320,35 @@ function create(l, x, d, r) { } function bal(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height(ll) >= height(lr)) { - return create(ll, lv, ld, create(lr, x, d, r)); - } - if (lr) { - return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height(ll) >= height(lr)) { + return create(ll, lv, ld, create(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -352,22 +356,22 @@ function bal(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height(rr) >= height(rl)) { - return create(create(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height(rr) >= height(rl)) { + return create(create(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -375,8 +379,9 @@ function bal(l, x, d, r) { } function add(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -393,7 +398,8 @@ function add(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -421,17 +427,17 @@ function add(x, data, m) { function find(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(funarg.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(funarg.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } @@ -502,17 +508,20 @@ const funarg$1 = { }; function height$1(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$1(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; - return /* Node */{ + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; + return { + TAG: /* Node */0, l: l, v: v, r: r, @@ -521,52 +530,55 @@ function create$1(l, v, r) { } function bal$1(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const lv = l.v; - const ll = l.l; - if (height$1(ll) >= height$1(lr)) { - return create$1(ll, lv, create$1(lr, v, r)); - } - if (lr) { - return create$1(create$1(ll, lv, lr.l), lr.v, create$1(lr.r, v, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const lr = l.r; + const lv = l.v; + const ll = l.l; + if (height$1(ll) >= height$1(lr)) { + return create$1(ll, lv, create$1(lr, v, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$1(create$1(ll, lv, lr.l), lr.v, create$1(lr.r, v, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: v, r: r, h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rv = r.v; - const rl = r.l; - if (height$1(rr) >= height$1(rl)) { - return create$1(create$1(l, v, rl), rv, rr); - } - if (rl) { - return create$1(create$1(l, v, rl.l), rl.v, create$1(rl.r, rv, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const rr = r.r; + const rv = r.v; + const rl = r.l; + if (height$1(rr) >= height$1(rl)) { + return create$1(create$1(l, v, rl), rv, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$1(create$1(l, v, rl.l), rl.v, create$1(rl.r, rv, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" @@ -574,8 +586,9 @@ function bal$1(l, v, r) { } function add$1(x, t) { - if (!t) { - return /* Node */{ + if (/* tag */typeof t === "number" || typeof t === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -721,7 +734,7 @@ function seq$1(ids, kind, x, y) { const match = x.def; const match$1 = y.def; let exit = 0; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return y; } if (match.TAG === /* Alt */1) { @@ -733,7 +746,7 @@ function seq$1(ids, kind, x, y) { exit = 2; } if (exit === 2) { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { if (kind === "First") { return x; } @@ -753,7 +766,7 @@ function seq$1(ids, kind, x, y) { function is_eps(expr) { const match = expr.def; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return true; } else { return false; @@ -779,10 +792,10 @@ function erase(ids, m, m$p) { function rename(ids, x) { const l = x.def; - if (typeof l === "number") { + if (/* tag */typeof l === "number" || typeof l === "string") { return mk_expr(ids, x.def); } - switch (l.TAG | 0) { + switch (l.TAG) { case /* Alt */1 : return mk_expr(ids, { TAG: /* Alt */1, @@ -821,13 +834,13 @@ function equal(_l1, _l2) { } } const marks1 = l1.hd; - switch (marks1.TAG | 0) { + switch (marks1.TAG) { case /* TSeq */0 : if (!l2) { return false; } const match = l2.hd; - switch (match.TAG | 0) { + switch (match.TAG) { case /* TSeq */0 : if (marks1._1.id !== match._1.id) { return false; @@ -848,7 +861,7 @@ function equal(_l1, _l2) { return false; } const match$1 = l2.hd; - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* TExp */1 : if (marks1._1.id !== match$1._1.id) { return false; @@ -869,7 +882,7 @@ function equal(_l1, _l2) { return false; } const marks2 = l2.hd; - switch (marks2.TAG | 0) { + switch (marks2.TAG) { case /* TSeq */0 : case /* TExp */1 : return false; @@ -895,7 +908,7 @@ function hash$1(_l, _accu) { return accu; } const marks = l.hd; - switch (marks.TAG | 0) { + switch (marks.TAG) { case /* TSeq */0 : _accu = hash_combine(388635598, hash_combine(marks._1.id, hash$1(marks._0, accu))); _l = l.tl; @@ -918,9 +931,10 @@ function tseq(kind, x, y, rem) { return rem; } const match = x.hd; - switch (match.TAG | 0) { + switch (match.TAG) { case /* TExp */1 : - if (typeof match._1.def === "number" && !x.tl) { + let tmp = match._1.def; + if (/* tag */(typeof tmp === "number" || typeof tmp === "string") && !x.tl) { return { hd: { TAG: /* TExp */1, @@ -1004,7 +1018,7 @@ function reset_table(a) { function mark_used_indices(tbl) { return function (param) { return Stdlib__List.iter((function (param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* TSeq */0 : return mark_used_indices(tbl)(param._0); case /* TExp */1 : @@ -1048,7 +1062,7 @@ function free_index(tbl_ref, l) { function remove_matches(param) { return Stdlib__List.filter((function (param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* TSeq */0 : case /* TExp */1 : return true; @@ -1065,7 +1079,7 @@ function split_at_match_rec(_l$p, _param) { const l$p = _l$p; if (param) { const x = param.hd; - switch (x.TAG | 0) { + switch (x.TAG) { case /* TSeq */0 : case /* TExp */1 : _param = param.tl; @@ -1104,7 +1118,7 @@ function remove_duplicates(prev, _l, y) { ]; } const x = l.hd; - switch (x.TAG | 0) { + switch (x.TAG) { case /* TSeq */0 : const x$1 = x._1; const match = remove_duplicates(prev, x._0, x$1); @@ -1114,7 +1128,8 @@ function remove_duplicates(prev, _l, y) { match$1[1] ]; case /* TExp */1 : - if (typeof x._1.def === "number") { + let tmp = x._1.def; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { const r = l.tl; if (Stdlib__List.memq(y.id, prev)) { _l = r; @@ -1167,7 +1182,7 @@ function set_idx(idx, param) { return /* [] */0; } const marks = param.hd; - switch (marks.TAG | 0) { + switch (marks.TAG) { case /* TSeq */0 : return { hd: { @@ -1215,7 +1230,7 @@ function filter_marks(b, e, marks) { function delta_1(marks, c, next_cat, prev_cat, x, rem) { const s = x.def; - if (typeof s === "number") { + if (/* tag */typeof s === "number" || typeof s === "string") { return { hd: { TAG: /* TMatch */2, @@ -1224,7 +1239,7 @@ function delta_1(marks, c, next_cat, prev_cat, x, rem) { tl: rem }; } - switch (s.TAG | 0) { + switch (s.TAG) { case /* Cst */0 : if (mem(c, s._0)) { return { @@ -1247,7 +1262,7 @@ function delta_1(marks, c, next_cat, prev_cat, x, rem) { const kind = s._1; const y$p$1 = delta_1(marks, c, next_cat, prev_cat, s._2, /* [] */0); const marks$p = first((function (marks) { - switch (marks.TAG | 0) { + switch (marks.TAG) { case /* TSeq */0 : case /* TExp */1 : return ; @@ -1362,7 +1377,7 @@ function delta_2(marks, c, next_cat, prev_cat, l, rem) { function delta_seq(c, next_cat, prev_cat, kind, y, z, rem) { const marks = first((function (marks) { - switch (marks.TAG | 0) { + switch (marks.TAG) { case /* TSeq */0 : case /* TExp */1 : return ; @@ -1388,7 +1403,7 @@ function delta_4(c, next_cat, prev_cat, l, rem) { if (l) { let x = l.hd; let rem$1 = delta_4(c, next_cat, prev_cat, l.tl, rem); - switch (x.TAG | 0) { + switch (x.TAG) { case /* TSeq */0 : const y$p = delta_4(c, next_cat, prev_cat, x._0, /* [] */0); return delta_seq(c, next_cat, prev_cat, x._2, y$p, x._1, rem$1); @@ -1435,14 +1450,15 @@ function status(s) { let st$1; if (match) { const m = match.hd; - switch (m.TAG | 0) { + switch (m.TAG) { case /* TSeq */0 : case /* TExp */1 : st$1 = /* Running */1; break; case /* TMatch */2 : const m$1 = m._0; - st$1 = /* Match */{ + st$1 = { + TAG: /* Match */0, _0: flatten_match(m$1.marks), _1: m$1.pmarks }; @@ -1508,7 +1524,8 @@ const unknown_state = { function mk_state(ncol, desc) { const match = status(desc); - const break_state = typeof match === "number" && match ? false : true; + let break_state; + break_state = /* tag */(typeof match === "number" || typeof match === "string") && match !== /* Failed */0 ? false : true; return { idx: break_state ? -3 : desc.idx, real_idx: desc.idx, @@ -1748,10 +1765,10 @@ function trans_set(cache, cm, s) { function is_charset(_param) { while(true) { const param = _param; - if (typeof param === "number") { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } - switch (param.TAG | 0) { + switch (param.TAG) { case /* Set */0 : return true; case /* Sem */4 : @@ -1837,7 +1854,7 @@ function colorize(c, regexp) { const colorize$1 = function (_regexp) { while(true) { const regexp = _regexp; - if (typeof regexp === "number") { + if (/* tag */typeof regexp === "number" || typeof regexp === "string") { switch (regexp) { case /* Beg_of_line */0 : case /* End_of_line */1 : @@ -1863,7 +1880,7 @@ function colorize(c, regexp) { } } else { - switch (regexp.TAG | 0) { + switch (regexp.TAG) { case /* Set */0 : return split(regexp._0, c); case /* Sequence */1 : @@ -1921,60 +1938,92 @@ function equal$2(_x1, _x2) { while(true) { const x2 = _x2; const x1 = _x1; - if (typeof x1 === "number") { + if (/* tag */typeof x1 === "number" || typeof x1 === "string") { switch (x1) { case /* Beg_of_line */0 : - if (typeof x2 === "number" && !x2) { + if (/* tag */(typeof x2 === "number" || typeof x2 === "string") && x2 === /* Beg_of_line */0) { return true; } else { return false; } case /* End_of_line */1 : - return x2 === 1; + if (/* tag */(typeof x2 === "number" || typeof x2 === "string") && x2 === /* End_of_line */1) { + return true; + } else { + return false; + } case /* Beg_of_word */2 : - return x2 === 2; + if (/* tag */(typeof x2 === "number" || typeof x2 === "string") && x2 === /* Beg_of_word */2) { + return true; + } else { + return false; + } case /* End_of_word */3 : - return x2 === 3; + if (/* tag */(typeof x2 === "number" || typeof x2 === "string") && x2 === /* End_of_word */3) { + return true; + } else { + return false; + } case /* Not_bound */4 : - return x2 === 4; + if (/* tag */(typeof x2 === "number" || typeof x2 === "string") && x2 === /* Not_bound */4) { + return true; + } else { + return false; + } case /* Beg_of_str */5 : - return x2 === 5; + if (/* tag */(typeof x2 === "number" || typeof x2 === "string") && x2 === /* Beg_of_str */5) { + return true; + } else { + return false; + } case /* End_of_str */6 : - return x2 === 6; + if (/* tag */(typeof x2 === "number" || typeof x2 === "string") && x2 === /* End_of_str */6) { + return true; + } else { + return false; + } case /* Last_end_of_line */7 : - return x2 === 7; + if (/* tag */(typeof x2 === "number" || typeof x2 === "string") && x2 === /* Last_end_of_line */7) { + return true; + } else { + return false; + } case /* Start */8 : - return x2 === 8; + if (/* tag */(typeof x2 === "number" || typeof x2 === "string") && x2 === /* Start */8) { + return true; + } else { + return false; + } case /* Stop */9 : - if (typeof x2 === "number") { - return x2 >= 9; + if (/* tag */(typeof x2 === "number" || typeof x2 === "string") && x2 === /* Stop */9) { + return true; } else { return false; } } } else { - switch (x1.TAG | 0) { + switch (x1.TAG) { case /* Set */0 : - if (typeof x2 === "number" || x2.TAG !== /* Set */0) { + if (/* tag */typeof x2 === "number" || typeof x2 === "string" || x2.TAG !== /* Set */0) { return false; } else { return Caml_obj.caml_equal(x1._0, x2._0); } case /* Sequence */1 : - if (typeof x2 === "number" || x2.TAG !== /* Sequence */1) { + if (/* tag */typeof x2 === "number" || typeof x2 === "string" || x2.TAG !== /* Sequence */1) { return false; } else { return eq_list(x1._0, x2._0); } case /* Alternative */2 : - if (typeof x2 === "number" || x2.TAG !== /* Alternative */2) { + if (/* tag */typeof x2 === "number" || typeof x2 === "string" || x2.TAG !== /* Alternative */2) { return false; } else { return eq_list(x1._0, x2._0); } case /* Repeat */3 : - if (typeof x2 === "number") { + if (/* tag */typeof x2 === "number" || typeof x2 === "string") { return false; } if (x2.TAG !== /* Repeat */3) { @@ -1990,7 +2039,7 @@ function equal$2(_x1, _x2) { _x1 = x1._0; continue ; case /* Sem */4 : - if (typeof x2 === "number") { + if (/* tag */typeof x2 === "number" || typeof x2 === "string") { return false; } if (x2.TAG !== /* Sem */4) { @@ -2003,7 +2052,7 @@ function equal$2(_x1, _x2) { _x1 = x1._1; continue ; case /* Sem_greedy */5 : - if (typeof x2 === "number") { + if (/* tag */typeof x2 === "number" || typeof x2 === "string") { return false; } if (x2.TAG !== /* Sem_greedy */5) { @@ -2018,7 +2067,7 @@ function equal$2(_x1, _x2) { case /* Group */6 : return false; case /* No_group */7 : - if (typeof x2 === "number") { + if (/* tag */typeof x2 === "number" || typeof x2 === "string") { return false; } if (x2.TAG !== /* No_group */7) { @@ -2028,7 +2077,7 @@ function equal$2(_x1, _x2) { _x1 = x1._0; continue ; case /* Nest */8 : - if (typeof x2 === "number") { + if (/* tag */typeof x2 === "number" || typeof x2 === "string") { return false; } if (x2.TAG !== /* Nest */8) { @@ -2038,7 +2087,7 @@ function equal$2(_x1, _x2) { _x1 = x1._0; continue ; case /* Case */9 : - if (typeof x2 === "number") { + if (/* tag */typeof x2 === "number" || typeof x2 === "string") { return false; } if (x2.TAG !== /* Case */9) { @@ -2048,7 +2097,7 @@ function equal$2(_x1, _x2) { _x1 = x1._0; continue ; case /* No_case */10 : - if (typeof x2 === "number") { + if (/* tag */typeof x2 === "number" || typeof x2 === "string") { return false; } if (x2.TAG !== /* No_case */10) { @@ -2058,19 +2107,19 @@ function equal$2(_x1, _x2) { _x1 = x1._0; continue ; case /* Intersection */11 : - if (typeof x2 === "number" || x2.TAG !== /* Intersection */11) { + if (/* tag */typeof x2 === "number" || typeof x2 === "string" || x2.TAG !== /* Intersection */11) { return false; } else { return eq_list(x1._0, x2._0); } case /* Complement */12 : - if (typeof x2 === "number" || x2.TAG !== /* Complement */12) { + if (/* tag */typeof x2 === "number" || typeof x2 === "string" || x2.TAG !== /* Complement */12) { return false; } else { return eq_list(x1._0, x2._0); } case /* Difference */13 : - if (typeof x2 === "number") { + if (/* tag */typeof x2 === "number" || typeof x2 === "string") { return false; } if (x2.TAG !== /* Difference */13) { @@ -2083,7 +2132,7 @@ function equal$2(_x1, _x2) { _x1 = x1._1; continue ; case /* Pmark */14 : - if (typeof x2 === "number") { + if (/* tag */typeof x2 === "number" || typeof x2 === "string") { return false; } if (x2.TAG !== /* Pmark */14) { @@ -2142,8 +2191,8 @@ function merge_sequences(_param) { return /* [] */0; } const l$p = param.hd; - if (typeof l$p !== "number") { - switch (l$p.TAG | 0) { + if (!/* tag */(typeof l$p === "number" || typeof l$p === "string")) { + switch (l$p.TAG) { case /* Sequence */1 : const match = l$p._0; if (match) { @@ -2153,7 +2202,7 @@ function merge_sequences(_param) { let exit = 0; if (r$p) { const match$1 = r$p.hd; - if (typeof match$1 === "number" || match$1.TAG !== /* Sequence */1) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Sequence */1) { exit = 2; } else { const match$2 = match$1._0; @@ -2232,7 +2281,7 @@ function translate(ids, kind, _ign_group, ign_case, _greedy, pos, cache, c, _s) const s = _s; const greedy = _greedy; const ign_group = _ign_group; - if (typeof s === "number") { + if (/* tag */typeof s === "number" || typeof s === "string") { switch (s) { case /* Beg_of_line */0 : const c$1 = Curry._2(Re_automata_Category.$plus$plus, Re_automata_Category.inexistant, Re_automata_Category.newline); @@ -2345,7 +2394,7 @@ function translate(ids, kind, _ign_group, ign_case, _greedy, pos, cache, c, _s) } } else { - switch (s.TAG | 0) { + switch (s.TAG) { case /* Set */0 : return [ cst(ids, trans_set(cache, c, s._0)), @@ -2507,7 +2556,7 @@ function case_insens(s) { } function as_set(s) { - if (typeof s === "number") { + if (/* tag */typeof s === "number" || typeof s === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -2534,10 +2583,10 @@ function handle_case(_ign_case, _s) { while(true) { const s = _s; const ign_case = _ign_case; - if (typeof s === "number") { + if (/* tag */typeof s === "number" || typeof s === "string") { return s; } - switch (s.TAG | 0) { + switch (s.TAG) { case /* Set */0 : const s$1 = s._0; return { @@ -2672,7 +2721,7 @@ function handle_case(_ign_case, _s) { function anchored(_l) { while(true) { const l = _l; - if (typeof l === "number") { + if (/* tag */typeof l === "number" || typeof l === "string") { switch (l) { case /* Beg_of_str */5 : case /* Start */8 : @@ -2681,7 +2730,7 @@ function anchored(_l) { return false; } } else { - switch (l.TAG | 0) { + switch (l.TAG) { case /* Sequence */1 : return Stdlib__List.exists(anchored, l._0); case /* Alternative */2 : @@ -3178,14 +3227,15 @@ function exec_internal(name, posOpt, lenOpt, groups, re, s) { } res = match[1]; } - if (typeof res === "number") { - if (res) { - return /* Running */1; - } else { + if (/* tag */typeof res === "number" || typeof res === "string") { + if (res === /* Failed */0) { return /* Failed */0; + } else { + return /* Running */1; } } else { - return /* Match */{ + return { + TAG: /* Match */0, _0: { s: s, marks: res._0, @@ -4102,12 +4152,17 @@ function re(flagsOpt, pat) { function exec(rex, pos, s) { let len; const substr = exec_internal("Re.exec", pos, len, true, rex, s); - if (typeof substr === "number") { + if (!/* tag */(typeof substr === "number" || typeof substr === "string")) { + return substr._0; + } + if (substr === /* Failed */0) { throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { MEL_EXN_ID: Stdlib.Not_found }); } - return substr._0; + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } const s = Caml_bytes.bytes_to_string(Stdlib__Bytes.make(1048575, /* 'a' */97)) + "b"; diff --git a/jscomp/test/dist/jscomp/test/ocaml_typedtree_test.js b/jscomp/test/dist/jscomp/test/ocaml_typedtree_test.js index ae77c2314f..99e75c1c5e 100644 --- a/jscomp/test/dist/jscomp/test/ocaml_typedtree_test.js +++ b/jscomp/test/dist/jscomp/test/ocaml_typedtree_test.js @@ -388,7 +388,7 @@ function ansi_of_color(param) { } function code_of_style(c) { - if (typeof c !== "number") { + if (!/* tag */(typeof c === "number" || typeof c === "string")) { if (c.TAG === /* FG */0) { return "3" + ansi_of_color(c._0); } else { @@ -611,7 +611,7 @@ const Misc_Color = { }; function number(param) { - if (typeof param === "number") { + if (/* tag */typeof param === "number" || typeof param === "string") { switch (param) { case /* Comment_start */0 : return 1; @@ -650,7 +650,7 @@ function number(param) { } } else { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Deprecated */0 : return 3; case /* Fragile_match */1 : @@ -1094,7 +1094,7 @@ parse_options(false, "+a-4-6-7-9-27-29-32..39-41..42-44-45-48-50-102"); parse_options(true, "-a"); function message(s) { - if (typeof s === "number") { + if (/* tag */typeof s === "number" || typeof s === "string") { switch (s) { case /* Comment_start */0 : return "this is the start of a comment."; @@ -1133,7 +1133,7 @@ function message(s) { } } else { - switch (s.TAG | 0) { + switch (s.TAG) { case /* Deprecated */0 : return "deprecated: " + s._0; case /* Fragile_match */1 : @@ -1222,7 +1222,8 @@ function message(s) { case /* Unused_var_strict */13 : return "unused variable " + (s._0 + "."); case /* Duplicate_definitions */14 : - return Curry._4(Stdlib__Printf.sprintf(/* Format */{ + return Curry._4(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "the ", @@ -1263,7 +1264,8 @@ function message(s) { _1: "the %s %s is defined in both types %s and %s." }), s._0, s._1, s._2, s._3); case /* Multiple_definition */15 : - return Curry._3(Stdlib__Printf.sprintf(/* Format */{ + return Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "files ", @@ -1359,7 +1361,8 @@ function message(s) { case /* Nonoptional_label */26 : return "the label " + (s._0 + " is not optional."); case /* Open_shadow_identifier */27 : - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "this open statement shadows the ", @@ -1384,7 +1387,8 @@ function message(s) { _1: "this open statement shadows the %s identifier %s (which is later used)" }), s._0, s._1); case /* Open_shadow_label_constructor */28 : - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "this open statement shadows the ", @@ -1409,7 +1413,8 @@ function message(s) { _1: "this open statement shadows the %s %s (which is later used)" }), s._0, s._1); case /* Bad_env_variable */29 : - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "illegal environment variable ", @@ -1430,7 +1435,8 @@ function message(s) { _1: "illegal environment variable %s : %s" }), s._0, s._1); case /* Attribute_payload */30 : - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "illegal payload for attribute '", @@ -1452,7 +1458,8 @@ function message(s) { }), s._0, s._1); case /* Eliminated_optional_arguments */31 : const sl = s._0; - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "implicit elimination of optional argument", @@ -1498,7 +1505,8 @@ const nerrors = { function print(ppf, w) { const msg = message(w); const num = number(w); - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -1664,7 +1672,8 @@ function highlight_dumb(ppf, lb, loc) { } } - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Characters ", @@ -1725,7 +1734,8 @@ function highlight_dumb(ppf, lb, loc) { } else { if (line === line_start && line === line_end) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: /* Flush_newline */4, @@ -1745,7 +1755,8 @@ function highlight_dumb(ppf, lb, loc) { } } if (line >= line_start && line <= line_end) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: /* Flush_newline */4, @@ -1767,42 +1778,41 @@ function highlight_dumb(ppf, lb, loc) { function highlight_locations(ppf, locs) { while(true) { const num_lines = status.contents; - if (typeof num_lines === "number") { - if (num_lines) { - const lb = input_lexbuf.contents; - if (lb === undefined) { - return false; - } - let norepeat; - try { - norepeat = Caml_sys.caml_sys_getenv("TERM") === "norepeat"; - } - catch (raw_exn){ - const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); - if (exn.MEL_EXN_ID === Stdlib.Not_found) { - norepeat = false; - } else { - throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); - } + if (/* tag */typeof num_lines === "number" || typeof num_lines === "string") { + if (num_lines === /* Uninitialised */0) { + status.contents = Caml_external_polyfill.resolve("caml_terminfo_setup")(Stdlib.stdout); + continue ; + } + const lb = input_lexbuf.contents; + if (lb === undefined) { + return false; + } + let norepeat; + try { + norepeat = Caml_sys.caml_sys_getenv("TERM") === "norepeat"; + } + catch (raw_exn){ + const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); + if (exn.MEL_EXN_ID === Stdlib.Not_found) { + norepeat = false; + } else { + throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } - if (norepeat) { + } + if (norepeat) { + return false; + } + const loc1 = Stdlib__List.hd(locs); + try { + highlight_dumb(ppf, lb, loc1); + return true; + } + catch (raw_exn$1){ + const exn$1 = Caml_js_exceptions.internalToOCamlException(raw_exn$1); + if (exn$1.MEL_EXN_ID === Stdlib.Exit) { return false; } - const loc1 = Stdlib__List.hd(locs); - try { - highlight_dumb(ppf, lb, loc1); - return true; - } - catch (raw_exn$1){ - const exn$1 = Caml_js_exceptions.internalToOCamlException(raw_exn$1); - if (exn$1.MEL_EXN_ID === Stdlib.Exit) { - return false; - } - throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); - } - } else { - status.contents = Caml_external_polyfill.resolve("caml_terminfo_setup")(Stdlib.stdout); - continue ; + throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); } } else { const lb$1 = input_lexbuf.contents; @@ -1853,7 +1863,8 @@ function show_filename(file) { } function print_filename(ppf, file) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1885,7 +1896,8 @@ function print_loc(ppf, loc) { })) { return ; } else { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Characters ", @@ -1911,7 +1923,8 @@ function print_loc(ppf, loc) { }), loc.loc_start.pos_cnum, loc.loc_end.pos_cnum); } } else { - Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1919,7 +1932,8 @@ function print_loc(ppf, loc) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_tag */0, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -1947,7 +1961,8 @@ function print_loc(ppf, loc) { _1: "%s@{%a%s%i" }), "File \"", print_filename, file, "\", line ", match[1]); if (startchar$1 >= 0) { - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1972,7 +1987,8 @@ function print_loc(ppf, loc) { _1: "%s%i%s%i" }), ", characters ", startchar$1, "-", endchar); } - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: /* Close_tag */1, @@ -1991,12 +2007,14 @@ function print$1(ppf, loc) { })) { return ; } else { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_tag */0, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -2032,12 +2050,14 @@ const error_prefix = "Error"; function print_error(ppf, loc) { print$1(ppf, loc); Curry._1(Misc_Color.setup, color.contents); - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_tag */0, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -2068,12 +2088,14 @@ function default_warning_printer(loc, ppf, w) { if (is_active(w)) { Curry._1(Misc_Color.setup, color.contents); print$1(ppf, loc); - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_tag */0, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -2206,7 +2228,8 @@ function register_error_of_exn(f) { } function error_of_printer(loc, print, x) { - return Curry._2(errorf(loc, undefined, undefined, /* Format */{ + return Curry._2(errorf(loc, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -2225,7 +2248,8 @@ function error_of_printer_file(print, x) { register_error_of_exn(function (msg) { if (msg.MEL_EXN_ID === Stdlib.Sys_error) { - return Curry._1(errorf(in_file(input_name.contents), undefined, undefined, /* Format */{ + return Curry._1(errorf(in_file(input_name.contents), undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "I/O error: ", @@ -2238,7 +2262,8 @@ register_error_of_exn(function (msg) { _1: "I/O error: %s" }), msg._1); } else if (msg.MEL_EXN_ID === Errors) { - return Curry._1(errorf(in_file(input_name.contents), undefined, undefined, /* Format */{ + return Curry._1(errorf(in_file(input_name.contents), undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Some fatal warnings were triggered (", @@ -2333,7 +2358,8 @@ function print$2(ppf, i) { const n = i.stamp; if (n !== -1) { if (n !== 0) { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -2356,7 +2382,8 @@ function print$2(ppf, i) { _1: "%s/%i%s" }), i.name, n, $$global(i) ? "g" : ""); } else { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -2370,7 +2397,8 @@ function print$2(ppf, i) { }), i.name); } } else { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -2386,9 +2414,12 @@ function print$2(ppf, i) { } function mknode(l, d, r) { - const hl = l ? l._3 : 0; - const hr = r ? r._3 : 0; - return /* Node */{ + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l._3; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r._3; + return { + TAG: /* Node */0, _0: l, _1: d, _2: r, @@ -2397,23 +2428,12 @@ function mknode(l, d, r) { } function balance(l, d, r) { - const hl = l ? l._3 : 0; - const hr = r ? r._3 : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l._3; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r._3; if (hl > (hr + 1 | 0)) { - if (l) { - const lr = l._2; - const ld = l._1; - const ll = l._0; - if (( - ll ? ll._3 : 0 - ) >= ( - lr ? lr._3 : 0 - )) { - return mknode(ll, ld, mknode(lr, d, r)); - } - if (lr) { - return mknode(mknode(ll, ld, lr._0), lr._1, mknode(lr._2, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -2423,6 +2443,19 @@ function balance(l, d, r) { ] }); } + const lr = l._2; + const ld = l._1; + const ll = l._0; + let tmp; + tmp = /* tag */typeof ll === "number" || typeof ll === "string" ? 0 : ll._3; + let tmp$1; + tmp$1 = /* tag */typeof lr === "number" || typeof lr === "string" ? 0 : lr._3; + if (tmp >= tmp$1) { + return mknode(ll, ld, mknode(lr, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return mknode(mknode(ll, ld, lr._0), lr._1, mknode(lr._2, d, r)); + } throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -2431,21 +2464,30 @@ function balance(l, d, r) { 11 ] }); - } - if (hr <= (hl + 1 | 0)) { - return mknode(l, d, r); - } - if (r) { + } else { + if (hr <= (hl + 1 | 0)) { + return mknode(l, d, r); + } + if (/* tag */typeof r === "number" || typeof r === "string") { + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/test/ocaml_typedtree_test.ml", + 2790, + 11 + ] + }); + } const rl = r._0; const rr = r._2; - if (( - rr ? rr._3 : 0 - ) >= ( - rl ? rl._3 : 0 - )) { + let tmp$2; + tmp$2 = /* tag */typeof rr === "number" || typeof rr === "string" ? 0 : rr._3; + let tmp$3; + tmp$3 = /* tag */typeof rl === "number" || typeof rl === "string" ? 0 : rl._3; + if (tmp$2 >= tmp$3) { return mknode(mknode(l, d, rl), r._1, rr); } - if (rl) { + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { return mknode(mknode(l, d, rl._0), rl._1, mknode(rl._2, r._1, r._2)); } throw new Caml_js_exceptions.MelangeError("Assert_failure", { @@ -2457,19 +2499,12 @@ function balance(l, d, r) { ] }); } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/test/ocaml_typedtree_test.ml", - 2790, - 11 - ] - }); } function add(id, data, param) { - if (!param) { - return /* Node */{ + if (/* tag */typeof param === "number" || typeof param === "string") { + return { + TAG: /* Node */0, _0: /* Empty */0, _1: { ident: id, @@ -2485,7 +2520,8 @@ function add(id, data, param) { const l = param._0; const c = Caml.caml_string_compare(id.name, k.ident.name); if (c === 0) { - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: { ident: id, @@ -2505,54 +2541,54 @@ function add(id, data, param) { function find_same(id, _param) { while(true) { const param = _param; - if (param) { - const k = param._1; - const c = Caml.caml_string_compare(id.name, k.ident.name); - if (c === 0) { - if (id.stamp === k.ident.stamp) { - return k.data; - } else { - let s = id.stamp; - let _k = k.previous; - while(true) { - const k$1 = _k; - if (k$1 !== undefined) { - if (k$1.ident.stamp === s) { - return k$1.data; - } - _k = k$1.previous; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const k = param._1; + const c = Caml.caml_string_compare(id.name, k.ident.name); + if (c === 0) { + if (id.stamp === k.ident.stamp) { + return k.data; + } else { + let s = id.stamp; + let _k = k.previous; + while(true) { + const k$1 = _k; + if (k$1 !== undefined) { + if (k$1.ident.stamp === s) { + return k$1.data; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); - }; - } + _k = k$1.previous; + continue ; + } + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + }; } - _param = c < 0 ? param._0 : param._2; - continue ; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = c < 0 ? param._0 : param._2; + continue ; }; } function find_name(name, _param) { while(true) { const param = _param; - if (param) { - const k = param._1; - const c = Caml.caml_string_compare(name, k.ident.name); - if (c === 0) { - return k.data; - } - _param = c < 0 ? param._0 : param._2; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const k = param._1; + const c = Caml.caml_string_compare(name, k.ident.name); + if (c === 0) { + return k.data; + } + _param = c < 0 ? param._0 : param._2; + continue ; }; } @@ -2570,7 +2606,7 @@ function get_all(k) { function find_all(name, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* [] */0; } const k = param._1; @@ -2589,7 +2625,7 @@ function find_all(name, _param) { function iter(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const k = param._1; @@ -2604,9 +2640,9 @@ function same(_p1, _p2) { while(true) { const p2 = _p2; const p1 = _p1; - switch (p1.TAG | 0) { + switch (p1.TAG) { case /* Pident */0 : - switch (p2.TAG | 0) { + switch (p2.TAG) { case /* Pident */0 : return Caml_obj.caml_equal(p1._0, p2._0); case /* Pdot */1 : @@ -2615,7 +2651,7 @@ function same(_p1, _p2) { } case /* Pdot */1 : - switch (p2.TAG | 0) { + switch (p2.TAG) { case /* Pdot */1 : if (p1._1 !== p2._1) { return false; @@ -2629,7 +2665,7 @@ function same(_p1, _p2) { } case /* Papply */2 : - switch (p2.TAG | 0) { + switch (p2.TAG) { case /* Pident */0 : case /* Pdot */1 : return false; @@ -2650,7 +2686,7 @@ function same(_p1, _p2) { function isfree(id, _id$p) { while(true) { const id$p = _id$p; - switch (id$p.TAG | 0) { + switch (id$p.TAG) { case /* Pident */0 : return Caml_obj.caml_equal(id, id$p._0); case /* Pdot */1 : @@ -2670,7 +2706,7 @@ function isfree(id, _id$p) { function binding_time(_id) { while(true) { const id = _id; - switch (id.TAG | 0) { + switch (id.TAG) { case /* Pident */0 : return id._0.stamp; case /* Pdot */1 : @@ -2689,7 +2725,7 @@ function kfalse(x) { function name(parenOpt, id) { const paren = parenOpt !== undefined ? parenOpt : kfalse; - switch (id.TAG | 0) { + switch (id.TAG) { case /* Pident */0 : return id._0.name; case /* Pdot */1 : @@ -2706,7 +2742,7 @@ function name(parenOpt, id) { function head(_id) { while(true) { const id = _id; - switch (id.TAG | 0) { + switch (id.TAG) { case /* Pident */0 : return id._0; case /* Pdot */1 : @@ -2729,7 +2765,7 @@ function head(_id) { function last(_id) { while(true) { const id = _id; - switch (id.TAG | 0) { + switch (id.TAG) { case /* Pident */0 : return id._0.name; case /* Pdot */1 : @@ -2746,7 +2782,7 @@ function flat(_accu, _s) { while(true) { const s = _s; const accu = _accu; - switch (s.TAG | 0) { + switch (s.TAG) { case /* Lident */0 : return { hd: s._0, @@ -2771,7 +2807,7 @@ function flatten(lid) { } function last$1(s) { - switch (s.TAG | 0) { + switch (s.TAG) { case /* Lident */0 : return s._0; case /* Ldot */1 : @@ -2893,17 +2929,18 @@ const OrderedString = { }; function height(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$1(l, x, d, r) { const hl = height(l); const hr = height(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -2913,7 +2950,8 @@ function create$1(l, x, d, r) { } function singleton(x, d) { - return /* Node */{ + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: d, @@ -2923,32 +2961,35 @@ function singleton(x, d) { } function bal(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height(ll) >= height(lr)) { - return create$1(ll, lv, ld, create$1(lr, x, d, r)); - } - if (lr) { - return create$1(create$1(ll, lv, ld, lr.l), lr.v, lr.d, create$1(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height(ll) >= height(lr)) { + return create$1(ll, lv, ld, create$1(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$1(create$1(ll, lv, ld, lr.l), lr.v, lr.d, create$1(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -2956,22 +2997,22 @@ function bal(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height(rr) >= height(rl)) { - return create$1(create$1(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create$1(create$1(l, x, d, rl.l), rl.v, rl.d, create$1(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height(rr) >= height(rl)) { + return create$1(create$1(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$1(create$1(l, x, d, rl.l), rl.v, rl.d, create$1(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -2979,16 +3020,17 @@ function bal(l, x, d, r) { } function is_empty(param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } } function add$1(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -3005,7 +3047,8 @@ function add$1(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -3033,63 +3076,63 @@ function add$1(x, data, m) { function find(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(OrderedString.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(OrderedString.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } function find_first(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _d0 = param.d; - let _param$1 = param.l; - while(true) { - const param$1 = _param$1; - const d0 = _d0; - const v0 = _v0; - if (!param$1) { - return [ - v0, - d0 - ]; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.l; - _d0 = param$1.d; - _v0 = v$1; - continue ; - } - _param$1 = param$1.r; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _d0 = param.d; + let _param$1 = param.l; + while(true) { + const param$1 = _param$1; + const d0 = _d0; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return [ + v0, + d0 + ]; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.l; + _d0 = param$1.d; + _v0 = v$1; continue ; - }; - } - _param = param.r; - continue ; + } + _param$1 = param$1.r; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.r; + continue ; }; } function find_first_opt(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -3101,7 +3144,7 @@ function find_first_opt(f, _param) { const param$1 = _param$1; const d0 = _d0; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return [ v0, d0 @@ -3126,46 +3169,46 @@ function find_first_opt(f, _param) { function find_last(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _d0 = param.d; - let _param$1 = param.r; - while(true) { - const param$1 = _param$1; - const d0 = _d0; - const v0 = _v0; - if (!param$1) { - return [ - v0, - d0 - ]; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.r; - _d0 = param$1.d; - _v0 = v$1; - continue ; - } - _param$1 = param$1.l; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _d0 = param.d; + let _param$1 = param.r; + while(true) { + const param$1 = _param$1; + const d0 = _d0; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return [ + v0, + d0 + ]; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.r; + _d0 = param$1.d; + _v0 = v$1; continue ; - }; - } - _param = param.l; - continue ; + } + _param$1 = param$1.l; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.l; + continue ; }; } function find_last_opt(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -3177,7 +3220,7 @@ function find_last_opt(f, _param) { const param$1 = _param$1; const d0 = _d0; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return [ v0, d0 @@ -3202,7 +3245,7 @@ function find_last_opt(f, _param) { function find_opt(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const c = Curry._2(OrderedString.compare, x, param.v); @@ -3217,7 +3260,7 @@ function find_opt(x, _param) { function mem(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(OrderedString.compare, x, param.v); @@ -3232,31 +3275,31 @@ function mem(x, _param) { function min_binding(_param) { while(true) { const param = _param; - if (param) { - const l = param.l; - if (!l) { - return [ - param.v, - param.d - ]; - } - _param = l; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return [ + param.v, + param.d + ]; + } + _param = l; + continue ; }; } function min_binding_opt(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const l = param.l; - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return [ param.v, param.d @@ -3270,29 +3313,31 @@ function min_binding_opt(_param) { function max_binding(_param) { while(true) { const param = _param; - if (param) { - if (!param.r) { - return [ - param.v, - param.d - ]; - } - _param = param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return [ + param.v, + param.d + ]; + } + _param = param.r; + continue ; }; } function max_binding_opt(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } - if (!param.r) { + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { return [ param.v, param.d @@ -3304,25 +3349,25 @@ function max_binding_opt(_param) { } function remove_min_binding(param) { - if (param) { - const l = param.l; - if (l) { - return bal(remove_min_binding(l), param.v, param.d, param.r); - } else { - return param.r; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Invalid_argument", { + MEL_EXN_ID: "Invalid_argument", + _1: "Map.remove_min_elt" + }); + } + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param.r; + } else { + return bal(remove_min_binding(l), param.v, param.d, param.r); } - throw new Caml_js_exceptions.MelangeError("Invalid_argument", { - MEL_EXN_ID: "Invalid_argument", - _1: "Map.remove_min_elt" - }); } function merge(t1, t2) { - if (!t1) { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; } - if (!t2) { + if (/* tag */typeof t2 === "number" || typeof t2 === "string") { return t1; } const match = min_binding(t2); @@ -3330,7 +3375,7 @@ function merge(t1, t2) { } function remove(x, m) { - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return /* Empty */0; } const r = m.r; @@ -3358,56 +3403,58 @@ function remove(x, m) { } function update(x, f, m) { - if (m) { - const r = m.r; - const d = m.d; - const v = m.v; - const l = m.l; - const c = Curry._2(OrderedString.compare, x, v); - if (c === 0) { - const data = Curry._1(f, Caml_option.some(d)); - if (data === undefined) { - return merge(l, r); - } - const data$1 = Caml_option.valFromOption(data); - if (d === data$1) { - return m; - } else { - return /* Node */{ - l: l, - v: x, - d: data$1, - r: r, - h: m.h - }; - } + if (/* tag */typeof m === "number" || typeof m === "string") { + const data = Curry._1(f, undefined); + if (data !== undefined) { + return { + TAG: /* Node */0, + l: /* Empty */0, + v: x, + d: Caml_option.valFromOption(data), + r: /* Empty */0, + h: 1 + }; + } else { + return /* Empty */0; } - if (c < 0) { - const ll = update(x, f, l); - if (l === ll) { - return m; - } else { - return bal(ll, v, d, r); - } + } + const r = m.r; + const d = m.d; + const v = m.v; + const l = m.l; + const c = Curry._2(OrderedString.compare, x, v); + if (c === 0) { + const data$1 = Curry._1(f, Caml_option.some(d)); + if (data$1 === undefined) { + return merge(l, r); } - const rr = update(x, f, r); - if (r === rr) { + const data$2 = Caml_option.valFromOption(data$1); + if (d === data$2) { return m; } else { - return bal(l, v, d, rr); + return { + TAG: /* Node */0, + l: l, + v: x, + d: data$2, + r: r, + h: m.h + }; } } - const data$2 = Curry._1(f, undefined); - if (data$2 !== undefined) { - return /* Node */{ - l: /* Empty */0, - v: x, - d: Caml_option.valFromOption(data$2), - r: /* Empty */0, - h: 1 - }; + if (c < 0) { + const ll = update(x, f, l); + if (l === ll) { + return m; + } else { + return bal(ll, v, d, r); + } + } + const rr = update(x, f, r); + if (r === rr) { + return m; } else { - return /* Empty */0; + return bal(l, v, d, rr); } } @@ -3431,7 +3478,7 @@ function add_to_list(x, data, m) { function iter$1(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } iter$1(f, param.l); @@ -3442,13 +3489,14 @@ function iter$1(f, _param) { } function map(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const l$p = map(f, param.l); const d$p = Curry._1(f, param.d); const r$p = map(f, param.r); - return /* Node */{ + return { + TAG: /* Node */0, l: l$p, v: param.v, d: d$p, @@ -3458,14 +3506,15 @@ function map(f, param) { } function mapi(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param.v; const l$p = mapi(f, param.l); const d$p = Curry._2(f, v, param.d); const r$p = mapi(f, param.r); - return /* Node */{ + return { + TAG: /* Node */0, l: l$p, v: v, d: d$p, @@ -3478,7 +3527,7 @@ function fold(f, _m, _accu) { while(true) { const accu = _accu; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return accu; } _accu = Curry._3(f, m.v, m.d, fold(f, m.l, accu)); @@ -3490,7 +3539,7 @@ function fold(f, _m, _accu) { function for_all(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; } if (!Curry._2(p, param.v, param.d)) { @@ -3507,7 +3556,7 @@ function for_all(p, _param) { function exists(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } if (Curry._2(p, param.v, param.d)) { @@ -3522,30 +3571,30 @@ function exists(p, _param) { } function add_min_binding(k, x, param) { - if (param) { - return bal(add_min_binding(k, x, param.l), param.v, param.d, param.r); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(k, x); + } else { + return bal(add_min_binding(k, x, param.l), param.v, param.d, param.r); } } function add_max_binding(k, x, param) { - if (param) { - return bal(param.l, param.v, param.d, add_max_binding(k, x, param.r)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(k, x); + } else { + return bal(param.l, param.v, param.d, add_max_binding(k, x, param.r)); } } function join(l, v, d, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_binding(v, d, r); } - if (!r) { + const lh = l.h; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_binding(v, d, l); } const rh = r.h; - const lh = l.h; if (lh > (rh + 2 | 0)) { return bal(l.l, l.v, l.d, join(l.r, v, d, r)); } else if (rh > (lh + 2 | 0)) { @@ -3556,10 +3605,10 @@ function join(l, v, d, r) { } function concat(t1, t2) { - if (!t1) { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; } - if (!t2) { + if (/* tag */typeof t2 === "number" || typeof t2 === "string") { return t1; } const match = min_binding(t2); @@ -3575,7 +3624,7 @@ function concat_or_join(t1, v, d, t2) { } function split(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, undefined, @@ -3611,42 +3660,45 @@ function split(x, param) { } function merge$1(f, s1, s2) { - if (s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + return /* Empty */0; + } + + } else { const v1 = s1.v; if (s1.h >= height(s2)) { const match = split(v1, s2); return concat_or_join(merge$1(f, s1.l, match[0]), v1, Curry._3(f, v1, Caml_option.some(s1.d), match[1]), merge$1(f, s1.r, match[2])); } - } else if (!s2) { - return /* Empty */0; } - if (s2) { - const v2 = s2.v; - const match$1 = split(v2, s1); - return concat_or_join(merge$1(f, match$1[0], s2.l), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2.d)), merge$1(f, match$1[2], s2.r)); + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/stdlib/map.ml", + 408, + 10 + ] + }); } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/stdlib/map.ml", - 408, - 10 - ] - }); + const v2 = s2.v; + const match$1 = split(v2, s1); + return concat_or_join(merge$1(f, match$1[0], s2.l), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2.d)), merge$1(f, match$1[2], s2.r)); } function union(f, s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return s2; } - if (!s2) { + const d1 = s1.d; + const v1 = s1.v; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const d2 = s2.d; const v2 = s2.v; - const d1 = s1.d; - const v1 = s1.v; if (s1.h >= s2.h) { const match = split(v1, s2); const d2$1 = match[1]; @@ -3670,7 +3722,7 @@ function union(f, s1, s2) { } function filter(p, m) { - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return /* Empty */0; } const r = m.r; @@ -3692,7 +3744,7 @@ function filter(p, m) { } function filter_map(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param.v; @@ -3707,7 +3759,7 @@ function filter_map(f, param) { } function partition(p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, /* Empty */0 @@ -3739,10 +3791,11 @@ function cons_enum(_m, _e) { while(true) { const e = _e; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: m.v, _1: m.d, _2: m.r, @@ -3759,14 +3812,14 @@ function compare$2(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return -1; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 0; + } else { + return -1; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 1; } const c = Curry._2(OrderedString.compare, e1._0, e2._0); @@ -3789,14 +3842,14 @@ function equal$2(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return false; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return true; + } else { + return false; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return false; } if (Curry._2(OrderedString.compare, e1._0, e2._0) !== 0) { @@ -3812,10 +3865,10 @@ function equal$2(cmp, m1, m2) { } function cardinal(param) { - if (param) { - return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; } } @@ -3823,7 +3876,7 @@ function bindings_aux(_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param.l; @@ -3859,11 +3912,12 @@ function of_seq(i) { } function seq_of_enum_(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = cons_enum(c._2, c._3); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: [ c._0, c._1 @@ -3885,10 +3939,11 @@ function snoc_enum(_s, _e) { while(true) { const e = _e; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: s.v, _1: s.d, _2: s.l, @@ -3900,11 +3955,12 @@ function snoc_enum(_s, _e) { } function rev_seq_of_enum_(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = snoc_enum(c._2, c._3); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: [ c._0, c._1 @@ -3927,7 +3983,7 @@ function to_seq_from(low, m) { while(true) { const c = _c; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return c; } const r = m.r; @@ -3935,7 +3991,8 @@ function to_seq_from(low, m) { const v = m.v; const n = Curry._2(OrderedString.compare, v, low); if (n === 0) { - return /* More */{ + return { + TAG: /* More */0, _0: v, _1: d, _2: r, @@ -3946,7 +4003,8 @@ function to_seq_from(low, m) { _m = r; continue ; } - _c = /* More */{ + _c = { + TAG: /* More */0, _0: v, _1: d, _2: r, @@ -4081,17 +4139,20 @@ function get_lower(v) { } function height$1(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$2(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; - return /* Node */{ + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; + return { + TAG: /* Node */0, l: l, v: v, r: r, @@ -4100,52 +4161,55 @@ function create$2(l, v, r) { } function bal$1(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const lv = l.v; - const ll = l.l; - if (height$1(ll) >= height$1(lr)) { - return create$2(ll, lv, create$2(lr, v, r)); - } - if (lr) { - return create$2(create$2(ll, lv, lr.l), lr.v, create$2(lr.r, v, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const lr = l.r; + const lv = l.v; + const ll = l.l; + if (height$1(ll) >= height$1(lr)) { + return create$2(ll, lv, create$2(lr, v, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$2(create$2(ll, lv, lr.l), lr.v, create$2(lr.r, v, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: v, r: r, h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rv = r.v; - const rl = r.l; - if (height$1(rr) >= height$1(rl)) { - return create$2(create$2(l, v, rl), rv, rr); - } - if (rl) { - return create$2(create$2(l, v, rl.l), rl.v, create$2(rl.r, rv, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const rr = r.r; + const rv = r.v; + const rl = r.l; + if (height$1(rr) >= height$1(rl)) { + return create$2(create$2(l, v, rl), rv, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$2(create$2(l, v, rl.l), rl.v, create$2(rl.r, rv, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" @@ -4153,8 +4217,9 @@ function bal$1(l, v, r) { } function add$2(x, t) { - if (!t) { - return /* Node */{ + if (/* tag */typeof t === "number" || typeof t === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -4185,7 +4250,8 @@ function add$2(x, t) { } function singleton$1(x) { - return /* Node */{ + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -4194,30 +4260,30 @@ function singleton$1(x) { } function add_min_element(x, param) { - if (param) { - return bal$1(add_min_element(x, param.l), param.v, param.r); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton$1(x); + } else { + return bal$1(add_min_element(x, param.l), param.v, param.r); } } function add_max_element(x, param) { - if (param) { - return bal$1(param.l, param.v, add_max_element(x, param.r)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton$1(x); + } else { + return bal$1(param.l, param.v, add_max_element(x, param.r)); } } function join$1(l, v, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_element(v, r); } - if (!r) { + const lh = l.h; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_element(v, l); } const rh = r.h; - const lh = l.h; if (lh > (rh + 2 | 0)) { return bal$1(l.l, l.v, join$1(l.r, v, r)); } else if (rh > (lh + 2 | 0)) { @@ -4230,49 +4296,47 @@ function join$1(l, v, r) { function min_elt(_param) { while(true) { const param = _param; - if (param) { - const l = param.l; - if (!l) { - return param.v; - } - _param = l; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param.v; + } + _param = l; + continue ; }; } function remove_min_elt(param) { - if (param) { - const l = param.l; - if (l) { - return bal$1(remove_min_elt(l), param.v, param.r); - } else { - return param.r; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Invalid_argument", { + MEL_EXN_ID: "Invalid_argument", + _1: "Set.remove_min_elt" + }); + } + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param.r; + } else { + return bal$1(remove_min_elt(l), param.v, param.r); } - throw new Caml_js_exceptions.MelangeError("Invalid_argument", { - MEL_EXN_ID: "Invalid_argument", - _1: "Set.remove_min_elt" - }); } function concat$1(t1, t2) { - if (t1) { - if (t2) { - return join$1(t1, min_elt(t2), remove_min_elt(t2)); - } else { - return t1; - } - } else { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; + } else if (/* tag */typeof t2 === "number" || typeof t2 === "string") { + return t1; + } else { + return join$1(t1, min_elt(t2), remove_min_elt(t2)); } } function split$1(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, false, @@ -4307,17 +4371,17 @@ function split$1(x, param) { } function is_empty$1(param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } } function mem$2(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(OrderedString.compare, x, param.v); @@ -4330,16 +4394,16 @@ function mem$2(x, _param) { } function union$2(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return s2; } - if (!s2) { + const h1 = s1.h; + const v1 = s1.v; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const h2 = s2.h; const v2 = s2.v; - const h1 = s1.h; - const v1 = s1.v; if (h1 >= h2) { if (h2 === 1) { return add$2(v2, s1); @@ -4355,10 +4419,10 @@ function union$2(s1, s2) { } function inter$1(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return /* Empty */0; } - if (!s2) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return /* Empty */0; } const r1 = s1.r; @@ -4374,10 +4438,10 @@ function inter$1(s1, s2) { } function diff(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return /* Empty */0; } - if (!s2) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const r1 = s1.r; @@ -4396,10 +4460,11 @@ function cons_enum$1(_s, _e) { while(true) { const e = _e; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: s.v, _1: s.r, _2: e @@ -4415,14 +4480,14 @@ function compare$3(s1, s2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return -1; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 0; + } else { + return -1; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 1; } const c = Curry._2(OrderedString.compare, e1._0, e2._0); @@ -4443,7 +4508,7 @@ function fold$1(f, _s, _accu) { while(true) { const accu = _accu; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return accu; } _accu = Curry._2(f, s.v, fold$1(f, s.l, accu)); @@ -4456,7 +4521,7 @@ function elements_aux(_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param.l; @@ -4473,9 +4538,9 @@ function elements(s) { } function equal_tag(t1, t2) { - switch (t1.TAG | 0) { + switch (t1.TAG) { case /* Cstr_constant */0 : - switch (t2.TAG | 0) { + switch (t2.TAG) { case /* Cstr_constant */0 : return t2._0 === t1._0; case /* Cstr_block */1 : @@ -4484,7 +4549,7 @@ function equal_tag(t1, t2) { } case /* Cstr_block */1 : - switch (t2.TAG | 0) { + switch (t2.TAG) { case /* Cstr_block */1 : return t2._0 === t1._0; case /* Cstr_constant */0 : @@ -4493,7 +4558,7 @@ function equal_tag(t1, t2) { } case /* Cstr_extension */2 : - switch (t2.TAG | 0) { + switch (t2.TAG) { case /* Cstr_constant */0 : case /* Cstr_block */1 : return false; @@ -4533,17 +4598,20 @@ const Types_Variance = { const funarg = Types_TypeOps; function height$2(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$3(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; - return /* Node */{ + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; + return { + TAG: /* Node */0, l: l, v: v, r: r, @@ -4552,52 +4620,55 @@ function create$3(l, v, r) { } function bal$2(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const lv = l.v; - const ll = l.l; - if (height$2(ll) >= height$2(lr)) { - return create$3(ll, lv, create$3(lr, v, r)); - } - if (lr) { - return create$3(create$3(ll, lv, lr.l), lr.v, create$3(lr.r, v, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const lr = l.r; + const lv = l.v; + const ll = l.l; + if (height$2(ll) >= height$2(lr)) { + return create$3(ll, lv, create$3(lr, v, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$3(create$3(ll, lv, lr.l), lr.v, create$3(lr.r, v, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: v, r: r, h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rv = r.v; - const rl = r.l; - if (height$2(rr) >= height$2(rl)) { - return create$3(create$3(l, v, rl), rv, rr); - } - if (rl) { - return create$3(create$3(l, v, rl.l), rl.v, create$3(rl.r, rv, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const rr = r.r; + const rv = r.v; + const rl = r.l; + if (height$2(rr) >= height$2(rl)) { + return create$3(create$3(l, v, rl), rv, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$3(create$3(l, v, rl.l), rl.v, create$3(rl.r, rv, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" @@ -4605,8 +4676,9 @@ function bal$2(l, v, r) { } function add$3(x, t) { - if (!t) { - return /* Node */{ + if (/* tag */typeof t === "number" || typeof t === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -4637,7 +4709,8 @@ function add$3(x, t) { } function singleton$2(x) { - return /* Node */{ + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -4646,30 +4719,30 @@ function singleton$2(x) { } function add_min_element$1(x, param) { - if (param) { - return bal$2(add_min_element$1(x, param.l), param.v, param.r); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton$2(x); + } else { + return bal$2(add_min_element$1(x, param.l), param.v, param.r); } } function add_max_element$1(x, param) { - if (param) { - return bal$2(param.l, param.v, add_max_element$1(x, param.r)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton$2(x); + } else { + return bal$2(param.l, param.v, add_max_element$1(x, param.r)); } } function join$2(l, v, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_element$1(v, r); } - if (!r) { + const lh = l.h; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_element$1(v, l); } const rh = r.h; - const lh = l.h; if (lh > (rh + 2 | 0)) { return bal$2(l.l, l.v, join$2(l.r, v, r)); } else if (rh > (lh + 2 | 0)) { @@ -4682,49 +4755,47 @@ function join$2(l, v, r) { function min_elt$1(_param) { while(true) { const param = _param; - if (param) { - const l = param.l; - if (!l) { - return param.v; - } - _param = l; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param.v; + } + _param = l; + continue ; }; } function remove_min_elt$1(param) { - if (param) { - const l = param.l; - if (l) { - return bal$2(remove_min_elt$1(l), param.v, param.r); - } else { - return param.r; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Invalid_argument", { + MEL_EXN_ID: "Invalid_argument", + _1: "Set.remove_min_elt" + }); + } + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param.r; + } else { + return bal$2(remove_min_elt$1(l), param.v, param.r); } - throw new Caml_js_exceptions.MelangeError("Invalid_argument", { - MEL_EXN_ID: "Invalid_argument", - _1: "Set.remove_min_elt" - }); } function concat$2(t1, t2) { - if (t1) { - if (t2) { - return join$2(t1, min_elt$1(t2), remove_min_elt$1(t2)); - } else { - return t1; - } - } else { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; + } else if (/* tag */typeof t2 === "number" || typeof t2 === "string") { + return t1; + } else { + return join$2(t1, min_elt$1(t2), remove_min_elt$1(t2)); } } function split$2(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, false, @@ -4759,17 +4830,17 @@ function split$2(x, param) { } function is_empty$2(param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } } function mem$3(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(funarg.compare, x, param.v); @@ -4782,16 +4853,16 @@ function mem$3(x, _param) { } function union$3(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return s2; } - if (!s2) { + const h1 = s1.h; + const v1 = s1.v; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const h2 = s2.h; const v2 = s2.v; - const h1 = s1.h; - const v1 = s1.v; if (h1 >= h2) { if (h2 === 1) { return add$3(v2, s1); @@ -4807,10 +4878,10 @@ function union$3(s1, s2) { } function inter$2(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return /* Empty */0; } - if (!s2) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return /* Empty */0; } const r1 = s1.r; @@ -4826,10 +4897,10 @@ function inter$2(s1, s2) { } function diff$1(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return /* Empty */0; } - if (!s2) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const r1 = s1.r; @@ -4848,17 +4919,17 @@ function subset$1(_s1, _s2) { while(true) { const s2 = _s2; const s1 = _s1; - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return true; } - if (!s2) { + const r1 = s1.r; + const v1 = s1.v; + const l1 = s1.l; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return false; } const r2 = s2.r; const l2 = s2.l; - const r1 = s1.r; - const v1 = s1.v; - const l1 = s1.l; const c = Curry._2(funarg.compare, v1, s2.v); if (c === 0) { if (!subset$1(l1, l2)) { @@ -4869,7 +4940,8 @@ function subset$1(_s1, _s2) { continue ; } if (c < 0) { - if (!subset$1(/* Node */{ + if (!subset$1({ + TAG: /* Node */0, l: l1, v: v1, r: /* Empty */0, @@ -4880,7 +4952,8 @@ function subset$1(_s1, _s2) { _s1 = r1; continue ; } - if (!subset$1(/* Node */{ + if (!subset$1({ + TAG: /* Node */0, l: /* Empty */0, v: v1, r: r1, @@ -4897,7 +4970,7 @@ function fold$2(f, _s, _accu) { while(true) { const accu = _accu; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return accu; } _accu = Curry._2(f, s.v, fold$2(f, s.l, accu)); @@ -4909,7 +4982,7 @@ function fold$2(f, _s, _accu) { function exists$1(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } if (Curry._1(p, param.v)) { @@ -4927,7 +5000,7 @@ function elements_aux$1(_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param.l; @@ -4946,17 +5019,18 @@ function elements$1(s) { const funarg$1 = Types_TypeOps; function height$3(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$4(l, x, d, r) { const hl = height$3(l); const hr = height$3(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -4966,32 +5040,35 @@ function create$4(l, x, d, r) { } function bal$3(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height$3(ll) >= height$3(lr)) { - return create$4(ll, lv, ld, create$4(lr, x, d, r)); - } - if (lr) { - return create$4(create$4(ll, lv, ld, lr.l), lr.v, lr.d, create$4(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height$3(ll) >= height$3(lr)) { + return create$4(ll, lv, ld, create$4(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$4(create$4(ll, lv, ld, lr.l), lr.v, lr.d, create$4(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -4999,22 +5076,22 @@ function bal$3(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height$3(rr) >= height$3(rl)) { - return create$4(create$4(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create$4(create$4(l, x, d, rl.l), rl.v, rl.d, create$4(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height$3(rr) >= height$3(rl)) { + return create$4(create$4(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$4(create$4(l, x, d, rl.l), rl.v, rl.d, create$4(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -5022,8 +5099,9 @@ function bal$3(l, x, d, r) { } function add$4(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -5040,7 +5118,8 @@ function add$4(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -5068,17 +5147,17 @@ function add$4(x, data, m) { function find$1(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(funarg$1.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(funarg$1.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } @@ -5086,7 +5165,7 @@ function fold$3(f, _m, _accu) { while(true) { const accu = _accu; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return accu; } _accu = Curry._3(f, m.v, m.d, fold$3(f, m.l, accu)); @@ -5130,7 +5209,7 @@ function newty2(level, desc) { function is_Tvar(param) { const match = param.desc; - if (typeof match === "number" || match.TAG !== /* Tvar */0) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tvar */0) { return false; } else { return true; @@ -5139,7 +5218,7 @@ function is_Tvar(param) { function is_Tunivar(param) { const match = param.desc; - if (typeof match === "number" || match.TAG !== /* Tunivar */9) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tunivar */9) { return false; } else { return true; @@ -5151,7 +5230,7 @@ const dummy_method = "*dummy method*"; function field_kind_repr(_kind) { while(true) { const kind = _kind; - if (typeof kind === "number") { + if (/* tag */typeof kind === "number" || typeof kind === "string") { return kind; } const kind$1 = kind._0.contents; @@ -5167,10 +5246,10 @@ function repr(_t) { while(true) { const t = _t; const t$p = t.desc; - if (typeof t$p === "number") { + if (/* tag */typeof t$p === "number" || typeof t$p === "string") { return t; } - switch (t$p.TAG | 0) { + switch (t$p.TAG) { case /* Tfield */5 : if (!Caml_obj.caml_equal(field_kind_repr(t$p._1), /* Fabsent */1)) { return t; @@ -5189,7 +5268,7 @@ function repr(_t) { function commu_repr(_r) { while(true) { const r = _r; - if (typeof r === "number") { + if (/* tag */typeof r === "number" || typeof r === "string") { return r; } const r$1 = r._0; @@ -5205,7 +5284,7 @@ function row_field_repr_aux(_tl, _fi) { while(true) { const fi = _fi; const tl = _tl; - if (typeof fi === "number") { + if (/* tag */typeof fi === "number" || typeof fi === "string") { return fi; } if (fi.TAG === /* Rpresent */0) { @@ -5252,7 +5331,7 @@ function row_repr_aux(_ll, _row) { const row = _row; const ll = _ll; const row$p = repr(row.row_more).desc; - if (typeof row$p !== "number" && row$p.TAG === /* Tvariant */8) { + if (!/* tag */(typeof row$p === "number" || typeof row$p === "string") && row$p.TAG === /* Tvariant */8) { const f = row.row_fields; _row = row$p._0; _ll = Caml_obj.caml_equal(f, /* [] */0) ? ll : ({ @@ -5290,7 +5369,7 @@ function row_field(tag, row) { } const match$1 = repr(row.row_more); const row$p = match$1.desc; - if (typeof row$p === "number" || row$p.TAG !== /* Tvariant */8) { + if (/* tag */typeof row$p === "number" || typeof row$p === "string" || row$p.TAG !== /* Tvariant */8) { return /* Rabsent */0; } else { return row_field(tag, row$p._0); @@ -5303,7 +5382,7 @@ function row_more(_row) { const row = _row; const ty = repr(row.row_more); const row$p = ty.desc; - if (typeof row$p === "number") { + if (/* tag */typeof row$p === "number" || typeof row$p === "string") { return ty; } if (row$p.TAG !== /* Tvariant */8) { @@ -5320,10 +5399,10 @@ function row_fixed(row) { return true; } const match = repr(row$1.row_more).desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return false; } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tvar */0 : return false; case /* Tconstr */3 : @@ -5346,7 +5425,7 @@ function static_row(row) { if (row$1.row_closed) { return Stdlib__List.for_all((function (param) { const match = row_field_repr_aux(/* [] */0, param[1]); - if (typeof match === "number" || match.TAG === /* Rpresent */0) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG === /* Rpresent */0) { return true; } else { return false; @@ -5373,19 +5452,19 @@ function hash_variant(s) { function proxy(ty) { const ty0 = repr(ty); const row = ty0.desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { return ty0; } - switch (row.TAG | 0) { + switch (row.TAG) { case /* Tobject */4 : let _ty = row._0; while(true) { const ty$1 = _ty; const match = ty$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return ty0; } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tfield */5 : _ty = match._3; continue ; @@ -5421,19 +5500,19 @@ function proxy(ty) { function has_constr_row(t) { const row = repr(t).desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { return false; } - switch (row.TAG | 0) { + switch (row.TAG) { case /* Tobject */4 : let _t = row._0; while(true) { const t$1 = _t; const match = repr(t$1).desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return false; } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tconstr */3 : return true; case /* Tfield */5 : @@ -5446,7 +5525,7 @@ function has_constr_row(t) { case /* Tvariant */8 : const match$1 = row_more(row._0); const match$2 = match$1.desc; - if (typeof match$2 === "number" || match$2.TAG !== /* Tconstr */3) { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string" || match$2.TAG !== /* Tconstr */3) { return false; } else { return true; @@ -5467,14 +5546,14 @@ function is_row_name(s) { function is_constr_row(t) { const match = t.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return false; } if (match.TAG !== /* Tconstr */3) { return false; } const id = match._0; - switch (id.TAG | 0) { + switch (id.TAG) { case /* Pident */0 : return is_row_name(id._0.name); case /* Pdot */1 : @@ -5490,7 +5569,7 @@ function iter_row(f, _row) { const row = _row; Stdlib__List.iter((function (param) { const match = row_field_repr_aux(/* [] */0, param[1]); - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return ; } if (match.TAG !== /* Rpresent */0) { @@ -5503,8 +5582,8 @@ function iter_row(f, _row) { }), row.row_fields); const row$1 = repr(row.row_more).desc; - if (typeof row$1 !== "number") { - switch (row$1.TAG | 0) { + if (!/* tag */(typeof row$1 === "number" || typeof row$1 === "string")) { + switch (row$1.TAG) { case /* Tvariant */8 : _row = row$1._0; continue ; @@ -5532,10 +5611,10 @@ function iter_row(f, _row) { function iter_type_expr(f, ty) { const l = ty.desc; - if (typeof l === "number") { + if (/* tag */typeof l === "number" || typeof l === "string") { return ; } - switch (l.TAG | 0) { + switch (l.TAG) { case /* Tarrow */1 : Curry._1(f, l._1); return Curry._1(f, l._2); @@ -5575,7 +5654,7 @@ function iter_type_expr(f, ty) { function iter_abbrev(f, _rem) { while(true) { const rem = _rem; - if (typeof rem === "number") { + if (/* tag */typeof rem === "number" || typeof rem === "string") { return ; } if (rem.TAG === /* Mcons */0) { @@ -5597,7 +5676,7 @@ function it_signature(it) { } function it_signature_item(it, param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Sig_value */0 : return Curry._2(it.it_value_description, it, param._1); case /* Sig_type */1 : @@ -5655,7 +5734,7 @@ function it_class_type_declaration(it, ctd) { } function it_module_type(it, sg) { - switch (sg.TAG | 0) { + switch (sg.TAG) { case /* Mty_signature */1 : return Curry._2(it.it_signature, it, sg._0); case /* Mty_functor */2 : @@ -5669,7 +5748,7 @@ function it_module_type(it, sg) { } function it_class_type(it, cs) { - switch (cs.TAG | 0) { + switch (cs.TAG) { case /* Cty_constr */0 : Curry._1(it.it_path, cs._0); Stdlib__List.iter(Curry._1(it.it_type_expr, it), cs._1); @@ -5692,7 +5771,7 @@ function it_class_type(it, cs) { } function it_type_kind(it, cl) { - if (typeof cl === "number") { + if (/* tag */typeof cl === "number" || typeof cl === "string") { return ; } else if (cl.TAG === /* Type_record */0) { return Stdlib__List.iter((function (ld) { @@ -5709,10 +5788,10 @@ function it_type_kind(it, cl) { function it_do_type_expr(it, ty) { iter_type_expr(Curry._1(it.it_type_expr, it), ty); const row = ty.desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { return ; } - switch (row.TAG | 0) { + switch (row.TAG) { case /* Tobject */4 : const match = row._1.contents; if (match !== undefined) { @@ -5741,7 +5820,7 @@ function copy_row(f, fixed, row, keep, more) { const fi = param[1]; const match = row_field_repr_aux(/* [] */0, fi); let tmp; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { tmp = fi; } else if (match.TAG === /* Rpresent */0) { const ty = match._0; @@ -5786,8 +5865,8 @@ function copy_row(f, fixed, row, keep, more) { function copy_kind(_param) { while(true) { const param = _param; - if (typeof param === "number") { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { + if (param === /* Fpresent */0) { return /* Fpresent */0; } throw new Caml_js_exceptions.MelangeError("Assert_failure", { @@ -5798,17 +5877,19 @@ function copy_kind(_param) { 16 ] }); + } else { + const k = param._0.contents; + if (k === undefined) { + return { + TAG: /* Fvar */0, + _0: { + contents: undefined + } + }; + } + _param = k; + continue ; } - const k = param._0.contents; - if (k === undefined) { - return /* Fvar */{ - _0: { - contents: undefined - } - }; - } - _param = k; - continue ; }; } @@ -5816,7 +5897,8 @@ function copy_commu(c) { if (Caml_obj.caml_equal(commu_repr(c), /* Cok */0)) { return /* Cok */0; } else { - return /* Clink */{ + return { + TAG: /* Clink */0, _0: { contents: /* Cunknown */1 } @@ -5829,10 +5911,10 @@ function copy_type_desc(_keep_namesOpt, f, _ty) { const keep_namesOpt = _keep_namesOpt; const ty = _ty; const keep_names = keep_namesOpt !== undefined ? keep_namesOpt : false; - if (typeof ty === "number") { + if (/* tag */typeof ty === "number" || typeof ty === "string") { return /* Tnil */0; } - switch (ty.TAG | 0) { + switch (ty.TAG) { case /* Tvar */0 : if (keep_names) { return ty; @@ -5925,8 +6007,8 @@ function copy_type_desc(_keep_namesOpt, f, _ty) { while(true) { const ty = _ty; const ty$1 = ty.desc; - if (typeof ty$1 !== "number") { - switch (ty$1.TAG | 0) { + if (!/* tag */(typeof ty$1 === "number" || typeof ty$1 === "string")) { + switch (ty$1.TAG) { case /* Ttuple */2 : const match = ty$1._0; if (match) { @@ -6019,7 +6101,8 @@ function dup_kind(r) { hd: r$p, tl: new_kinds.contents }; - r.contents = /* Fvar */{ + r.contents = { + TAG: /* Fvar */0, _0: r$p }; } @@ -6110,7 +6193,7 @@ function unmark_class_signature(sign) { function find_expans(priv, p1, _param) { while(true) { const param = _param; - if (typeof param === "number") { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } if (param.TAG === /* Mcons */0) { @@ -6153,7 +6236,7 @@ function memorize_abbrev(mem, priv, path, v, v$p) { } function forget_abbrev_rec(mem, path) { - if (typeof mem === "number") { + if (/* tag */typeof mem === "number" || typeof mem === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -6252,7 +6335,7 @@ function extract_label_aux(_hd, l, _param) { } function undo_change(param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Ctype */0 : param._0.desc = param._1; return ; @@ -6279,7 +6362,8 @@ function log_change(ch) { const r$p = { contents: /* Unchanged */0 }; - r.contents = /* Change */{ + r.contents = { + TAG: /* Change */0, _0: ch, _1: r$p }; @@ -6305,13 +6389,13 @@ function link_type(ty, ty$p) { _0: ty$p }; const match = ty$p.desc; - if (typeof desc === "number") { + if (/* tag */typeof desc === "number" || typeof desc === "string") { return ; } if (desc.TAG !== /* Tvar */0) { return ; } - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return ; } if (match.TAG !== /* Tvar */0) { @@ -6418,28 +6502,29 @@ function rev_log(_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (typeof param === "number") { - if (param) { - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/test/ocaml_typedtree_test.ml", - 5465, - 15 - ] - }); + if (/* tag */typeof param === "number" || typeof param === "string") { + if (param === /* Unchanged */0) { + return accu; } - return accu; + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/test/ocaml_typedtree_test.ml", + 5465, + 15 + ] + }); + } else { + const next = param._1; + const d = next.contents; + next.contents = /* Invalid */1; + _param = d; + _accu = { + hd: param._0, + tl: accu + }; + continue ; } - const next = param._1; - const d = next.contents; - next.contents = /* Invalid */1; - _param = d; - _accu = { - hd: param._0, - tl: accu - }; - continue ; }; } @@ -6447,22 +6532,23 @@ function backtrack(param) { const old = param[1]; const changes = param[0]; const change = changes.contents; - if (typeof change === "number") { - if (change) { - throw new Caml_js_exceptions.MelangeError("Failure", { - MEL_EXN_ID: "Failure", - _1: "Btype.backtrack" - }); + if (/* tag */typeof change === "number" || typeof change === "string") { + if (change === /* Unchanged */0) { + last_snapshot.contents = old; + return ; } + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "Btype.backtrack" + }); + } else { + cleanup_abbrev(undefined); + const backlog = rev_log(/* [] */0, change); + Stdlib__List.iter(undo_change, backlog); + changes.contents = /* Unchanged */0; last_snapshot.contents = old; - return ; + return Caml_array.set(trail, 0, changes); } - cleanup_abbrev(undefined); - const backlog = rev_log(/* [] */0, change); - Stdlib__List.iter(undo_change, backlog); - changes.contents = /* Unchanged */0; - last_snapshot.contents = old; - Caml_array.set(trail, 0, changes); } const $$Error$1 = /* @__PURE__ */Caml_exceptions.create("Ocaml_typedtree_test.Cmi_format.Error"); @@ -6565,9 +6651,10 @@ function output_cmi(filename, oc, cmi) { } function report_error(ppf, filename) { - switch (filename.TAG | 0) { + switch (filename.TAG) { case /* Not_an_interface */0 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -6588,7 +6675,8 @@ function report_error(ppf, filename) { _1: "%a@ is not a compiled interface" }), print_filename, filename._0); case /* Wrong_version_interface */1 : - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -6625,7 +6713,8 @@ function report_error(ppf, filename) { _1: "%a@ is not a compiled interface for this version of OCaml.@.It seems to be for %s version of OCaml." }), print_filename, filename._0, filename._1); case /* Corrupted_interface */2 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Corrupted compiled interface", @@ -6707,10 +6796,10 @@ function free_vars(ty) { } ty$1.level = pivot_level - ty$1.level | 0; const row = ty$1.desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { return iter_type_expr(loop, ty$1); } - switch (row.TAG | 0) { + switch (row.TAG) { case /* Tvar */0 : ret.contents = Curry._2(add$3, ty$1, ret.contents); return ; @@ -7483,13 +7572,16 @@ function warn_bad_docstrings(param) { return ; case /* Docs */2 : const match$1 = ds.ds_associated; - if (match$1 >= 2) { - return prerr_warning(ds.ds_loc, { - TAG: /* Bad_docstring */33, - _0: false - }); - } else { - return ; + switch (match$1) { + case /* Zero */0 : + case /* One */1 : + return ; + case /* Many */2 : + return prerr_warning(ds.ds_loc, { + TAG: /* Bad_docstring */33, + _0: false + }); + } } @@ -7642,12 +7734,17 @@ function get_docstring(info, dsl) { } const ds = param.hd; const match = ds.ds_attached; - if (match !== 1) { - ds.ds_attached = info ? /* Info */1 : /* Docs */2; - return ds; + switch (match) { + case /* Info */1 : + _param = param.tl; + continue ; + case /* Unattached */0 : + case /* Docs */2 : + break; + } - _param = param.tl; - continue ; + ds.ds_attached = info ? /* Info */1 : /* Docs */2; + return ds; }; } @@ -7662,16 +7759,21 @@ function get_docstrings(dsl) { } const ds = param.hd; const match = ds.ds_attached; - if (match !== 1) { - ds.ds_attached = /* Docs */2; - _param = param.tl; - _acc = { - hd: ds, - tl: acc - }; - continue ; + switch (match) { + case /* Info */1 : + _param = param.tl; + continue ; + case /* Unattached */0 : + case /* Docs */2 : + break; + } + ds.ds_attached = /* Docs */2; _param = param.tl; + _acc = { + hd: ds, + tl: acc + }; continue ; }; } @@ -7679,10 +7781,15 @@ function get_docstrings(dsl) { function associate_docstrings(dsl) { Stdlib__List.iter((function (ds) { const match = ds.ds_associated; - if (match) { - ds.ds_associated = /* Many */2; - } else { - ds.ds_associated = /* One */1; + switch (match) { + case /* Zero */0 : + ds.ds_associated = /* One */1; + return ; + case /* One */1 : + case /* Many */2 : + ds.ds_associated = /* Many */2; + return ; + } }), dsl); } @@ -8007,7 +8114,7 @@ function extension(loc, attrs, a) { function force_poly(t) { const match = t.ptyp_desc; - if (typeof match !== "number" && match.TAG === /* Ptyp_poly */8) { + if (!/* tag */(typeof match === "number" || typeof match === "string") && match.TAG === /* Ptyp_poly */8) { return t; } return poly(t.ptyp_loc, undefined, /* [] */0, t); @@ -9314,10 +9421,10 @@ function map$1(sub, param) { const desc = param.ptyp_desc; const loc = Curry._2(sub.location, sub, param.ptyp_loc); const attrs = Curry._2(sub.attributes, sub, param.ptyp_attributes); - if (typeof desc === "number") { + if (/* tag */typeof desc === "number" || typeof desc === "string") { return mk(loc, attrs, /* Ptyp_any */0); } - switch (desc.TAG | 0) { + switch (desc.TAG) { case /* Ptyp_var */0 : return $$var(loc, attrs, desc._0); case /* Ptyp_arrow */1 : @@ -9389,7 +9496,7 @@ function map_type_declaration(sub, param) { } function map_type_kind(sub, l) { - if (typeof l === "number") { + if (/* tag */typeof l === "number" || typeof l === "string") { if (l === /* Ptype_abstract */0) { return /* Ptype_abstract */0; } else { @@ -9438,7 +9545,7 @@ function map$2(sub, param) { const desc = param.pcty_desc; const loc = Curry._2(sub.location, sub, param.pcty_loc); const attrs = Curry._2(sub.attributes, sub, param.pcty_attributes); - switch (desc.TAG | 0) { + switch (desc.TAG) { case /* Pcty_constr */0 : return constr$2(loc, attrs, map_loc(sub, desc._0), Stdlib__List.map(Curry._1(sub.typ, sub), desc._1)); case /* Pcty_signature */1 : @@ -9455,7 +9562,7 @@ function map_field(sub, param) { const desc = param.pctf_desc; const loc = Curry._2(sub.location, sub, param.pctf_loc); const attrs = Curry._2(sub.attributes, sub, param.pctf_attributes); - switch (desc.TAG | 0) { + switch (desc.TAG) { case /* Pctf_inherit */0 : return Curry._3(Ast_helper_Ctf.inherit_, loc, attrs, Curry._2(sub.class_type, sub, desc._0)); case /* Pctf_val */1 : @@ -9486,7 +9593,7 @@ function map$3(sub, param) { const desc = param.pmty_desc; const loc = Curry._2(sub.location, sub, param.pmty_loc); const attrs = Curry._2(sub.attributes, sub, param.pmty_attributes); - switch (desc.TAG | 0) { + switch (desc.TAG) { case /* Pmty_ident */0 : return ident$1(loc, attrs, map_loc(sub, desc._0)); case /* Pmty_signature */1 : @@ -9506,7 +9613,7 @@ function map$3(sub, param) { } function map_with_constraint(sub, d) { - switch (d.TAG | 0) { + switch (d.TAG) { case /* Pwith_type */0 : return { TAG: /* Pwith_type */0, @@ -9537,7 +9644,7 @@ function map_with_constraint(sub, d) { function map_signature_item(sub, param) { const desc = param.psig_desc; const loc = Curry._2(sub.location, sub, param.psig_loc); - switch (desc.TAG | 0) { + switch (desc.TAG) { case /* Psig_value */0 : const a = Curry._2(sub.value_description, sub, desc._0); return mk$5(loc, { @@ -9620,7 +9727,7 @@ function map$4(sub, param) { const desc = param.pmod_desc; const loc = Curry._2(sub.location, sub, param.pmod_loc); const attrs = Curry._2(sub.attributes, sub, param.pmod_attributes); - switch (desc.TAG | 0) { + switch (desc.TAG) { case /* Pmod_ident */0 : return ident$2(loc, attrs, map_loc(sub, desc._0)); case /* Pmod_structure */1 : @@ -9642,7 +9749,7 @@ function map$4(sub, param) { function map_structure_item(sub, param) { const desc = param.pstr_desc; const loc = Curry._2(sub.location, sub, param.pstr_loc); - switch (desc.TAG | 0) { + switch (desc.TAG) { case /* Pstr_eval */0 : return $$eval(loc, Curry._2(sub.attributes, sub, desc._1), Curry._2(sub.expr, sub, desc._0)); case /* Pstr_value */1 : @@ -9729,7 +9836,7 @@ function map$5(sub, param) { const desc = param.pexp_desc; const loc = Curry._2(sub.location, sub, param.pexp_loc); const attrs = Curry._2(sub.attributes, sub, param.pexp_attributes); - switch (desc.TAG | 0) { + switch (desc.TAG) { case /* Pexp_ident */0 : return Curry._3(Ast_helper_Exp.ident, loc, attrs, map_loc(sub, desc._0)); case /* Pexp_constant */1 : @@ -9819,10 +9926,10 @@ function map$6(sub, param) { const desc = param.ppat_desc; const loc = Curry._2(sub.location, sub, param.ppat_loc); const attrs = Curry._2(sub.attributes, sub, param.ppat_attributes); - if (typeof desc === "number") { + if (/* tag */typeof desc === "number" || typeof desc === "string") { return mk$1(loc, attrs, /* Ppat_any */0); } - switch (desc.TAG | 0) { + switch (desc.TAG) { case /* Ppat_var */0 : return $$var$1(loc, attrs, map_loc(sub, desc._0)); case /* Ppat_alias */1 : @@ -9868,7 +9975,7 @@ function map$7(sub, param) { const desc = param.pcl_desc; const loc = Curry._2(sub.location, sub, param.pcl_loc); const attrs = Curry._2(sub.attributes, sub, param.pcl_attributes); - switch (desc.TAG | 0) { + switch (desc.TAG) { case /* Pcl_constr */0 : return constr$1(loc, attrs, map_loc(sub, desc._0), Stdlib__List.map(Curry._1(sub.typ, sub), desc._1)); case /* Pcl_structure */1 : @@ -9909,7 +10016,7 @@ function map_field$1(sub, param) { const desc = param.pcf_desc; const loc = Curry._2(sub.location, sub, param.pcf_loc); const attrs = Curry._2(sub.attributes, sub, param.pcf_attributes); - switch (desc.TAG | 0) { + switch (desc.TAG) { case /* Pcf_inherit */0 : return Curry._5(Ast_helper_Cf.inherit_, loc, attrs, desc._0, Curry._2(sub.class_expr, sub, desc._1), desc._2); case /* Pcf_val */1 : @@ -10033,7 +10140,7 @@ function default_mapper_open_description($$this, param) { } function default_mapper_payload($$this, x) { - switch (x.TAG | 0) { + switch (x.TAG) { case /* PStr */0 : return { TAG: /* PStr */0, @@ -10114,17 +10221,18 @@ const default_mapper = { }; function height$4(param) { - if (param) { - return param._4; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param._4; } } function create$5(l, x, d, r) { const hl = height$4(l); const hr = height$4(r); - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: x, _2: d, @@ -10137,17 +10245,7 @@ function bal$4(l, x, d, r) { const hl = height$4(l); const hr = height$4(r); if (hl > (hr + 1 | 0)) { - if (l) { - const lr = l._3; - const ld = l._2; - const lv = l._1; - const ll = l._0; - if (height$4(ll) >= height$4(lr)) { - return create$5(ll, lv, ld, create$5(lr, x, d, r)); - } - if (lr) { - return create$5(create$5(ll, lv, ld, lr._0), lr._1, lr._2, create$5(lr._3, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -10157,6 +10255,16 @@ function bal$4(l, x, d, r) { ] }); } + const lr = l._3; + const ld = l._2; + const lv = l._1; + const ll = l._0; + if (height$4(ll) >= height$4(lr)) { + return create$5(ll, lv, ld, create$5(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$5(create$5(ll, lv, ld, lr._0), lr._1, lr._2, create$5(lr._3, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -10169,15 +10277,7 @@ function bal$4(l, x, d, r) { if (hr <= (hl + 1 | 0)) { return create$5(l, x, d, r); } - if (r) { - const rl = r._0; - const rr = r._3; - if (height$4(rr) >= height$4(rl)) { - return create$5(create$5(l, x, d, rl), r._1, r._2, rr); - } - if (rl) { - return create$5(create$5(l, x, d, rl._0), rl._1, rl._2, create$5(rl._3, r._1, r._2, r._3)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -10187,6 +10287,14 @@ function bal$4(l, x, d, r) { ] }); } + const rl = r._0; + const rr = r._3; + if (height$4(rr) >= height$4(rl)) { + return create$5(create$5(l, x, d, rl), r._1, r._2, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$5(create$5(l, x, d, rl._0), rl._1, rl._2, create$5(rl._3, r._1, r._2, r._3)); + } throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -10198,8 +10306,9 @@ function bal$4(l, x, d, r) { } function add$5(x, data, param) { - if (!param) { - return /* Node */{ + if (/* tag */typeof param === "number" || typeof param === "string") { + return { + TAG: /* Node */0, _0: /* Empty */0, _1: x, _2: data, @@ -10213,7 +10322,8 @@ function add$5(x, data, param) { const l = param._0; const c = Caml_obj.caml_compare(x, v); if (c === 0) { - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: x, _2: data, @@ -10230,24 +10340,24 @@ function add$5(x, data, param) { function find$2(x, _param) { while(true) { const param = _param; - if (param) { - const c = Caml_obj.caml_compare(x, param._1); - if (c === 0) { - return param._2; - } - _param = c < 0 ? param._0 : param._3; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Caml_obj.caml_compare(x, param._1); + if (c === 0) { + return param._2; + } + _param = c < 0 ? param._0 : param._3; + continue ; }; } function mem$4(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Caml_obj.caml_compare(x, param._1); @@ -10262,7 +10372,7 @@ function mem$4(x, _param) { function iter$2(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } iter$2(f, param._0); @@ -10276,7 +10386,7 @@ function fold$4(f, _m, _accu) { while(true) { const accu = _accu; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return accu; } _accu = Curry._3(f, m._1, m._2, fold$4(f, m._0, accu)); @@ -10364,7 +10474,7 @@ function attrs(s, x) { } function module_path(s, p) { - switch (p.TAG | 0) { + switch (p.TAG) { case /* Pident */0 : try { return find$2(p._0, s.modules); @@ -10394,7 +10504,7 @@ function module_path(s, p) { } function modtype_path(s, p) { - switch (p.TAG | 0) { + switch (p.TAG) { case /* Pident */0 : try { const p$1 = find$2(p._0, s.modtypes); @@ -10425,7 +10535,7 @@ function modtype_path(s, p) { } function type_path(s, p) { - switch (p.TAG | 0) { + switch (p.TAG) { case /* Pident */0 : try { return find$2(p._0, s.types); @@ -10464,10 +10574,10 @@ function newpersty(desc) { } function norm(d) { - if (typeof d === "number") { + if (/* tag */typeof d === "number" || typeof d === "string") { return d; } - switch (d.TAG | 0) { + switch (d.TAG) { case /* Tvar */0 : if (d._0 !== undefined) { return d; @@ -10495,10 +10605,10 @@ function typexp(s, ty) { const ty$1 = repr(ty); const desc = ty$1.desc; let exit = 0; - if (typeof desc === "number") { + if (/* tag */typeof desc === "number" || typeof desc === "string") { exit = 1; } else { - switch (desc.TAG | 0) { + switch (desc.TAG) { case /* Tsubst */7 : return desc._0; case /* Tvar */0 : @@ -10526,10 +10636,10 @@ function typexp(s, ty) { }; let tmp; let exit$1 = 0; - if (typeof desc$1 === "number") { + if (/* tag */typeof desc$1 === "number" || typeof desc$1 === "string") { exit$1 = 3; } else { - switch (desc$1.TAG | 0) { + switch (desc$1.TAG) { case /* Tconstr */3 : tmp = { TAG: /* Tconstr */3, @@ -10581,11 +10691,11 @@ function typexp(s, ty) { const more = repr(row.row_more); const match$1 = more.desc; let exit$2 = 0; - if (typeof match$1 === "number" || match$1.TAG !== /* Tsubst */7) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Tsubst */7) { exit$2 = 4; } else { const match$2 = match$1._0.desc; - if (typeof match$2 === "number" || match$2.TAG !== /* Ttuple */2) { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string" || match$2.TAG !== /* Ttuple */2) { exit$2 = 4; } else { const match$3 = match$2._0; @@ -10618,7 +10728,7 @@ function typexp(s, ty) { if (!static_row(row)) { const match$5 = more.desc; let tmp$3; - tmp$3 = typeof match$5 === "number" || match$5.TAG !== /* Tconstr */3 ? false : true; + tmp$3 = /* tag */typeof match$5 === "number" || typeof match$5 === "string" || match$5.TAG !== /* Tconstr */3 ? false : true; tmp$2 = tmp$3; } tmp$1 = tmp$2; @@ -10628,10 +10738,10 @@ function typexp(s, ty) { const ty$2 = more.desc; let more$p; let exit$3 = 0; - if (typeof ty$2 === "number") { + if (/* tag */typeof ty$2 === "number" || typeof ty$2 === "string") { more$p = typexp(s, more); } else { - switch (ty$2.TAG | 0) { + switch (ty$2.TAG) { case /* Tconstr */3 : more$p = typexp(s, more); break; @@ -10740,7 +10850,7 @@ function type_expr(s, ty) { function type_declaration(s, decl) { const cstrs = decl.type_kind; let tmp; - tmp = typeof cstrs === "number" ? ( + tmp = /* tag */typeof cstrs === "number" || typeof cstrs === "string" ? ( cstrs === /* Type_abstract */0 ? /* Type_abstract */0 : /* Type_open */1 ) : ( cstrs.TAG === /* Type_record */0 ? ({ @@ -10820,7 +10930,7 @@ function class_signature(s, sign) { } function class_type(s, sign) { - switch (sign.TAG | 0) { + switch (sign.TAG) { case /* Cty_constr */0 : return { TAG: /* Cty_constr */0, @@ -10940,7 +11050,7 @@ function rename_bound_idents(_s, _idents, _param) { ]; } const match = param.hd; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Sig_type */1 : const id = match._0; const id$p = rename(id); @@ -10996,10 +11106,10 @@ function rename_bound_idents(_s, _idents, _param) { } function modtype(s, mty) { - switch (mty.TAG | 0) { + switch (mty.TAG) { case /* Mty_ident */0 : const p = mty._0; - switch (p.TAG | 0) { + switch (p.TAG) { case /* Pident */0 : try { return find$2(p._0, s.modtypes); @@ -11057,7 +11167,7 @@ function signature$2(s, sg) { const match = rename_bound_idents(s, /* [] */0, sg); const s$p = match[1]; return Stdlib__List.map2((function (param, param$1) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Sig_value */0 : return { TAG: /* Sig_value */0, @@ -11168,7 +11278,7 @@ const $$Error$2 = /* @__PURE__ */Caml_exceptions.create("Ocaml_typedtree_test.En function force(f, x) { const x$1 = x.contents; - switch (x$1.TAG | 0) { + switch (x$1.TAG) { case /* Done */0 : return x$1._0; case /* Raise */1 : @@ -11196,7 +11306,7 @@ function force(f, x) { function get_arg(x) { const a = x.contents; - switch (a.TAG | 0) { + switch (a.TAG) { case /* Done */0 : case /* Raise */1 : return ; @@ -11262,20 +11372,20 @@ function fold_name(f) { const param$2 = _param; const accu = _accu; const stack = _stack; - if (param$2) { - _param = param$2._2; - _accu = Curry._2(f$2, param$2._1, accu); - _stack = { - hd: param$2._0, - tl: stack - }; + if (/* tag */typeof param$2 === "number" || typeof param$2 === "string") { + if (!stack) { + return accu; + } + _param = stack.hd; + _stack = stack.tl; continue ; } - if (!stack) { - return accu; - } - _param = stack.hd; - _stack = stack.tl; + _param = param$2._2; + _accu = Curry._2(f$2, param$2._1, accu); + _stack = { + hd: param$2._0, + tl: stack + }; continue ; }; }; @@ -11426,17 +11536,20 @@ const funarg$2 = { }; function height$5(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$6(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; - return /* Node */{ + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; + return { + TAG: /* Node */0, l: l, v: v, r: r, @@ -11445,52 +11558,55 @@ function create$6(l, v, r) { } function bal$5(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const lv = l.v; - const ll = l.l; - if (height$5(ll) >= height$5(lr)) { - return create$6(ll, lv, create$6(lr, v, r)); - } - if (lr) { - return create$6(create$6(ll, lv, lr.l), lr.v, create$6(lr.r, v, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const lr = l.r; + const lv = l.v; + const ll = l.l; + if (height$5(ll) >= height$5(lr)) { + return create$6(ll, lv, create$6(lr, v, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$6(create$6(ll, lv, lr.l), lr.v, create$6(lr.r, v, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: v, r: r, h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rv = r.v; - const rl = r.l; - if (height$5(rr) >= height$5(rl)) { - return create$6(create$6(l, v, rl), rv, rr); - } - if (rl) { - return create$6(create$6(l, v, rl.l), rl.v, create$6(rl.r, rv, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const rr = r.r; + const rv = r.v; + const rl = r.l; + if (height$5(rr) >= height$5(rl)) { + return create$6(create$6(l, v, rl), rv, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$6(create$6(l, v, rl.l), rl.v, create$6(rl.r, rv, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" @@ -11498,8 +11614,9 @@ function bal$5(l, v, r) { } function add$7(x, t) { - if (!t) { - return /* Node */{ + if (/* tag */typeof t === "number" || typeof t === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -11533,7 +11650,7 @@ function fold$5(f, _s, _accu) { while(true) { const accu = _accu; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return accu; } _accu = Curry._2(f, s.v, fold$5(f, s.l, accu)); @@ -11546,7 +11663,7 @@ function elements_aux$2(_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param.l; @@ -11742,7 +11859,7 @@ function find_pers_struct(checkOpt, name) { } function find_module_descr(path, env) { - switch (path.TAG | 0) { + switch (path.TAG) { case /* Pident */0 : const id = path._0; try { @@ -11782,7 +11899,7 @@ function find_module_descr(path, env) { } function find$3(proj1, proj2, path, env) { - switch (path.TAG | 0) { + switch (path.TAG) { case /* Pident */0 : return find_same$1(path._0, Curry._1(proj1, env))[1]; case /* Pdot */1 : @@ -11834,7 +11951,7 @@ function find_class(param, param$1) { } function find_module(alias, path, env) { - switch (path.TAG | 0) { + switch (path.TAG) { case /* Pident */0 : const id = path._0; try { @@ -11936,7 +12053,7 @@ function add_required_global(id) { function normalize_path(lax, env, path) { let path$1; - switch (path.TAG | 0) { + switch (path.TAG) { case /* Pident */0 : path$1 = path; break; @@ -11979,7 +12096,7 @@ function normalize_path(lax, env, path) { let tmp = true; if (!lax) { let tmp$1; - switch (path$1.TAG | 0) { + switch (path$1.TAG) { case /* Pident */0 : tmp$1 = path$1._0.stamp !== 0; break; @@ -12113,7 +12230,7 @@ function find_modtype_expansion(path, env) { function is_functor_arg(_path, env) { while(true) { const path = _path; - switch (path.TAG | 0) { + switch (path.TAG) { case /* Pident */0 : try { find_same(path._0, env.functor_args); @@ -12139,7 +12256,7 @@ function is_functor_arg(_path, env) { const Recmodule = /* @__PURE__ */Caml_exceptions.create("Ocaml_typedtree_test.Env.Recmodule"); function lookup_module_descr(lid, env) { - switch (lid.TAG | 0) { + switch (lid.TAG) { case /* Lident */0 : const s = lid._0; try { @@ -12213,7 +12330,7 @@ function lookup_module_descr(lid, env) { } function lookup_module(load, lid, env) { - switch (lid.TAG | 0) { + switch (lid.TAG) { case /* Lident */0 : const s = lid._0; try { @@ -12221,7 +12338,7 @@ function lookup_module(load, lid, env) { const md_type = r[1].md_type; if (md_type.TAG === /* Mty_ident */0) { const id = md_type._0; - switch (id.TAG | 0) { + switch (id.TAG) { case /* Pident */0 : if (id._0.name === "#recmod#") { throw new Caml_js_exceptions.MelangeError(Recmodule, { @@ -12313,7 +12430,7 @@ function lookup_module(load, lid, env) { } function lookup(proj1, proj2, lid, env) { - switch (lid.TAG | 0) { + switch (lid.TAG) { case /* Lident */0 : return find_name$1(lid._0, Curry._1(proj1, env)); case /* Ldot */1 : @@ -12344,7 +12461,7 @@ function lookup(proj1, proj2, lid, env) { } function lookup_all_simple(proj1, proj2, shadow, lid, env) { - switch (lid.TAG | 0) { + switch (lid.TAG) { case /* Lident */0 : const xl = find_all(lid._0, Curry._1(proj1, env)); const do_shadow = function (param) { @@ -12403,12 +12520,12 @@ function lookup_all_simple(proj1, proj2, shadow, lid, env) { function cstr_shadow(cstr1, cstr2) { const match = cstr1.cstr_tag; const match$1 = cstr2.cstr_tag; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Cstr_constant */0 : case /* Cstr_block */1 : return false; case /* Cstr_extension */2 : - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Cstr_constant */0 : case /* Cstr_block */1 : return false; @@ -12624,7 +12741,7 @@ function mark_type_path(env, path) { function ty_path(t) { const match = repr(t); const match$1 = match.desc; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -12662,7 +12779,7 @@ function lookup_constructor(lid, env) { } function is_lident(param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Lident */0 : return true; case /* Ldot */1 : @@ -12704,7 +12821,7 @@ function mark_constructor(usage, env, name, desc) { return ; } const match = desc.cstr_tag; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Cstr_constant */0 : case /* Cstr_block */1 : break; @@ -12811,7 +12928,7 @@ function scrape_alias_safe(env, _mty) { return true; } const id = mty._0; - switch (id.TAG | 0) { + switch (id.TAG) { case /* Pident */0 : if (id._0.stamp === 0) { return false; @@ -12994,7 +13111,7 @@ function find_all_comps(proj, s, param) { } function find_shadowed_comps(path, env) { - switch (path.TAG | 0) { + switch (path.TAG) { case /* Pident */0 : return Stdlib__List.map((function (prim) { return prim[0]; @@ -13014,7 +13131,7 @@ function find_shadowed_comps(path, env) { } function find_shadowed(proj1, proj2, path, env) { - switch (path.TAG | 0) { + switch (path.TAG) { case /* Pident */0 : return Stdlib__List.map((function (prim) { return prim[0]; @@ -13071,7 +13188,7 @@ function add_gadt_instance_level(lv, env) { function is_Tlink(param) { const match = param.desc; - if (typeof match === "number" || match.TAG !== /* Tlink */6) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tlink */6) { return false; } else { return true; @@ -13148,7 +13265,7 @@ function add_gadt_instance_chain(env, lv, t) { } set_typeset(r, Curry._2(add$3, t$1, r.contents)); const match = t$1.desc; - if (typeof match === "number" || match.TAG !== /* Tconstr */3) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tconstr */3) { return ; } else { return may(add_instance, find_expans(/* Private */0, match._0, match._2.contents)); @@ -13158,7 +13275,7 @@ function add_gadt_instance_chain(env, lv, t) { } function scrape_alias(env, path, mty) { - switch (mty.TAG | 0) { + switch (mty.TAG) { case /* Mty_ident */0 : try { return scrape_alias(env, path, find_modtype_expansion(mty._0, env)); @@ -13196,7 +13313,7 @@ function scrape_alias(env, path, mty) { function constructors_of_type(ty_path, decl) { const cstrs = decl.type_kind; - if (typeof cstrs === "number" || cstrs.TAG !== /* Type_variant */1) { + if (/* tag */typeof cstrs === "number" || typeof cstrs === "string" || cstrs.TAG !== /* Type_variant */1) { return /* [] */0; } else { let cstrs$1 = cstrs._0; @@ -13422,7 +13539,7 @@ function constructors_of_type(ty_path, decl) { function labels_of_type(ty_path, decl) { const match = decl.type_kind; - if (typeof match === "number" || match.TAG !== /* Type_record */0) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Type_record */0) { return /* [] */0; } else { let ty_res = newty2(100000000, { @@ -13480,7 +13597,7 @@ function prefix_idents(root, pos, sub, param) { ]; } const match = param.hd; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Sig_value */0 : const p_1 = match._0.name; const p = { @@ -13491,7 +13608,7 @@ function prefix_idents(root, pos, sub, param) { }; const match$1 = match._1.val_kind; let nextpos; - nextpos = typeof match$1 === "number" || match$1.TAG !== /* Val_prim */0 ? pos + 1 | 0 : pos; + nextpos = /* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Val_prim */0 ? pos + 1 | 0 : pos; const match$2 = prefix_idents(root, nextpos, sub, param.tl); return [ { @@ -13616,7 +13733,7 @@ function prefix_idents_and_subst(root, sub, sg) { LAZY_DONE: false, VAL: (function () { return Stdlib__List.map((function (item) { - switch (item.TAG | 0) { + switch (item.TAG) { case /* Sig_value */0 : return { TAG: /* Sig_value */0, @@ -13897,7 +14014,7 @@ function components_of_module_maker(param) { const sub = param[1]; const env = param[0]; const sg = scrape_alias(env, undefined, param[3]); - switch (sg.TAG | 0) { + switch (sg.TAG) { case /* Mty_signature */1 : const sg$1 = sg._0; const c = { @@ -13920,7 +14037,7 @@ function components_of_module_maker(param) { contents: 0 }; Stdlib__List.iter2((function (item, path) { - switch (item.TAG | 0) { + switch (item.TAG) { case /* Sig_value */0 : const decl = item._1; const decl$p = value_description(sub$1, decl); @@ -13929,7 +14046,7 @@ function components_of_module_maker(param) { pos.contents ], c.comp_values); const match = decl.val_kind; - if (typeof match === "number" || match.TAG !== /* Val_prim */0) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Val_prim */0) { pos.contents = pos.contents + 1 | 0; return ; } else { @@ -14532,7 +14649,7 @@ function enter_module(arg, s, mty, env) { } function add_item(comp, env) { - switch (comp.TAG | 0) { + switch (comp.TAG) { case /* Sig_value */0 : return add_value(undefined, comp._0, comp._1, env); case /* Sig_type */1 : @@ -14568,7 +14685,7 @@ function open_signature(slot, root, sg, env0) { const match = prefix_idents_and_subst$1(root, identity, sg); const sg$1 = CamlinternalLazy.force(match[2]); const newenv = Stdlib__List.fold_left2((function (env, item, p) { - switch (item.TAG | 0) { + switch (item.TAG) { case /* Sig_value */0 : return store_value(undefined, slot, hide(item._0), p, item._1, env, env0); case /* Sig_type */1 : @@ -14965,9 +15082,10 @@ function keep_only_summary(env) { } function report_error$1(ppf, param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Illegal_renaming */0 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Wrong file naming: ", @@ -15017,12 +15135,14 @@ function report_error$1(ppf, param) { _1: "Wrong file naming: %a@ contains the compiled interface for @ %s when %s was expected" }), print_filename, param._2, param._0, param._1); case /* Inconsistent_import */1 : - return Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -15093,12 +15213,14 @@ function report_error$1(ppf, param) { _1: "@[The files %a@ and %a@ make inconsistent assumptions@ over interface %s@]" }), print_filename, param._1, print_filename, param._2, param._0); case /* Need_recursive_types */2 : - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -15151,12 +15273,14 @@ function report_error$1(ppf, param) { case /* Missing_module */3 : const path2 = param._2; const path1 = param._1; - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -15165,7 +15289,8 @@ function report_error$1(ppf, param) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -15180,7 +15305,8 @@ function report_error$1(ppf, param) { _1: "@[@[" }); if (same(path1, path2)) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Internal path", @@ -15215,7 +15341,8 @@ function report_error$1(ppf, param) { _1: "Internal path@ %s@ is dangling." }), name(undefined, path1)); } else { - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Internal path", @@ -15276,7 +15403,8 @@ function report_error$1(ppf, param) { _1: "Internal path@ %s@ expands to@ %s@ which is dangling." }), name(undefined, path1), name(undefined, path2)); } - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: /* Close_box */0, @@ -15292,7 +15420,8 @@ function report_error$1(ppf, param) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -15346,7 +15475,8 @@ function report_error$1(ppf, param) { _1: "@]@ @[%s@ %s@ %s.@]@]" }), "The compiled interface for module", head(path2).name, "was not found"); case /* Illegal_value_name */4 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '\'' */39, @@ -15371,7 +15501,7 @@ register_error_of_exn(function (err) { return ; } const err$1 = err._1; - switch (err$1.TAG | 0) { + switch (err$1.TAG) { case /* Missing_module */3 : case /* Illegal_value_name */4 : break; @@ -15421,7 +15551,7 @@ function from_pair_suites(name, suites) { const code = param[1]; it(param[0], (function () { let spec = Curry._1(code, undefined); - switch (spec.TAG | 0) { + switch (spec.TAG) { case /* Eq */0 : Assert.deepEqual(spec._0, spec._1); return ; @@ -15476,7 +15606,7 @@ function from_pair_suites(name, suites) { return Stdlib__List.iter((function (param) { const name = param[0]; const fn = Curry._1(param[1], undefined); - switch (fn.TAG | 0) { + switch (fn.TAG) { case /* Eq */0 : console.log([ name, @@ -15558,12 +15688,13 @@ const $$Error$3 = /* @__PURE__ */Caml_exceptions.create("Ocaml_typedtree_test.Sy const Escape_error = /* @__PURE__ */Caml_exceptions.create("Ocaml_typedtree_test.Syntaxerr.Escape_error"); function prepare_error(loc) { - switch (loc.TAG | 0) { + switch (loc.TAG) { case /* Unclosed */0 : const closing = loc._3; const opening = loc._1; return Curry._1(errorf(loc._2, { - hd: Curry._1(errorf(loc._0, undefined, undefined, /* Format */{ + hd: Curry._1(errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This '", @@ -15580,7 +15711,8 @@ function prepare_error(loc) { _1: "This '%s' might be unmatched" }), opening), tl: /* [] */0 - }, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + }, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error: '", @@ -15603,7 +15735,8 @@ function prepare_error(loc) { } }, _1: "Syntax error: '%s' expected, the highlighted '%s' might be unmatched" - }), closing, opening), /* Format */{ + }), closing, opening), { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error: '", @@ -15620,7 +15753,8 @@ function prepare_error(loc) { _1: "Syntax error: '%s' expected" }), closing); case /* Expecting */1 : - return Curry._1(errorf(loc._0, undefined, undefined, /* Format */{ + return Curry._1(errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error: ", @@ -15637,7 +15771,8 @@ function prepare_error(loc) { _1: "Syntax error: %s expected." }), loc._1); case /* Not_expecting */2 : - return Curry._1(errorf(loc._0, undefined, undefined, /* Format */{ + return Curry._1(errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error: ", @@ -15654,7 +15789,8 @@ function prepare_error(loc) { _1: "Syntax error: %s not expected." }), loc._1); case /* Applicative_path */3 : - return errorf(loc._0, undefined, undefined, /* Format */{ + return errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error: applicative paths of the form F(X).t are not supported when the option -no-app-func is set.", @@ -15664,7 +15800,8 @@ function prepare_error(loc) { }); case /* Variable_in_scope */4 : const $$var = loc._1; - return Curry._2(errorf(loc._0, undefined, undefined, /* Format */{ + return Curry._2(errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "In this scoped type, variable '", @@ -15689,7 +15826,8 @@ function prepare_error(loc) { _1: "In this scoped type, variable '%s is reserved for the local type %s." }), $$var, $$var); case /* Other */5 : - return errorf(loc._0, undefined, undefined, /* Format */{ + return errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error", @@ -15698,7 +15836,8 @@ function prepare_error(loc) { _1: "Syntax error" }); case /* Ill_formed_ast */6 : - return Curry._1(errorf(loc._0, undefined, undefined, /* Format */{ + return Curry._1(errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "broken invariant in parsetree: ", @@ -16181,10 +16320,10 @@ function varify_constructors(var_names, t) { const loop = function (t) { const x = t.ptyp_desc; let desc; - if (typeof x === "number") { + if (/* tag */typeof x === "number" || typeof x === "string") { desc = /* Ptyp_any */0; } else { - switch (x.TAG | 0) { + switch (x.TAG) { case /* Ptyp_var */0 : const x$1 = x._0; check_variable(var_names, t.ptyp_loc, x$1); @@ -16211,7 +16350,7 @@ function varify_constructors(var_names, t) { const longident = x._0; let exit = 0; const s = longident.txt; - switch (s.TAG | 0) { + switch (s.TAG) { case /* Lident */0 : if (x._1) { exit = 1; @@ -16420,7 +16559,7 @@ function extra_csig(pos, items) { } function add_nonrec(rf, attrs, pos) { - if (rf) { + if (rf !== /* Nonrecursive */0) { return attrs; } const name_loc = rhs_loc(pos); @@ -16977,7 +17116,8 @@ const yyact = [ let exit = 0; if (bindings) { const lb = bindings.hd; - if (typeof lb.lb_pattern.ppat_desc === "number" && !bindings.tl) { + let tmp = lb.lb_pattern.ppat_desc; + if (/* tag */(typeof tmp === "number" || typeof tmp === "string") && !bindings.tl) { const exp = wrap_exp_attrs(lb.lb_expression, [ undefined, lbs.lbs_attributes @@ -18798,7 +18938,7 @@ const yyact = [ case "-" : if (match.TAG === /* Pexp_constant */1) { const n = match._0; - switch (n.TAG | 0) { + switch (n.TAG) { case /* Const_int */0 : return mkexp({ TAG: /* Pexp_constant */1, @@ -18877,7 +19017,7 @@ const yyact = [ switch (_1) { case "+" : if (desc.TAG === /* Pexp_constant */1) { - switch (desc._0.TAG | 0) { + switch (desc._0.TAG) { case /* Const_char */1 : case /* Const_string */2 : case /* Const_float */3 : @@ -22674,10 +22814,10 @@ function implementation(lexfun, lexbuf) { } function type_of_directive(x) { - if (typeof x === "number") { + if (/* tag */typeof x === "number" || typeof x === "string") { return /* Dir_type_null */4; } - switch (x.TAG | 0) { + switch (x.TAG) { case /* Dir_bool */0 : return /* Dir_type_bool */0; case /* Dir_float */1 : @@ -22834,7 +22974,7 @@ function defined(str) { return false; } } - if (typeof val === "number") { + if (/* tag */typeof val === "number" || typeof val === "string") { return false; } else { return true; @@ -22900,7 +23040,7 @@ function query(loc, str) { throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } } - if (typeof v === "number") { + if (/* tag */typeof v === "number" || typeof v === "string") { return { TAG: /* Dir_bool */0, _0: false @@ -22911,7 +23051,7 @@ function query(loc, str) { } function value_of_token(loc, t) { - if (typeof t === "number") { + if (/* tag */typeof t === "number" || typeof t === "string") { switch (t) { case /* FALSE */29 : return { @@ -22931,7 +23071,7 @@ function value_of_token(loc, t) { }); } } else { - switch (t.TAG | 0) { + switch (t.TAG) { case /* FLOAT */1 : return { TAG: /* Dir_float */1, @@ -22972,7 +23112,7 @@ function directive_parse(token_with_comments, lexbuf) { let _param; while(true) { const t = Curry._1(token_with_comments, lexbuf); - if (typeof t === "number") { + if (/* tag */typeof t === "number" || typeof t === "string") { switch (t) { case /* EOF */25 : throw new Caml_js_exceptions.MelangeError($$Error$4, { @@ -22987,7 +23127,7 @@ function directive_parse(token_with_comments, lexbuf) { return t; } } else { - switch (t.TAG | 0) { + switch (t.TAG) { case /* COMMENT */18 : case /* DOCSTRING */19 : _param = undefined; @@ -23014,7 +23154,7 @@ function directive_parse(token_with_comments, lexbuf) { const token_op = function (calc, no, lhs) { const op = token(undefined); let exit = 0; - if (typeof op === "number") { + if (/* tag */typeof op === "number" || typeof op === "string") { switch (op) { case /* EQUAL */26 : case /* GREATER */34 : @@ -23034,13 +23174,13 @@ function directive_parse(token_with_comments, lexbuf) { return true; } let exit$1 = 0; - if (typeof lhs === "number" || lhs.TAG !== /* Dir_string */3) { + if (/* tag */typeof lhs === "number" || typeof lhs === "string" || lhs.TAG !== /* Dir_string */3) { exit$1 = 2; } else { const curr_loc = curr(lexbuf); const rhs = value_of_token(curr_loc, token(undefined)); let exit$2 = 0; - if (typeof rhs === "number") { + if (/* tag */typeof rhs === "number" || typeof rhs === "string") { exit$2 = 3; } else { if (rhs.TAG === /* Dir_string */3) { @@ -23198,7 +23338,7 @@ function directive_parse(token_with_comments, lexbuf) { if (exit === 1) { let f; let exit$4 = 0; - if (typeof op === "number") { + if (/* tag */typeof op === "number" || typeof op === "string") { switch (op) { case /* EQUAL */26 : f = Caml_obj.caml_equal; @@ -23249,21 +23389,29 @@ function directive_parse(token_with_comments, lexbuf) { const parse_relation = function (calc) { const curr_token = token(undefined); const curr_loc = curr(lexbuf); - if (typeof curr_token === "number") { + if (/* tag */typeof curr_token === "number" || typeof curr_token === "string") { switch (curr_token) { case /* FALSE */29 : return false; case /* LPAREN */54 : const v = parse_or_aux(calc, parse_and_aux(calc, parse_relation(calc))); const match = token(undefined); - if (match === 81) { - return v; + if (/* tag */typeof match === "number" || typeof match === "string") { + if (match === /* RPAREN */81) { + return v; + } + throw new Caml_js_exceptions.MelangeError($$Error$4, { + MEL_EXN_ID: $$Error$4, + _1: /* Unterminated_paren_in_conditional */1, + _2: curr(lexbuf) + }); + } else { + throw new Caml_js_exceptions.MelangeError($$Error$4, { + MEL_EXN_ID: $$Error$4, + _1: /* Unterminated_paren_in_conditional */1, + _2: curr(lexbuf) + }); } - throw new Caml_js_exceptions.MelangeError($$Error$4, { - MEL_EXN_ID: $$Error$4, - _1: /* Unterminated_paren_in_conditional */1, - _2: curr(lexbuf) - }); case /* TRUE */91 : return true; default: @@ -23274,7 +23422,7 @@ function directive_parse(token_with_comments, lexbuf) { }); } } else { - switch (curr_token.TAG | 0) { + switch (curr_token.TAG) { case /* FLOAT */1 : return token_op(calc, (function (e) { throw new Caml_js_exceptions.MelangeError($$Error$4, { @@ -23320,7 +23468,7 @@ function directive_parse(token_with_comments, lexbuf) { } const t = token(undefined); const loc = curr(lexbuf); - if (typeof t === "number") { + if (/* tag */typeof t === "number" || typeof t === "string") { throw new Caml_js_exceptions.MelangeError($$Error$4, { MEL_EXN_ID: $$Error$4, _1: /* Unexpected_token_in_conditional */4, @@ -23364,7 +23512,7 @@ function directive_parse(token_with_comments, lexbuf) { const value_v = query(curr_loc, curr_token._0); return token_op(calc, (function (e) { push(e); - if (typeof value_v !== "number" && value_v.TAG === /* Dir_bool */0) { + if (!/* tag */(typeof value_v === "number" || typeof value_v === "string") && value_v.TAG === /* Dir_bool */0) { return value_v._0; } const ty = type_of_directive(value_v); @@ -23389,50 +23537,64 @@ function directive_parse(token_with_comments, lexbuf) { }; const parse_and_aux = function (calc, v) { const e = token(undefined); - if (typeof e === "number") { - if (e) { - push(e); - return v; - } - const calc$1 = calc && v; - const b = parse_and_aux(calc$1, parse_relation(calc$1)); - if (v) { - return b; - } else { - return false; + if (/* tag */typeof e === "number" || typeof e === "string") { + if (e === /* AMPERAMPER */0) { + const calc$1 = calc && v; + const b = parse_and_aux(calc$1, parse_relation(calc$1)); + if (v) { + return b; + } else { + return false; + } } + push(e); + return v; + } else { + push(e); + return v; } - push(e); - return v; }; const parse_or_aux = function (calc, v) { const e = token(undefined); - if (e === 8) { - const calc$1 = calc && !v; - const b = parse_or_aux(calc$1, parse_and_aux(calc$1, parse_relation(calc$1))); - if (v) { - return true; - } else { - return b; + if (/* tag */typeof e === "number" || typeof e === "string") { + if (e === /* BARBAR */8) { + const calc$1 = calc && !v; + const b = parse_or_aux(calc$1, parse_and_aux(calc$1, parse_relation(calc$1))); + if (v) { + return true; + } else { + return b; + } } + push(e); + return v; + } else { + push(e); + return v; } - push(e); - return v; }; const v = parse_or_aux(true, parse_and_aux(true, parse_relation(true))); const match = token(undefined); - if (match === 88) { - return v; + if (/* tag */typeof match === "number" || typeof match === "string") { + if (match === /* THEN */88) { + return v; + } + throw new Caml_js_exceptions.MelangeError($$Error$4, { + MEL_EXN_ID: $$Error$4, + _1: /* Expect_hash_then_in_conditional */5, + _2: curr(lexbuf) + }); + } else { + throw new Caml_js_exceptions.MelangeError($$Error$4, { + MEL_EXN_ID: $$Error$4, + _1: /* Expect_hash_then_in_conditional */5, + _2: curr(lexbuf) + }); } - throw new Caml_js_exceptions.MelangeError($$Error$4, { - MEL_EXN_ID: $$Error$4, - _1: /* Expect_hash_then_in_conditional */5, - _2: curr(lexbuf) - }); } function is_elif(i) { - if (typeof i === "number" || !(i.TAG === /* LIDENT */11 && i._0 === "elif")) { + if (/* tag */typeof i === "number" || typeof i === "string" || !(i.TAG === /* LIDENT */11 && i._0 === "elif")) { return false; } else { return true; @@ -24044,10 +24206,11 @@ function add_docstring_comment(ds) { } function report_error$2(ppf, c) { - if (typeof c === "number") { + if (/* tag */typeof c === "number" || typeof c === "string") { switch (c) { case /* Unterminated_string */0 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "String literal not terminated", @@ -24056,7 +24219,8 @@ function report_error$2(ppf, c) { _1: "String literal not terminated" }); case /* Unterminated_paren_in_conditional */1 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unterminated parens in conditional predicate", @@ -24065,7 +24229,8 @@ function report_error$2(ppf, c) { _1: "Unterminated parens in conditional predicate" }); case /* Unterminated_if */2 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "#if not terminated", @@ -24074,7 +24239,8 @@ function report_error$2(ppf, c) { _1: "#if not terminated" }); case /* Unterminated_else */3 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "#else not terminated", @@ -24083,7 +24249,8 @@ function report_error$2(ppf, c) { _1: "#else not terminated" }); case /* Unexpected_token_in_conditional */4 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unexpected token in conditional predicate", @@ -24092,7 +24259,8 @@ function report_error$2(ppf, c) { _1: "Unexpected token in conditional predicate" }); case /* Expect_hash_then_in_conditional */5 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Expect `then` after conditional predicate", @@ -24101,7 +24269,8 @@ function report_error$2(ppf, c) { _1: "Expect `then` after conditional predicate" }); case /* Unexpected_directive */6 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unexpected directive", @@ -24112,9 +24281,10 @@ function report_error$2(ppf, c) { } } else { - switch (c.TAG | 0) { + switch (c.TAG) { case /* Illegal_character */0 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Illegal character (", @@ -24131,7 +24301,8 @@ function report_error$2(ppf, c) { _1: "Illegal character (%s)" }), Stdlib__Char.escaped(c._0)); case /* Illegal_escape */1 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Illegal backslash escape in string or character (", @@ -24148,7 +24319,8 @@ function report_error$2(ppf, c) { _1: "Illegal backslash escape in string or character (%s)" }), c._0); case /* Unterminated_comment */2 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Comment not terminated", @@ -24157,7 +24329,8 @@ function report_error$2(ppf, c) { _1: "Comment not terminated" }); case /* Unterminated_string_in_comment */3 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This comment contains an unterminated string literal", @@ -24177,7 +24350,8 @@ function report_error$2(ppf, c) { _1: "This comment contains an unterminated string literal@.%aString literal begins here" }), print_error, c._1); case /* Keyword_as_label */4 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '`' */96, @@ -24194,7 +24368,8 @@ function report_error$2(ppf, c) { _1: "`%s' is a keyword, it cannot be used as label name" }), c._0); case /* Literal_overflow */5 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Integer literal exceeds the range of representable integers of type ", @@ -24207,7 +24382,8 @@ function report_error$2(ppf, c) { _1: "Integer literal exceeds the range of representable integers of type %s" }), c._0); case /* Illegal_semver */6 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Illegal semantic version string ", @@ -24220,7 +24396,8 @@ function report_error$2(ppf, c) { _1: "Illegal semantic version string %s" }), c._0); case /* Conditional_expr_expected_type */7 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Conditional expression type mismatch (", @@ -24900,37 +25077,39 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { catch (raw_exn){ const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); if (exn.MEL_EXN_ID === $$Error$4) { - const match$1 = exn._1; - if (typeof match$1 === "number") { - if (match$1) { - throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); - } - const match$2 = comment_start_loc.contents; - if (match$2) { - const start = Stdlib__List.hd(Stdlib__List.rev(comment_start_loc.contents)); - comment_start_loc.contents = /* [] */0; - throw new Caml_js_exceptions.MelangeError($$Error$4, { - MEL_EXN_ID: $$Error$4, - _1: { - TAG: /* Unterminated_string_in_comment */3, - _0: start, - _1: exn._2 - }, - _2: match$2.hd + let tmp = exn._1; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + if (tmp === /* Unterminated_string */0) { + const match$1 = comment_start_loc.contents; + if (match$1) { + const start = Stdlib__List.hd(Stdlib__List.rev(comment_start_loc.contents)); + comment_start_loc.contents = /* [] */0; + throw new Caml_js_exceptions.MelangeError($$Error$4, { + MEL_EXN_ID: $$Error$4, + _1: { + TAG: /* Unterminated_string_in_comment */3, + _0: start, + _1: exn._2 + }, + _2: match$1.hd + }); + } + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/test/ocaml_typedtree_test.ml", + 26861, + 18 + ] }); } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/test/ocaml_typedtree_test.ml", - 26861, - 18 - ] - }); + throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); + } else { + throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } + } else { throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } - throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } is_in_string.contents = false; store_string_char(/* '"' */34); @@ -24948,37 +25127,39 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { catch (raw_exn$1){ const exn$1 = Caml_js_exceptions.internalToOCamlException(raw_exn$1); if (exn$1.MEL_EXN_ID === $$Error$4) { - const match$3 = exn$1._1; - if (typeof match$3 === "number") { - if (match$3) { - throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); - } - const match$4 = comment_start_loc.contents; - if (match$4) { - const start$1 = Stdlib__List.hd(Stdlib__List.rev(comment_start_loc.contents)); - comment_start_loc.contents = /* [] */0; - throw new Caml_js_exceptions.MelangeError($$Error$4, { - MEL_EXN_ID: $$Error$4, - _1: { - TAG: /* Unterminated_string_in_comment */3, - _0: start$1, - _1: exn$1._2 - }, - _2: match$4.hd + let tmp$1 = exn$1._1; + if (/* tag */typeof tmp$1 === "number" || typeof tmp$1 === "string") { + if (tmp$1 === /* Unterminated_string */0) { + const match$2 = comment_start_loc.contents; + if (match$2) { + const start$1 = Stdlib__List.hd(Stdlib__List.rev(comment_start_loc.contents)); + comment_start_loc.contents = /* [] */0; + throw new Caml_js_exceptions.MelangeError($$Error$4, { + MEL_EXN_ID: $$Error$4, + _1: { + TAG: /* Unterminated_string_in_comment */3, + _0: start$1, + _1: exn$1._2 + }, + _2: match$2.hd + }); + } + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/test/ocaml_typedtree_test.ml", + 26884, + 18 + ] }); } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/test/ocaml_typedtree_test.ml", - 26884, - 18 - ] - }); + throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); + } else { + throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); } + } else { throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); } - throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); } is_in_string.contents = false; store_string_char(/* '|' */124); @@ -24992,8 +25173,8 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { ___ocaml_lex_state = 132; continue ; case 10 : - const match$5 = comment_start_loc.contents; - if (match$5) { + const match$3 = comment_start_loc.contents; + if (match$3) { const start$2 = Stdlib__List.hd(Stdlib__List.rev(comment_start_loc.contents)); comment_start_loc.contents = /* [] */0; throw new Caml_js_exceptions.MelangeError($$Error$4, { @@ -25002,7 +25183,7 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { TAG: /* Unterminated_comment */2, _0: start$2 }, - _2: match$5.hd + _2: match$3.hd }); } throw new Caml_js_exceptions.MelangeError("Assert_failure", { @@ -25052,41 +25233,49 @@ function token_with_comments(lexbuf) { function token$1(lexbuf) { const post_pos = lexbuf.lex_curr_p; const attach = function (lines, docs, pre_pos) { - if (typeof docs === "number") { + if (/* tag */typeof docs === "number" || typeof docs === "string") { return ; } if (docs.TAG === /* After */0) { const a = docs._0; - if (lines >= 2) { - set_post_docstrings(post_pos, Stdlib__List.rev(a)); - return set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a)); - } else { - set_post_docstrings(post_pos, Stdlib__List.rev(a)); - return set_pre_docstrings(pre_pos, a); + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + break; + case /* BlankLine */2 : + set_post_docstrings(post_pos, Stdlib__List.rev(a)); + return set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a)); + } + set_post_docstrings(post_pos, Stdlib__List.rev(a)); + return set_pre_docstrings(pre_pos, a); } const b = docs._2; const f = docs._1; const a$1 = docs._0; - if (lines >= 2) { - set_post_docstrings(post_pos, Stdlib__List.rev(a$1)); - set_post_extra_docstrings(post_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); - set_floating_docstrings(pre_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); - return set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a$1)); - } else { - set_post_docstrings(post_pos, Stdlib__List.rev(a$1)); - set_post_extra_docstrings(post_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); - set_floating_docstrings(pre_pos, Stdlib__List.rev(f)); - set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a$1)); - return set_pre_docstrings(pre_pos, b); + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + break; + case /* BlankLine */2 : + set_post_docstrings(post_pos, Stdlib__List.rev(a$1)); + set_post_extra_docstrings(post_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); + set_floating_docstrings(pre_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); + return set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a$1)); + } + set_post_docstrings(post_pos, Stdlib__List.rev(a$1)); + set_post_extra_docstrings(post_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); + set_floating_docstrings(pre_pos, Stdlib__List.rev(f)); + set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a$1)); + set_pre_docstrings(pre_pos, b); }; const loop = function (_lines, _docs, lexbuf) { while(true) { const docs = _docs; const lines = _lines; const doc = token_with_comments(lexbuf); - if (typeof doc === "number") { + if (/* tag */typeof doc === "number" || typeof doc === "string") { switch (doc) { case /* SHARP */84 : if (at_bol(lexbuf)) { @@ -25099,81 +25288,93 @@ function token$1(lexbuf) { }; const if_then_else$1 = if_then_else.contents; const match = token_with_comments(lexbuf); - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { switch (match) { case /* ELSE */23 : - if (if_then_else$1) { - throw new Caml_js_exceptions.MelangeError($$Error$4, { - MEL_EXN_ID: $$Error$4, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); + switch (if_then_else$1) { + case /* Dir_if_true */0 : + break; + case /* Dir_if_false */1 : + case /* Dir_out */2 : + throw new Caml_js_exceptions.MelangeError($$Error$4, { + MEL_EXN_ID: $$Error$4, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + } break; case /* END */24 : - if (if_then_else$1 >= 2) { - throw new Caml_js_exceptions.MelangeError($$Error$4, { - MEL_EXN_ID: $$Error$4, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); + switch (if_then_else$1) { + case /* Dir_if_true */0 : + case /* Dir_if_false */1 : + if_then_else.contents = /* Dir_out */2; + return Curry._1(cont, lexbuf); + case /* Dir_out */2 : + throw new Caml_js_exceptions.MelangeError($$Error$4, { + MEL_EXN_ID: $$Error$4, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + } - if_then_else.contents = /* Dir_out */2; - return Curry._1(cont, lexbuf); case /* IF */37 : - if (if_then_else$1 >= 2) { - if (directive_parse(token_with_comments, lexbuf)) { - if_then_else.contents = /* Dir_if_true */0; - return Curry._1(cont, lexbuf); - } else { - let _param; - while(true) { - const token = token_with_comments(lexbuf); - if (Caml_obj.caml_equal(token, /* EOF */25)) { - throw new Caml_js_exceptions.MelangeError($$Error$4, { - MEL_EXN_ID: $$Error$4, - _1: /* Unterminated_if */2, - _2: curr(lexbuf) - }); - } - if (Caml_obj.caml_equal(token, /* SHARP */84) && at_bol(lexbuf)) { - const token$1 = token_with_comments(lexbuf); - if (typeof token$1 === "number") { - if (token$1 === 24 || token$1 === 23) { - if (token$1 >= 24) { - if_then_else.contents = /* Dir_out */2; - return Curry._1(cont, lexbuf); - } else { - if_then_else.contents = /* Dir_if_false */1; - return Curry._1(cont, lexbuf); - } - } - if (token$1 === 37) { + switch (if_then_else$1) { + case /* Dir_if_true */0 : + case /* Dir_if_false */1 : + throw new Caml_js_exceptions.MelangeError($$Error$4, { + MEL_EXN_ID: $$Error$4, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + case /* Dir_out */2 : + if (directive_parse(token_with_comments, lexbuf)) { + if_then_else.contents = /* Dir_if_true */0; + return Curry._1(cont, lexbuf); + } else { + let _param; + while(true) { + const token = token_with_comments(lexbuf); + if (Caml_obj.caml_equal(token, /* EOF */25)) { throw new Caml_js_exceptions.MelangeError($$Error$4, { MEL_EXN_ID: $$Error$4, - _1: /* Unexpected_directive */6, + _1: /* Unterminated_if */2, _2: curr(lexbuf) }); } - - } - if (is_elif(token$1) && directive_parse(token_with_comments, lexbuf)) { - if_then_else.contents = /* Dir_if_true */0; - return Curry._1(cont, lexbuf); - } - _param = undefined; - continue ; + if (Caml_obj.caml_equal(token, /* SHARP */84) && at_bol(lexbuf)) { + const token$1 = token_with_comments(lexbuf); + if (/* tag */typeof token$1 === "number" || typeof token$1 === "string") { + switch (token$1) { + case /* ELSE */23 : + if_then_else.contents = /* Dir_if_false */1; + return Curry._1(cont, lexbuf); + case /* END */24 : + if_then_else.contents = /* Dir_out */2; + return Curry._1(cont, lexbuf); + case /* IF */37 : + throw new Caml_js_exceptions.MelangeError($$Error$4, { + MEL_EXN_ID: $$Error$4, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + default: + + } + } + if (is_elif(token$1) && directive_parse(token_with_comments, lexbuf)) { + if_then_else.contents = /* Dir_if_true */0; + return Curry._1(cont, lexbuf); + } + _param = undefined; + continue ; + } + _param = undefined; + continue ; + }; } - _param = undefined; - continue ; - }; - } + } - throw new Caml_js_exceptions.MelangeError($$Error$4, { - MEL_EXN_ID: $$Error$4, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); default: return Curry._1(look_ahead, match); } @@ -25184,145 +25385,200 @@ function token$1(lexbuf) { if (match._0 !== "elif") { return Curry._1(look_ahead, match); } - if (if_then_else$1) { - throw new Caml_js_exceptions.MelangeError($$Error$4, { - MEL_EXN_ID: $$Error$4, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); + switch (if_then_else$1) { + case /* Dir_if_true */0 : + break; + case /* Dir_if_false */1 : + case /* Dir_out */2 : + throw new Caml_js_exceptions.MelangeError($$Error$4, { + MEL_EXN_ID: $$Error$4, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + } - - } - if (if_then_else$1) { - return Curry._1(look_ahead, match); } - let _else_seen = Caml_obj.caml_equal(match, /* ELSE */23); - while(true) { - const else_seen = _else_seen; - const token$2 = token_with_comments(lexbuf); - if (Caml_obj.caml_equal(token$2, /* EOF */25)) { - throw new Caml_js_exceptions.MelangeError($$Error$4, { - MEL_EXN_ID: $$Error$4, - _1: /* Unterminated_else */3, - _2: curr(lexbuf) - }); - } - if (Caml_obj.caml_equal(token$2, /* SHARP */84) && at_bol(lexbuf)) { - const token$3 = token_with_comments(lexbuf); - if (typeof token$3 === "number") { - if (token$3 === 24 || token$3 === 23) { - if (token$3 >= 24) { - if_then_else.contents = /* Dir_out */2; - return Curry._1(cont, lexbuf); - } - if (else_seen) { + switch (if_then_else$1) { + case /* Dir_if_true */0 : + let _else_seen = Caml_obj.caml_equal(match, /* ELSE */23); + while(true) { + const else_seen = _else_seen; + const token$2 = token_with_comments(lexbuf); + if (Caml_obj.caml_equal(token$2, /* EOF */25)) { throw new Caml_js_exceptions.MelangeError($$Error$4, { MEL_EXN_ID: $$Error$4, - _1: /* Unexpected_directive */6, + _1: /* Unterminated_else */3, _2: curr(lexbuf) }); } - _else_seen = true; + if (Caml_obj.caml_equal(token$2, /* SHARP */84) && at_bol(lexbuf)) { + const token$3 = token_with_comments(lexbuf); + if (/* tag */typeof token$3 === "number" || typeof token$3 === "string") { + switch (token$3) { + case /* ELSE */23 : + if (else_seen) { + throw new Caml_js_exceptions.MelangeError($$Error$4, { + MEL_EXN_ID: $$Error$4, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + } + _else_seen = true; + continue ; + case /* END */24 : + if_then_else.contents = /* Dir_out */2; + return Curry._1(cont, lexbuf); + case /* IF */37 : + throw new Caml_js_exceptions.MelangeError($$Error$4, { + MEL_EXN_ID: $$Error$4, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + default: + + } + } + if (else_seen && is_elif(token$3)) { + throw new Caml_js_exceptions.MelangeError($$Error$4, { + MEL_EXN_ID: $$Error$4, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + } + continue ; + } continue ; - } - if (token$3 === 37) { - throw new Caml_js_exceptions.MelangeError($$Error$4, { - MEL_EXN_ID: $$Error$4, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); - } - - } - if (else_seen && is_elif(token$3)) { - throw new Caml_js_exceptions.MelangeError($$Error$4, { - MEL_EXN_ID: $$Error$4, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); - } - continue ; - } - continue ; - }; + }; + case /* Dir_if_false */1 : + case /* Dir_out */2 : + return Curry._1(look_ahead, match); + + } } break; case /* EOL */100 : - const lines$p = lines ? /* BlankLine */2 : /* NewLine */1; + let lines$p; + switch (lines) { + case /* NoLine */0 : + lines$p = /* NewLine */1; + break; + case /* NewLine */1 : + case /* BlankLine */2 : + lines$p = /* BlankLine */2; + break; + + } _lines = lines$p; continue ; default: } } else { - switch (doc.TAG | 0) { + switch (doc.TAG) { case /* COMMENT */18 : const match$1 = doc._0; add_comment([ match$1[0], match$1[1] ]); - const lines$p$1 = lines >= 2 ? /* BlankLine */2 : /* NoLine */0; + let lines$p$1; + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + lines$p$1 = /* NoLine */0; + break; + case /* BlankLine */2 : + lines$p$1 = /* BlankLine */2; + break; + + } _lines = lines$p$1; continue ; case /* DOCSTRING */19 : const doc$1 = doc._0; add_docstring_comment(doc$1); let docs$p; - if (typeof docs === "number") { - docs$p = lines >= 2 ? ({ - TAG: /* Before */1, - _0: /* [] */0, - _1: /* [] */0, - _2: { - hd: doc$1, - tl: /* [] */0 - } - }) : ({ - TAG: /* After */0, - _0: { - hd: doc$1, - tl: /* [] */0 - } - }); + if (/* tag */typeof docs === "number" || typeof docs === "string") { + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + docs$p = { + TAG: /* After */0, + _0: { + hd: doc$1, + tl: /* [] */0 + } + }; + break; + case /* BlankLine */2 : + docs$p = { + TAG: /* Before */1, + _0: /* [] */0, + _1: /* [] */0, + _2: { + hd: doc$1, + tl: /* [] */0 + } + }; + break; + + } } else if (docs.TAG === /* After */0) { const a = docs._0; - docs$p = lines >= 2 ? ({ - TAG: /* Before */1, - _0: a, - _1: /* [] */0, - _2: { - hd: doc$1, - tl: /* [] */0 - } - }) : ({ - TAG: /* After */0, - _0: { - hd: doc$1, - tl: a - } - }); + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + docs$p = { + TAG: /* After */0, + _0: { + hd: doc$1, + tl: a + } + }; + break; + case /* BlankLine */2 : + docs$p = { + TAG: /* Before */1, + _0: a, + _1: /* [] */0, + _2: { + hd: doc$1, + tl: /* [] */0 + } + }; + break; + + } } else { const b = docs._2; const f = docs._1; const a$1 = docs._0; - docs$p = lines >= 2 ? ({ - TAG: /* Before */1, - _0: a$1, - _1: Stdlib.$at(b, f), - _2: { - hd: doc$1, - tl: /* [] */0 - } - }) : ({ - TAG: /* Before */1, - _0: a$1, - _1: f, - _2: { - hd: doc$1, - tl: b - } - }); + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + docs$p = { + TAG: /* Before */1, + _0: a$1, + _1: f, + _2: { + hd: doc$1, + tl: b + } + }; + break; + case /* BlankLine */2 : + docs$p = { + TAG: /* Before */1, + _0: a$1, + _1: Stdlib.$at(b, f), + _2: { + hd: doc$1, + tl: /* [] */0 + } + }; + break; + + } } _docs = docs$p; _lines = /* NoLine */0; @@ -25361,23 +25617,28 @@ function skip_phrase(lexbuf) { while(true) { try { const match = token$1(lexbuf); - if (typeof match === "number" && !(match !== 25 && match !== 83)) { - return ; - } else { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { return skip_phrase(lexbuf); } + switch (match) { + case /* EOF */25 : + case /* SEMISEMI */83 : + return ; + default: + return skip_phrase(lexbuf); + } } catch (raw_exn){ const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); if (exn.MEL_EXN_ID === $$Error$4) { let tmp = exn._1; - if (typeof tmp === "number") { + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { if (tmp === /* Unterminated_string */0) { continue ; } throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } else { - switch (tmp.TAG | 0) { + switch (tmp.TAG) { case /* Illegal_character */0 : case /* Unterminated_comment */2 : case /* Unterminated_string_in_comment */3 : @@ -25414,7 +25675,7 @@ function wrap$1(parsing_fun, lexbuf) { const err = Caml_js_exceptions.internalToOCamlException(raw_err); if (err.MEL_EXN_ID === $$Error$4) { let tmp = err._1; - if (typeof tmp === "number") { + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { throw new Caml_js_exceptions.MelangeError(err.MEL_EXN_ID, err); } if (tmp.TAG === /* Illegal_character */0) { @@ -25453,10 +25714,10 @@ function wrap$1(parsing_fun, lexbuf) { } function iter_pattern_desc(f, patl) { - if (typeof patl === "number") { + if (/* tag */typeof patl === "number" || typeof patl === "string") { return ; } - switch (patl.TAG | 0) { + switch (patl.TAG) { case /* Tpat_construct */4 : return Stdlib__List.iter(f, patl._2); case /* Tpat_variant */5 : @@ -25480,10 +25741,10 @@ function iter_pattern_desc(f, patl) { } function map_pattern_desc(f, d) { - if (typeof d === "number") { + if (/* tag */typeof d === "number" || typeof d === "string") { return d; } - switch (d.TAG | 0) { + switch (d.TAG) { case /* Tpat_alias */1 : return { TAG: /* Tpat_alias */1, @@ -25557,10 +25818,10 @@ function bound_idents(_pat) { while(true) { const pat = _pat; const d = pat.pat_desc; - if (typeof d === "number") { + if (/* tag */typeof d === "number" || typeof d === "string") { return iter_pattern_desc(bound_idents, d); } - switch (d.TAG | 0) { + switch (d.TAG) { case /* Tpat_var */0 : idents.contents = { hd: [ @@ -25615,8 +25876,8 @@ function let_bound_idents(pat) { function alpha_pat(env, p) { const d = p.pat_desc; - if (typeof d !== "number") { - switch (d.TAG | 0) { + if (!/* tag */(typeof d === "number" || typeof d === "string")) { + switch (d.TAG) { case /* Tpat_var */0 : let tmp; try { @@ -25852,10 +26113,10 @@ function TypedtreeMap_MakeMap(funarg) { const ct$1 = Curry._1(funarg.enter_core_type, ct); const list = ct$1.ctyp_desc; let ctyp_desc; - if (typeof list === "number") { + if (/* tag */typeof list === "number" || typeof list === "string") { ctyp_desc = ct$1.ctyp_desc; } else { - switch (list.TAG | 0) { + switch (list.TAG) { case /* Ttyp_var */0 : ctyp_desc = ct$1.ctyp_desc; break; @@ -25945,7 +26206,7 @@ function TypedtreeMap_MakeMap(funarg) { const mty$1 = Curry._1(funarg.enter_module_type, mty); const sg = mty$1.mty_desc; let mty_desc; - switch (sg.TAG | 0) { + switch (sg.TAG) { case /* Tmty_signature */1 : mty_desc = { TAG: /* Tmty_signature */1, @@ -25998,7 +26259,7 @@ function TypedtreeMap_MakeMap(funarg) { const exp$1 = Curry._1(funarg.enter_expression, exp); const list = exp$1.exp_desc; let exp_desc; - switch (list.TAG | 0) { + switch (list.TAG) { case /* Texp_let */2 : const rec_flag = list._0; exp_desc = { @@ -26229,7 +26490,7 @@ function TypedtreeMap_MakeMap(funarg) { const mexpr$1 = Curry._1(funarg.enter_module_expr, mexpr); const st = mexpr$1.mod_desc; let mod_desc; - switch (st.TAG | 0) { + switch (st.TAG) { case /* Tmod_ident */0 : mod_desc = mexpr$1.mod_desc; break; @@ -26260,19 +26521,20 @@ function TypedtreeMap_MakeMap(funarg) { const mtype = st._2; const mod_type = st._1; const mexpr$2 = st._0; - mod_desc = mtype ? ({ + mod_desc = /* tag */typeof mtype === "number" || typeof mtype === "string" ? ({ TAG: /* Tmod_constraint */4, _0: map_module_expr(mexpr$2), _1: mod_type, - _2: /* Tmodtype_explicit */{ - _0: map_module_type(mtype._0) - }, + _2: /* Tmodtype_implicit */0, _3: st._3 }) : ({ TAG: /* Tmod_constraint */4, _0: map_module_expr(mexpr$2), _1: mod_type, - _2: /* Tmodtype_implicit */0, + _2: { + TAG: /* Tmodtype_explicit */0, + _0: map_module_type(mtype._0) + }, _3: st._3 }); break; @@ -26303,7 +26565,7 @@ function TypedtreeMap_MakeMap(funarg) { const ct$1 = Curry._1(funarg.enter_class_type, ct); const csg = ct$1.cltyp_desc; let cltyp_desc; - switch (csg.TAG | 0) { + switch (csg.TAG) { case /* Tcty_constr */0 : cltyp_desc = { TAG: /* Tcty_constr */0, @@ -26339,7 +26601,7 @@ function TypedtreeMap_MakeMap(funarg) { const map_with_constraint = function (cstr) { const cstr$1 = Curry._1(funarg.enter_with_constraint, cstr); let tmp; - switch (cstr$1.TAG | 0) { + switch (cstr$1.TAG) { case /* Twith_type */0 : tmp = { TAG: /* Twith_type */0, @@ -26430,7 +26692,7 @@ function TypedtreeMap_MakeMap(funarg) { const attrs = exp_extra[2]; const loc = exp_extra[1]; const desc = exp_extra[0]; - switch (desc.TAG | 0) { + switch (desc.TAG) { case /* Texp_constraint */0 : return [ { @@ -26497,7 +26759,7 @@ function TypedtreeMap_MakeMap(funarg) { const cf$1 = Curry._1(funarg.enter_class_field, cf); const exp = cf$1.cf_desc; let cf_desc; - switch (exp.TAG | 0) { + switch (exp.TAG) { case /* Tcf_inherit */0 : cf_desc = { TAG: /* Tcf_inherit */0, @@ -26587,10 +26849,10 @@ function TypedtreeMap_MakeMap(funarg) { const pat$1 = Curry._1(funarg.enter_pattern, pat); const list = pat$1.pat_desc; let pat_desc; - if (typeof list === "number") { + if (/* tag */typeof list === "number" || typeof list === "string") { pat_desc = pat$1.pat_desc; } else { - switch (list.TAG | 0) { + switch (list.TAG) { case /* Tpat_alias */1 : const pat1 = map_pattern(list._0); pat_desc = { @@ -26675,7 +26937,7 @@ function TypedtreeMap_MakeMap(funarg) { const item$1 = Curry._1(funarg.enter_signature_item, item); const vd = item$1.sig_desc; let sig_desc; - switch (vd.TAG | 0) { + switch (vd.TAG) { case /* Tsig_value */0 : sig_desc = { TAG: /* Tsig_value */0, @@ -26775,7 +27037,7 @@ function TypedtreeMap_MakeMap(funarg) { const cexpr$1 = Curry._1(funarg.enter_class_expr, cexpr); const clstr = cexpr$1.cl_desc; let cl_desc; - switch (clstr.TAG | 0) { + switch (clstr.TAG) { case /* Tcl_ident */0 : cl_desc = { TAG: /* Tcl_ident */0, @@ -26866,7 +27128,7 @@ function TypedtreeMap_MakeMap(funarg) { }; const map_pat_extra = function (pat_extra) { const ct = pat_extra[0]; - if (typeof ct === "number" || ct.TAG !== /* Tpat_constraint */0) { + if (/* tag */typeof ct === "number" || typeof ct === "string" || ct.TAG !== /* Tpat_constraint */0) { return pat_extra; } else { return [ @@ -26919,7 +27181,7 @@ function TypedtreeMap_MakeMap(funarg) { }), decl$1.typ_cstrs); const list = decl$1.typ_kind; let typ_kind; - if (typeof list === "number") { + if (/* tag */typeof list === "number" || typeof list === "string") { typ_kind = list === /* Ttype_abstract */0 ? /* Ttype_abstract */0 : /* Ttype_open */1; } else if (list.TAG === /* Ttype_variant */0) { const list$1 = Stdlib__List.map(map_constructor_declaration, list._0); @@ -27035,7 +27297,7 @@ function TypedtreeMap_MakeMap(funarg) { const item$1 = Curry._1(funarg.enter_structure_item, item); const vd = item$1.str_desc; let str_desc; - switch (vd.TAG | 0) { + switch (vd.TAG) { case /* Tstr_eval */0 : str_desc = { TAG: /* Tstr_eval */0, @@ -27194,7 +27456,7 @@ function TypedtreeMap_MakeMap(funarg) { const ctf$1 = Curry._1(funarg.enter_class_type_field, ctf); const ct = ctf$1.ctf_desc; let ctf_desc; - switch (ct.TAG | 0) { + switch (ct.TAG) { case /* Tctf_inherit */0 : ctf_desc = { TAG: /* Tctf_inherit */0, @@ -27449,7 +27711,7 @@ const ClearEnv = Curry._1(TypedtreeMap_MakeMap, { }); function clear_part(p) { - switch (p.TAG | 0) { + switch (p.TAG) { case /* Partial_structure */0 : return { TAG: /* Partial_structure */0, @@ -27498,7 +27760,7 @@ function clear_env(binary_annots) { if (!need_to_clear_env) { return binary_annots; } - switch (binary_annots.TAG | 0) { + switch (binary_annots.TAG) { case /* Packed */0 : return binary_annots; case /* Implementation */1 : @@ -27636,7 +27898,8 @@ const Tags = /* @__PURE__ */Caml_exceptions.create("Ocaml_typedtree_test.Ctype.T register_error_of_exn(function (param) { if (param.MEL_EXN_ID === Tags) { - return Curry._2(errorf(in_file(input_name.contents), undefined, undefined, /* Format */{ + return Curry._2(errorf(in_file(input_name.contents), undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "In this program,", @@ -27794,7 +28057,7 @@ function increase_global_level(param) { function is_object_type(path) { let name; - switch (path.TAG | 0) { + switch (path.TAG) { case /* Pident */0 : name = path._0.name; break; @@ -27948,7 +28211,7 @@ function set_mode_pattern(generate, injective, f) { } function in_current_module(param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Pident */0 : return true; case /* Pdot */1 : @@ -27977,7 +28240,7 @@ function in_pervasives(p) { function is_datatype(decl) { const match = decl.type_kind; - if (typeof match === "number" && !match) { + if (/* tag */(typeof match === "number" || typeof match === "string") && match === /* Type_abstract */0) { return false; } else { return true; @@ -27986,7 +28249,7 @@ function is_datatype(decl) { function object_fields(ty) { const match = repr(ty).desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -28016,7 +28279,7 @@ function flatten_fields(ty) { const l = _l; const ty$1 = repr(ty); const match = ty$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return [ l, ty$1 @@ -28152,10 +28415,10 @@ function object_row(_ty) { const ty = _ty; const ty$1 = repr(ty); const match = ty$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return ty$1; } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tobject */4 : _ty = match._0; continue ; @@ -28170,10 +28433,10 @@ function object_row(_ty) { function opened_object(ty) { const match = object_row(ty).desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return false; } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tvar */0 : case /* Tconstr */3 : case /* Tunivar */9 : @@ -28185,7 +28448,7 @@ function opened_object(ty) { function concrete_object(ty) { const match = object_row(ty).desc; - if (typeof match === "number" || match.TAG !== /* Tvar */0) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tvar */0) { return true; } else { return false; @@ -28194,7 +28457,7 @@ function concrete_object(ty) { function close_object(ty) { const match = repr(ty).desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -28210,7 +28473,7 @@ function close_object(ty) { const ty$1 = _ty; const ty$2 = repr(ty$1); const match$1 = ty$2.desc; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -28220,7 +28483,7 @@ function close_object(ty) { ] }); } - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : return link_type(ty$2, newty2(ty$2.level, /* Tnil */0)); case /* Tfield */5 : @@ -28250,7 +28513,7 @@ function close_object(ty) { function row_variable(ty) { const match = repr(ty).desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -28266,7 +28529,7 @@ function row_variable(ty) { const ty$1 = _ty; const ty$2 = repr(ty$1); const match$1 = ty$2.desc; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -28276,7 +28539,7 @@ function row_variable(ty) { ] }); } - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : return ty$2; case /* Tfield */5 : @@ -28306,7 +28569,7 @@ function row_variable(ty) { function set_object_name(id, rv, params, ty) { const match = repr(ty).desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -28340,7 +28603,7 @@ function set_object_name(id, rv, params, ty) { function hide_private_methods(ty) { const match = repr(ty).desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -28355,7 +28618,7 @@ function hide_private_methods(ty) { const match$1 = flatten_fields(match._0); return Stdlib__List.iter((function (param) { const r = field_kind_repr(param[1]); - if (typeof r === "number") { + if (/* tag */typeof r === "number" || typeof r === "string") { return ; } else { return set_kind(r._0, /* Fabsent */1); @@ -28375,7 +28638,7 @@ function hide_private_methods(ty) { function signature_of_class_type(_sign) { while(true) { const sign = _sign; - switch (sign.TAG | 0) { + switch (sign.TAG) { case /* Cty_signature */1 : return sign._0; case /* Cty_constr */0 : @@ -28390,7 +28653,7 @@ function signature_of_class_type(_sign) { function class_type_arity(_param) { while(true) { const param = _param; - switch (param.TAG | 0) { + switch (param.TAG) { case /* Cty_constr */0 : _param = param._2; continue ; @@ -28512,7 +28775,7 @@ function filter_row_fields(erase, param) { const p = param.hd; const fi = filter_row_fields(erase, param.tl); const match = row_field_repr_aux(/* [] */0, p[1]); - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return fi; } else if (match.TAG === /* Rpresent */0 || match._2 || !erase) { return { @@ -28537,10 +28800,10 @@ function closed_schema_rec(_ty) { const level = ty$1.level; ty$1.level = pivot_level - level | 0; const row = ty$1.desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { return iter_type_expr(closed_schema_rec, ty$1); } - switch (row.TAG | 0) { + switch (row.TAG) { case /* Tvar */0 : if (level !== 100000000) { throw new Caml_js_exceptions.MelangeError(Non_closed0, { @@ -28605,12 +28868,12 @@ function free_vars_rec(_real, _ty) { ty$1.level = pivot_level - ty$1.level | 0; const match = ty$1.desc; const match$1 = really_closed.contents; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return iter_type_expr((function (param) { return free_vars_rec(true, param); }), ty$1); } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tvar */0 : free_variables.contents = { hd: [ @@ -28732,7 +28995,7 @@ function closed_type_decl(decl) { try { Stdlib__List.iter(mark_type, decl.type_params); const v = decl.type_kind; - if (typeof v === "number") { + if (/* tag */typeof v === "number" || typeof v === "string") { v === /* Type_abstract */0; } else if (v.TAG === /* Type_record */0) { Stdlib__List.iter((function (l) { @@ -28855,7 +29118,7 @@ function iter_generalize(tyl, ty) { } set_level(ty$1, 100000000); const match = ty$1.desc; - if (typeof match !== "number" && match.TAG === /* Tconstr */3) { + if (!/* tag */(typeof match === "number" || typeof match === "string") && match.TAG === /* Tconstr */3) { iter_abbrev((function (param) { return iter_generalize(tyl, param); }), match._2.contents); @@ -28888,7 +29151,7 @@ function generalize_structure(var_level, ty) { if (ty$1.level > current_level.contents) { const match = ty$1.desc; let tmp$1; - tmp$1 = typeof match === "number" || match.TAG !== /* Tconstr */3 ? true : !is_object_type(match._0) && (match._2.contents = /* Mnil */0, true); + tmp$1 = /* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tconstr */3 ? true : !is_object_type(match._0) && (match._2.contents = /* Mnil */0, true); tmp = tmp$1; } if (tmp) { @@ -28913,10 +29176,10 @@ function generalize_spine(_ty) { return ; } const match = ty$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return ; } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tarrow */1 : set_level(ty$1, 100000000); generalize_spine(match._1); @@ -29022,8 +29285,8 @@ function update_level(env, level, _ty) { }); } const row = ty$1.desc; - if (typeof row !== "number") { - switch (row.TAG | 0) { + if (!/* tag */(typeof row === "number" || typeof row === "string")) { + switch (row.TAG) { case /* Tconstr */3 : const p = row._0; if (level < get_level(env, p)) { @@ -29168,12 +29431,12 @@ function generalize_expansive(env, var_level, _ty) { } set_level(ty$1, 100000000); const match = ty$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return iter_type_expr((function (param) { return generalize_expansive(env, var_level, param); }), ty$1); } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tarrow */1 : generalize_contravariant(env)(var_level, match._1); _ty = match._2; @@ -29298,7 +29561,7 @@ function limited_generalize(ty0, ty) { set_level(ty, 100000000); Stdlib__List.iter(generalize_parents, Stdlib__Hashtbl.find(graph, idx)[1].contents); const row = ty.desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { return ; } if (row.TAG !== /* Tvariant */8) { @@ -29360,7 +29623,7 @@ function compute_univars(ty) { const node_univars = Curry._1(TypeHash.create, 17); const add_univar = function (univ, inv) { const match = inv.inv_type.desc; - if (typeof match !== "number" && match.TAG === /* Tpoly */10 && Stdlib__List.memq(univ, Stdlib__List.map(repr, match._1))) { + if (!/* tag */(typeof match === "number" || typeof match === "string") && match.TAG === /* Tpoly */10 && Stdlib__List.memq(univ, Stdlib__List.map(repr, match._1))) { return ; } try { @@ -29410,17 +29673,17 @@ function compute_univars(ty) { function find_repr(p1, _param) { while(true) { const param = _param; - if (typeof param === "number") { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } if (param.TAG === /* Mcons */0) { - if (param._0) { - if (same(p1, param._1)) { - return param._2; - } + if (param._0 === /* Private */0) { _param = param._4; continue ; } + if (same(p1, param._1)) { + return param._2; + } _param = param._4; continue ; } @@ -29443,7 +29706,7 @@ function copy(env, partial, keep_names, ty) { const ty$1 = repr(ty); const ty$2 = ty$1.desc; let exit = 0; - if (typeof ty$2 === "number") { + if (/* tag */typeof ty$2 === "number" || typeof ty$2 === "string") { exit = 1; } else { if (ty$2.TAG === /* Tsubst */7) { @@ -29500,10 +29763,10 @@ function copy(env, partial, keep_names, ty) { _0: t }; let tmp; - if (typeof desc === "number") { + if (/* tag */typeof desc === "number" || typeof desc === "string") { tmp = copy_type_desc(keep_names, copy$1, desc); } else { - switch (desc.TAG | 0) { + switch (desc.TAG) { case /* Tconstr */3 : const tl = desc._1; const p = desc._0; @@ -29521,7 +29784,7 @@ function copy(env, partial, keep_names, ty) { if (exit$1 === 2) { const abbrev = abbreviations.contents.contents; let tmp$1; - tmp$1 = typeof abbrev === "number" || abbrev.TAG !== /* Mcons */0 ? abbrev : ({ + tmp$1 = /* tag */typeof abbrev === "number" || typeof abbrev === "string" || abbrev.TAG !== /* Mcons */0 ? abbrev : ({ TAG: /* Mlink */1, _0: abbreviations.contents }); @@ -29546,11 +29809,11 @@ function copy(env, partial, keep_names, ty) { break; case /* Tfield */5 : const r = field_kind_repr(desc._1); - if (typeof r === "number") { - tmp = r ? ({ + if (/* tag */typeof r === "number" || typeof r === "string") { + tmp = r === /* Fpresent */0 ? copy_type_desc(undefined, copy$1, desc) : ({ TAG: /* Tlink */6, _0: copy$1(desc._3) - }) : copy_type_desc(undefined, copy$1, desc); + }); } else { dup_kind(r._0); tmp = copy_type_desc(undefined, copy$1, desc); @@ -29561,11 +29824,11 @@ function copy(env, partial, keep_names, ty) { const more = repr(row.row_more); const match = more.desc; let exit$2 = 0; - if (typeof match === "number" || match.TAG !== /* Tsubst */7) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tsubst */7) { exit$2 = 2; } else { const match$1 = match._0.desc; - if (typeof match$1 === "number" || match$1.TAG !== /* Ttuple */2) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Ttuple */2) { exit$2 = 2; } else { const match$2 = match$1._0; @@ -29594,10 +29857,10 @@ function copy(env, partial, keep_names, ty) { const ty$4 = more.desc; let more$p; let exit$3 = 0; - if (typeof ty$4 === "number") { + if (/* tag */typeof ty$4 === "number" || typeof ty$4 === "string") { exit$3 = 3; } else { - switch (ty$4.TAG | 0) { + switch (ty$4.TAG) { case /* Tconstr */3 : exit$3 = 3; break; @@ -29635,7 +29898,7 @@ function copy(env, partial, keep_names, ty) { const match$4 = repr(more$p); const match$5 = match$4.desc; let row$1; - row$1 = typeof match$5 === "number" || !(match$5.TAG === /* Tconstr */3 && !row.row_fixed) ? row : ({ + row$1 = /* tag */typeof match$5 === "number" || typeof match$5 === "string" || !(match$5.TAG === /* Tconstr */3 && !row.row_fixed) ? row : ({ row_fields: row.row_fields, row_more: row.row_more, row_bound: row.row_bound, @@ -29657,7 +29920,7 @@ function copy(env, partial, keep_names, ty) { } const not_reither = function (param) { const match = row_field_repr_aux(/* [] */0, param[1]); - if (typeof match === "number" || match.TAG === /* Rpresent */0) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG === /* Rpresent */0) { return true; } else { return false; @@ -29768,7 +30031,8 @@ function get_new_abstract_name(s) { } } reified_var_counter.contents = Curry._3(Meths.add, s, index, reified_var_counter.contents); - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -29814,7 +30078,7 @@ function instance_constructor(in_pattern, cstr) { const match = repr(existential); const match$1 = match.desc; let name; - if (typeof match$1 === "number" || match$1.TAG !== /* Tvar */0) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Tvar */0) { name = "ex"; } else { const name$1 = match$1._0; @@ -29872,7 +30136,7 @@ function instance_parameterized_type(keep_names, sch_args, sch) { function instance_declaration(decl) { const cl = decl.type_kind; let tmp; - tmp = typeof cl === "number" ? ( + tmp = /* tag */typeof cl === "number" || typeof cl === "string" ? ( cl === /* Type_abstract */0 ? /* Type_abstract */0 : /* Type_open */1 ) : ( cl.TAG === /* Type_record */0 ? ({ @@ -29925,7 +30189,7 @@ function instance_declaration(decl) { function instance_class(params, cty) { const copy_class_type = function (sign) { - switch (sign.TAG | 0) { + switch (sign.TAG) { case /* Cty_constr */0 : return { TAG: /* Cty_constr */0, @@ -30040,10 +30304,10 @@ function copy_sep(fixed, free, bound, visited, ty) { const match$1 = ty$1.desc; let visited$1; let exit = 0; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { visited$1 = visited; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tarrow */1 : case /* Ttuple */2 : case /* Tconstr */3 : @@ -30073,10 +30337,10 @@ function copy_sep(fixed, free, bound, visited, ty) { }; const row0 = ty$1.desc; let tmp; - if (typeof row0 === "number") { + if (/* tag */typeof row0 === "number" || typeof row0 === "string") { tmp = copy_type_desc(undefined, copy_rec, ty$1.desc); } else { - switch (row0.TAG | 0) { + switch (row0.TAG) { case /* Tvariant */8 : const row = row_repr_aux(/* [] */0, row0._0); const more = repr(row.row_more); @@ -30126,7 +30390,7 @@ function instance_poly(keep_namesOpt, fixed, univars, sch) { const univars$1 = Stdlib__List.map(repr, univars); const copy_var = function (ty) { const name = ty.desc; - if (typeof name === "number") { + if (/* tag */typeof name === "number" || typeof name === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -30182,7 +30446,7 @@ function instance_label(fixed, lbl) { let match; let exit = 0; const match$1 = ty.desc; - if (typeof match$1 === "number" || match$1.TAG !== /* Tpoly */10) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Tpoly */10) { exit = 1; } else { match = instance_poly(undefined, fixed, match$1._1, match$1._0); @@ -30223,7 +30487,7 @@ function subst(env, level, priv, abbrev, ty, params, args, body) { const body0 = newvar(undefined, undefined); if (ty !== undefined) { const match = ty.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -30285,7 +30549,7 @@ function check_abbrev_env(env) { function expand_abbrev_gen(kind, find_type_expansion, env, ty) { check_abbrev_env(env); const match = ty.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -30333,7 +30597,7 @@ function expand_abbrev_gen(kind, find_type_expansion, env, ty) { const ty$p = subst(env, level, kind, abbrev, ty, match$1[0], args, match$1[1]); const ty$2 = repr(ty$p); const row = ty$2.desc; - if (typeof row !== "number" && row.TAG === /* Tvariant */8) { + if (!/* tag */(typeof row === "number" || typeof row === "string") && row.TAG === /* Tvariant */8) { const row$1 = row._0; if (static_row(row$1)) { ty$2.desc = { @@ -30442,7 +30706,7 @@ function safe_abbrev(env, ty) { function try_expand_once(env, ty) { const ty$1 = repr(ty); const match = ty$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError(Cannot_expand, { MEL_EXN_ID: Cannot_expand }); @@ -30526,7 +30790,7 @@ forward_try_expand_once.contents = try_expand_safe; function extract_concrete_typedecl(env, ty) { const ty$1 = repr(ty); const match = ty$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { MEL_EXN_ID: Stdlib.Not_found }); @@ -30573,7 +30837,7 @@ function expand_abbrev_opt(param, param$1) { function try_expand_once_opt(env, ty) { const ty$1 = repr(ty); const match = ty$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError(Cannot_expand, { MEL_EXN_ID: Cannot_expand }); @@ -30621,7 +30885,7 @@ function expand_head_opt(env, ty) { function enforce_constraints(env, ty) { const match = ty.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -30665,7 +30929,7 @@ function enforce_constraints(env, ty) { function full_expand(env, ty) { const ty$1 = repr(expand_head(env, ty)); const match = ty$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return ty$1; } if (match.TAG !== /* Tobject */4) { @@ -30706,14 +30970,14 @@ function generic_abbrev(env, path) { function generic_private_abbrev(env, path) { try { const match = find_type_full(path, env)[0]; - const match$1 = match.type_kind; - if (typeof match$1 !== "number") { + let tmp = match.type_kind; + if (!/* tag */(typeof tmp === "number" || typeof tmp === "string")) { return false; } - if (match$1) { + if (tmp !== /* Type_abstract */0) { return false; } - if (match.type_private) { + if (match.type_private !== /* Private */0) { return false; } const body = match.type_manifest; @@ -30734,7 +30998,7 @@ function generic_private_abbrev(env, path) { function is_contractive(env, ty) { const match = repr(ty).desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return true; } if (match.TAG !== /* Tconstr */3) { @@ -30766,8 +31030,8 @@ function occur_rec(env, visited, ty0, ty) { } const occur_ok = recursive_types.contents && is_contractive(env, ty); const match = ty.desc; - if (typeof match !== "number") { - switch (match.TAG | 0) { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + switch (match.TAG) { case /* Tconstr */3 : try { if (occur_ok || Stdlib__List.memq(ty, visited)) { @@ -30795,10 +31059,10 @@ function occur_rec(env, visited, ty0, ty) { } const match$1 = ty$p.desc; let exit = 0; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 2; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tobject */4 : case /* Tvariant */8 : return ; @@ -31015,12 +31279,12 @@ function occur_univar(env, ty) { return ; } const match = ty$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return iter_type_expr((function (param) { return occur_rec(bound, param); }), ty$1); } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tconstr */3 : if (!match._1) { return ; @@ -31121,10 +31385,10 @@ function univars_escape(env, univar_pairs, vl, ty) { } visited.contents = Curry._2(add$3, t$1, visited.contents); const match = t$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return iter_type_expr(occur, t$1); } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tconstr */3 : if (!match._1) { return ; @@ -31251,7 +31515,7 @@ const univar_pairs = { function has_cached_expansion(p, _abbrev) { while(true) { const abbrev = _abbrev; - if (typeof abbrev === "number") { + if (/* tag */typeof abbrev === "number" || typeof abbrev === "string") { return false; } if (abbrev.TAG === /* Mcons */0) { @@ -31385,10 +31649,10 @@ function reify(env, t) { } visited.contents = Curry._2(add$3, ty$1, visited.contents); const o = ty$1.desc; - if (typeof o === "number") { + if (/* tag */typeof o === "number" || typeof o === "string") { return iter_type_expr(iterator, ty$1); } - switch (o.TAG | 0) { + switch (o.TAG) { case /* Tvar */0 : const o$1 = o._0; const name = o$1 !== undefined ? o$1 : "ex"; @@ -31408,7 +31672,7 @@ function reify(env, t) { } else { const m = r.row_more; const o$2 = m.desc; - if (typeof o$2 === "number") { + if (/* tag */typeof o$2 === "number" || typeof o$2 === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -31486,7 +31750,7 @@ function non_aliasable(p, decl) { function expands_to_datatype(env, ty) { const ty$1 = repr(ty); const match = ty$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return false; } if (match.TAG !== /* Tconstr */3) { @@ -31527,19 +31791,19 @@ function mcomp(type_pairs, env, _t1, _t2) { const match$1 = t2$1.desc; let exit = 0; let exit$1 = 0; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { exit$1 = 2; } else { - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tvar */0 : return ; case /* Tconstr */3 : if (match._1) { exit$1 = 2; - } else if (typeof match$1 === "number") { + } else if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : exit$1 = 2; break; @@ -31563,7 +31827,7 @@ function mcomp(type_pairs, env, _t1, _t2) { } } if (exit$1 === 2) { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { if (match$1.TAG === /* Tvar */0) { @@ -31598,8 +31862,8 @@ function mcomp(type_pairs, env, _t1, _t2) { let exit$2 = 0; let p; let exit$3 = 0; - if (typeof match$2 === "number") { - if (typeof match$3 === "number") { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { return ; } if (match$3.TAG === /* Tconstr */3) { @@ -31611,15 +31875,15 @@ function mcomp(type_pairs, env, _t1, _t2) { }); } } else { - switch (match$2.TAG | 0) { + switch (match$2.TAG) { case /* Tvar */0 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (match$3.TAG | 0) { + switch (match$3.TAG) { case /* Tvar */0 : throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", @@ -31641,13 +31905,13 @@ function mcomp(type_pairs, env, _t1, _t2) { break; case /* Tarrow */1 : const l1 = match$2._0; - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (match$3.TAG | 0) { + switch (match$3.TAG) { case /* Tarrow */1 : const l2 = match$3._0; if (l1 === l2 || !(is_optional(l1) || is_optional(l2))) { @@ -31671,13 +31935,13 @@ function mcomp(type_pairs, env, _t1, _t2) { } break; case /* Ttuple */2 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (match$3.TAG | 0) { + switch (match$3.TAG) { case /* Ttuple */2 : return mcomp_list(type_pairs, env, match$2._0, match$3._0); case /* Tconstr */3 : @@ -31692,7 +31956,7 @@ function mcomp(type_pairs, env, _t1, _t2) { break; case /* Tconstr */3 : const p1 = match$2._0; - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { p = p1; exit$2 = 2; } else { @@ -31734,11 +31998,11 @@ function mcomp(type_pairs, env, _t1, _t2) { const match$4 = decl.type_kind; const match$5 = decl$p.type_kind; let exit$4 = 0; - if (typeof match$4 === "number") { + if (/* tag */typeof match$4 === "number" || typeof match$4 === "string") { if (match$4 === /* Type_abstract */0) { let exit$5 = 0; - if (typeof match$5 === "number") { - if (!match$5) { + if (/* tag */typeof match$5 === "number" || typeof match$5 === "string") { + if (match$5 === /* Type_abstract */0) { return ; } exit$5 = 2; @@ -31752,19 +32016,25 @@ function mcomp(type_pairs, env, _t1, _t2) { exit$4 = 1; } - } else if (typeof match$5 === "number") { - if (match$5) { + } else if (/* tag */typeof match$5 === "number" || typeof match$5 === "string") { + if (match$5 !== /* Type_abstract */0) { return mcomp_list(type_pairs, env, tl1, tl2); } exit$4 = 1; } else { + if (match$5.TAG === /* Type_record */0) { + throw new Caml_js_exceptions.MelangeError(Unify, { + MEL_EXN_ID: Unify, + _1: /* [] */0 + }); + } throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } } else if (match$4.TAG === /* Type_record */0) { - if (typeof match$5 === "number") { + if (/* tag */typeof match$5 === "number" || typeof match$5 === "string") { if (match$5 === /* Type_abstract */0) { exit$4 = 1; } else { @@ -31789,7 +32059,7 @@ function mcomp(type_pairs, env, _t1, _t2) { _1: /* [] */0 }); } - } else if (typeof match$5 === "number") { + } else if (/* tag */typeof match$5 === "number" || typeof match$5 === "string") { if (match$5 === /* Type_abstract */0) { exit$4 = 1; } else { @@ -31844,25 +32114,26 @@ function mcomp(type_pairs, env, _t1, _t2) { }; } if (exit$4 === 1) { - if (typeof match$5 === "number") { - if (match$5) { + if (/* tag */typeof match$5 === "number" || typeof match$5 === "string") { + if (match$5 === /* Type_abstract */0) { + if (!non_aliasable(p2, decl$p)) { + return ; + } throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - if (!non_aliasable(p2, decl$p)) { - return ; - } + throw new Caml_js_exceptions.MelangeError(Unify, { + MEL_EXN_ID: Unify, + _1: /* [] */0 + }); + } else { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - throw new Caml_js_exceptions.MelangeError(Unify, { - MEL_EXN_ID: Unify, - _1: /* [] */0 - }); } } @@ -31879,13 +32150,13 @@ function mcomp(type_pairs, env, _t1, _t2) { } break; case /* Tobject */4 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (match$3.TAG | 0) { + switch (match$3.TAG) { case /* Tconstr */3 : exit$3 = 3; break; @@ -31899,13 +32170,13 @@ function mcomp(type_pairs, env, _t1, _t2) { } break; case /* Tfield */5 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (match$3.TAG | 0) { + switch (match$3.TAG) { case /* Tconstr */3 : exit$3 = 3; break; @@ -31923,13 +32194,13 @@ function mcomp(type_pairs, env, _t1, _t2) { exit$3 = 3; break; case /* Tvariant */8 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (match$3.TAG | 0) { + switch (match$3.TAG) { case /* Tconstr */3 : exit$3 = 3; break; @@ -31941,7 +32212,7 @@ function mcomp(type_pairs, env, _t1, _t2) { const match$6 = merge_row_fields(row1$1.row_fields, row2$1.row_fields); const cannot_erase = function (param) { const match = row_field_repr_aux(/* [] */0, param[1]); - if (typeof match === "number" || match.TAG !== /* Rpresent */0) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Rpresent */0) { return false; } else { return true; @@ -31958,12 +32229,12 @@ function mcomp(type_pairs, env, _t1, _t2) { const match$1 = row_field_repr_aux(/* [] */0, param[2]); let exit = 0; let exit$1 = 0; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { exit$1 = 2; } else if (match.TAG === /* Rpresent */0) { const t1 = match._0; if (t1 !== undefined) { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -31989,7 +32260,7 @@ function mcomp(type_pairs, env, _t1, _t2) { return mcomp(type_pairs, env, t1, param); }), match$1._1); } else { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -32014,7 +32285,7 @@ function mcomp(type_pairs, env, _t1, _t2) { } } else { let exit$2 = 0; - if (match._0 || typeof match$1 === "number" || match$1.TAG !== /* Rpresent */0) { + if (match._0 || /* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Rpresent */0) { exit$2 = 3; } else { const t2$1 = match$1._0; @@ -32035,7 +32306,7 @@ function mcomp(type_pairs, env, _t1, _t2) { } if (exit$1 === 2) { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return ; } if (match$1.TAG !== /* Rpresent */0) { @@ -32052,7 +32323,7 @@ function mcomp(type_pairs, env, _t1, _t2) { } if (exit === 1) { let exit$3 = 0; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { exit$3 = 2; } else { if (!match._0) { @@ -32061,7 +32332,7 @@ function mcomp(type_pairs, env, _t1, _t2) { exit$3 = 2; } if (exit$3 === 2) { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return ; } if (match$1.TAG !== /* Rpresent */0) { @@ -32087,13 +32358,13 @@ function mcomp(type_pairs, env, _t1, _t2) { } break; case /* Tunivar */9 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (match$3.TAG | 0) { + switch (match$3.TAG) { case /* Tconstr */3 : exit$3 = 3; break; @@ -32113,13 +32384,13 @@ function mcomp(type_pairs, env, _t1, _t2) { if (tl1$1) { exit$6 = 4; } else { - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (match$3.TAG | 0) { + switch (match$3.TAG) { case /* Tconstr */3 : exit$3 = 3; break; @@ -32140,13 +32411,13 @@ function mcomp(type_pairs, env, _t1, _t2) { } } if (exit$6 === 4) { - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (match$3.TAG | 0) { + switch (match$3.TAG) { case /* Tconstr */3 : exit$3 = 3; break; @@ -32163,13 +32434,13 @@ function mcomp(type_pairs, env, _t1, _t2) { } break; case /* Tpackage */11 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (match$3.TAG | 0) { + switch (match$3.TAG) { case /* Tconstr */3 : exit$3 = 3; break; @@ -32186,7 +32457,7 @@ function mcomp(type_pairs, env, _t1, _t2) { } } if (exit$3 === 3) { - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -32273,17 +32544,33 @@ function mcomp_fields(type_pairs, env, ty1, ty2) { function mcomp_kind(k1, k2) { const k1$1 = field_kind_repr(k1); const k2$1 = field_kind_repr(k2); - if (typeof k1$1 === "number") { - if (k1$1) { + if (/* tag */typeof k1$1 === "number" || typeof k1$1 === "string") { + if (k1$1 === /* Fpresent */0) { + if (/* tag */typeof k2$1 === "number" || typeof k2$1 === "string") { + if (k2$1 === /* Fpresent */0) { + return ; + } + throw new Caml_js_exceptions.MelangeError(Unify, { + MEL_EXN_ID: Unify, + _1: /* [] */0 + }); + } else { + throw new Caml_js_exceptions.MelangeError(Unify, { + MEL_EXN_ID: Unify, + _1: /* [] */0 + }); + } + } else { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - if (typeof k2$1 === "number") { - if (!k2$1) { - return ; - } + } else { + if (!/* tag */(typeof k2$1 === "number" || typeof k2$1 === "string")) { + return ; + } + if (k2$1 === /* Fpresent */0) { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -32294,13 +32581,6 @@ function mcomp_kind(k1, k2) { _1: /* [] */0 }); } - if (typeof k2$1 === "number") { - throw new Caml_js_exceptions.MelangeError(Unify, { - MEL_EXN_ID: Unify, - _1: /* [] */0 - }); - } - } function mcomp_type_option(type_pairs, env, t, t$p) { @@ -32482,7 +32762,7 @@ const package_subtype = { function concat_longident(lid1) { return function (s) { - switch (s.TAG | 0) { + switch (s.TAG) { case /* Lident */0 : return { TAG: /* Ldot */1, @@ -32556,14 +32836,14 @@ function complete_type_list(allow_absentOpt, env, nl1, lv2, mty2, nl2, tl2) { MEL_EXN_ID: Stdlib.Exit }); } - const match$1 = decl.type_kind; - if (typeof match$1 === "number") { - if (match$1) { - throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { - MEL_EXN_ID: Stdlib.Exit - }); - } - if (decl.type_private) { + let tmp = decl.type_kind; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + if (tmp === /* Type_abstract */0) { + if (decl.type_private === /* Private */0) { + throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { + MEL_EXN_ID: Stdlib.Exit + }); + } const t2 = decl.type_manifest; if (t2 !== undefined) { return { @@ -32584,10 +32864,11 @@ function complete_type_list(allow_absentOpt, env, nl1, lv2, mty2, nl2, tl2) { throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { MEL_EXN_ID: Stdlib.Exit }); + } else { + throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { + MEL_EXN_ID: Stdlib.Exit + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { - MEL_EXN_ID: Stdlib.Exit - }); } catch (raw_exn){ const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); @@ -32645,7 +32926,7 @@ function unify_eq(env, t1, t2) { return true; } const match = umode.contents; - if (!match) { + if (match === /* Expression */0) { return false; } try { @@ -32676,13 +32957,13 @@ function unify(env, t1, t2) { const match = t1$1.desc; const match$1 = t2$1.desc; let exit = 0; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { exit = 1; } else { - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tvar */0 : let exit$1 = 0; - if (typeof match$1 === "number" || !(match$1.TAG === /* Tconstr */3 && deep_occur(t1$1, t2$1))) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || !(match$1.TAG === /* Tconstr */3 && deep_occur(t1$1, t2$1))) { exit$1 = 2; } else { unify2(env, t1$1, t2$1); @@ -32696,10 +32977,10 @@ function unify(env, t1, t2) { break; case /* Tconstr */3 : const p1 = match._0; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { unify2(env, t1$1, t2$1); } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : if (deep_occur(t2$1, t1$1)) { unify2(env, t1$1, t2$1); @@ -32742,10 +33023,10 @@ function unify(env, t1, t2) { } break; case /* Tunivar */9 : - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { unify2(env, t1$1, t2$1); } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : exit = 1; break; @@ -32764,7 +33045,7 @@ function unify(env, t1, t2) { } } if (exit === 1) { - if (typeof match$1 === "number" || match$1.TAG !== /* Tvar */0) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Tvar */0) { unify2(env, t1$1, t2$1); } else { occur(env.contents, t2$1, t1$1); @@ -33041,8 +33322,8 @@ function unify_row(env, row1, row2) { if (f1$2 === f2$2) { return ; } - if (typeof f1$2 === "number") { - if (typeof f2$2 === "number") { + if (/* tag */typeof f1$2 === "number" || typeof f1$2 === "string") { + if (/* tag */typeof f2$2 === "number" || typeof f2$2 === "string") { return ; } if (f2$2.TAG === /* Rpresent */0) { @@ -33067,7 +33348,7 @@ function unify_row(env, row1, row2) { } else if (f1$2.TAG === /* Rpresent */0) { const t1 = f1$2._0; if (t1 !== undefined) { - if (typeof f2$2 === "number") { + if (/* tag */typeof f2$2 === "number" || typeof f2$2 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -33108,7 +33389,7 @@ function unify_row(env, row1, row2) { throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } } else { - if (typeof f2$2 === "number") { + if (/* tag */typeof f2$2 === "number" || typeof f2$2 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -33148,7 +33429,7 @@ function unify_row(env, row1, row2) { const m1 = f1$2._2; const tl1 = f1$2._1; const e1 = f1$2._3; - if (typeof f2$2 === "number") { + if (/* tag */typeof f2$2 === "number" || typeof f2$2 === "string") { if (m1) { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, @@ -33389,10 +33670,10 @@ function unify2(env, t1, t2) { if (principal.contents && (find_lowest_level(t1$p) < lv || find_lowest_level(t2$p) < lv)) { const match$2 = t1$1.desc; let tmp; - tmp = typeof match$2 === "number" || !(match$2.TAG === /* Tconstr */3 && !match$2._1) ? t1$1 : t1$p; + tmp = /* tag */typeof match$2 === "number" || typeof match$2 === "string" || !(match$2.TAG === /* Tconstr */3 && !match$2._1) ? t1$1 : t1$p; const match$3 = t2$1.desc; let tmp$1; - tmp$1 = typeof match$3 === "number" || !(match$3.TAG === /* Tconstr */3 && !match$3._1) ? t2$1 : t2$p; + tmp$1 = /* tag */typeof match$3 === "number" || typeof match$3 === "string" || !(match$3.TAG === /* Tconstr */3 && !match$3._1) ? t2$1 : t2$p; match$1 = [ tmp, tmp$1 @@ -33434,19 +33715,19 @@ function unify3(env, t1, t1$p, t2, t2$p) { const create_recursion = t2 !== t2$p && deep_occur(t1$p, t2); let exit = 0; let exit$1 = 0; - if (typeof d1 === "number") { + if (/* tag */typeof d1 === "number" || typeof d1 === "string") { exit$1 = 2; } else { - switch (d1.TAG | 0) { + switch (d1.TAG) { case /* Tvar */0 : occur(env.contents, t1$p, t2); occur_univar(env.contents, t2); return link_type(t1$p, t2); case /* Tfield */5 : - if (typeof d2 === "number") { + if (/* tag */typeof d2 === "number" || typeof d2 === "string") { exit = 1; } else { - switch (d2.TAG | 0) { + switch (d2.TAG) { case /* Tvar */0 : exit$1 = 2; break; @@ -33458,10 +33739,10 @@ function unify3(env, t1, t1$p, t2, t2$p) { } break; case /* Tunivar */9 : - if (typeof d2 === "number") { + if (/* tag */typeof d2 === "number" || typeof d2 === "string") { exit = 1; } else { - switch (d2.TAG | 0) { + switch (d2.TAG) { case /* Tvar */0 : exit$1 = 2; break; @@ -33478,7 +33759,7 @@ function unify3(env, t1, t1$p, t2, t2$p) { } } if (exit$1 === 2) { - if (typeof d2 === "number") { + if (/* tag */typeof d2 === "number" || typeof d2 === "string") { exit = 1; } else { if (d2.TAG === /* Tvar */0) { @@ -33491,11 +33772,11 @@ function unify3(env, t1, t1$p, t2, t2$p) { } if (exit === 1) { const match = umode.contents; - if (match) { - add_type_equality(t1$p, t2$p); - } else { + if (match === /* Expression */0) { occur(env.contents, t1$p, t2$p); link_type(t1$p, t2); + } else { + add_type_equality(t1$p, t2$p); } try { let exit$2 = 0; @@ -33504,9 +33785,9 @@ function unify3(env, t1, t1$p, t2, t2$p) { let rem; let exit$3 = 0; let exit$4 = 0; - if (typeof d1 === "number") { - if (typeof d2 !== "number") { - switch (d2.TAG | 0) { + if (/* tag */typeof d1 === "number" || typeof d1 === "string") { + if (!/* tag */(typeof d2 === "number" || typeof d2 === "string")) { + switch (d2.TAG) { case /* Tconstr */3 : exit$4 = 5; break; @@ -33525,16 +33806,16 @@ function unify3(env, t1, t1$p, t2, t2$p) { } } else { - switch (d1.TAG | 0) { + switch (d1.TAG) { case /* Tarrow */1 : const l1 = d1._0; - if (typeof d2 === "number") { + if (/* tag */typeof d2 === "number" || typeof d2 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (d2.TAG | 0) { + switch (d2.TAG) { case /* Tarrow */1 : const l2 = d2._0; if (l1 === l2 || classic.contents && !(is_optional(l1) || is_optional(l2))) { @@ -33542,15 +33823,20 @@ function unify3(env, t1, t1$p, t2, t2$p) { unify(env, d1._2, d2._2); const match$1 = commu_repr(d1._3); const match$2 = commu_repr(d2._3); - if (typeof match$1 === "number") { - if (typeof match$2 === "number") { - + let exit$5 = 0; + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { + exit$5 = 6; + } else { + set_commu(match$1._0, match$2); + } + if (exit$5 === 6) { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string") { + match$2 === /* Cok */0; } else { set_commu(match$2._0, match$1); } - } else { - set_commu(match$1._0, match$2); } + } else { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, @@ -33569,13 +33855,13 @@ function unify3(env, t1, t1$p, t2, t2$p) { } break; case /* Ttuple */2 : - if (typeof d2 === "number") { + if (/* tag */typeof d2 === "number" || typeof d2 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (d2.TAG | 0) { + switch (d2.TAG) { case /* Ttuple */2 : unify_list(env, d1._0, d2._0); break; @@ -33591,9 +33877,9 @@ function unify3(env, t1, t1$p, t2, t2$p) { break; case /* Tconstr */3 : const p1 = d1._0; - let exit$5 = 0; - if (typeof d2 === "number" || d2.TAG !== /* Tconstr */3) { - exit$5 = 6; + let exit$6 = 0; + if (/* tag */typeof d2 === "number" || typeof d2 === "string" || d2.TAG !== /* Tconstr */3) { + exit$6 = 6; } else { const tl2 = d2._1; const tl1 = d1._1; @@ -33664,25 +33950,25 @@ function unify3(env, t1, t1$p, t2, t2$p) { } } } else { - exit$5 = 6; + exit$6 = 6; } } - if (exit$5 === 6) { - switch (p1.TAG | 0) { + if (exit$6 === 6) { + switch (p1.TAG) { case /* Pident */0 : if (d1._1) { exit$4 = 5; } else { const p = p1._0; - let exit$6 = 0; - if (typeof d2 === "number" || d2.TAG !== /* Tconstr */3) { - exit$6 = 7; + let exit$7 = 0; + if (/* tag */typeof d2 === "number" || typeof d2 === "string" || d2.TAG !== /* Tconstr */3) { + exit$7 = 7; } else { const path$p = d2._0; - switch (path$p.TAG | 0) { + switch (path$p.TAG) { case /* Pident */0 : if (d2._1 || !(is_newtype(env.contents, p1) && is_newtype(env.contents, path$p) && generate_equations.contents)) { - exit$6 = 7; + exit$7 = 7; } else { const match$3 = Caml_obj.caml_greaterthan(find_newtype_level(env.contents, p1), find_newtype_level(env.contents, path$p)) ? [ p, @@ -33696,12 +33982,12 @@ function unify3(env, t1, t1$p, t2, t2$p) { break; case /* Pdot */1 : case /* Papply */2 : - exit$6 = 7; + exit$7 = 7; break; } } - if (exit$6 === 7) { + if (exit$7 === 7) { if (is_newtype(env.contents, p1) && generate_equations.contents) { reify(env, t2$p); add_gadt_equation(env, p, t2$p); @@ -33721,31 +34007,31 @@ function unify3(env, t1, t1$p, t2, t2$p) { } break; case /* Tobject */4 : - if (typeof d2 === "number") { + if (/* tag */typeof d2 === "number" || typeof d2 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (d2.TAG | 0) { + switch (d2.TAG) { case /* Tconstr */3 : exit$4 = 5; break; case /* Tobject */4 : unify_fields(env, d1._0, d2._0); const match$4 = repr(t2$p).desc; - if (typeof match$4 !== "number" && match$4.TAG === /* Tobject */4) { - let exit$7 = 0; + if (!/* tag */(typeof match$4 === "number" || typeof match$4 === "string") && match$4.TAG === /* Tobject */4) { + let exit$8 = 0; const match$5 = match$4._1.contents; if (match$5 !== undefined) { const match$6 = match$5[1]; if (match$6) { const match$7 = repr(match$6.hd).desc; let tmp$1; - if (typeof match$7 === "number") { + if (/* tag */typeof match$7 === "number" || typeof match$7 === "string") { tmp$1 = true; } else { - switch (match$7.TAG | 0) { + switch (match$7.TAG) { case /* Tvar */0 : case /* Tunivar */9 : tmp$1 = true; @@ -33755,16 +34041,16 @@ function unify3(env, t1, t1$p, t2, t2$p) { } } if (!tmp$1) { - exit$7 = 6; + exit$8 = 6; } } else { - exit$7 = 6; + exit$8 = 6; } } else { - exit$7 = 6; + exit$8 = 6; } - if (exit$7 === 6) { + if (exit$8 === 6) { set_name(match$4._1, d1._1.contents); } @@ -33778,7 +34064,7 @@ function unify3(env, t1, t1$p, t2, t2$p) { } break; case /* Tfield */5 : - if (typeof d2 === "number") { + if (/* tag */typeof d2 === "number" || typeof d2 === "string") { f = d1._0; kind = d1._1; rem = d1._3; @@ -33794,13 +34080,13 @@ function unify3(env, t1, t1$p, t2, t2$p) { break; case /* Tvariant */8 : const row1 = d1._0; - if (typeof d2 === "number") { + if (/* tag */typeof d2 === "number" || typeof d2 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (d2.TAG | 0) { + switch (d2.TAG) { case /* Tconstr */3 : exit$4 = 5; break; @@ -33839,23 +34125,23 @@ function unify3(env, t1, t1$p, t2, t2$p) { case /* Tpoly */10 : const tl1$1 = d1._1; const t1$1 = d1._0; - let exit$8 = 0; + let exit$9 = 0; if (tl1$1) { - exit$8 = 6; + exit$9 = 6; } else { - if (typeof d2 === "number") { + if (/* tag */typeof d2 === "number" || typeof d2 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (d2.TAG | 0) { + switch (d2.TAG) { case /* Tconstr */3 : exit$4 = 5; break; case /* Tpoly */10 : if (d2._1) { - exit$8 = 6; + exit$9 = 6; } else { unify(env, t1$1, d2._0); } @@ -33867,14 +34153,14 @@ function unify3(env, t1, t1$p, t2, t2$p) { }); } } - if (exit$8 === 6) { - if (typeof d2 === "number") { + if (exit$9 === 6) { + if (/* tag */typeof d2 === "number" || typeof d2 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (d2.TAG | 0) { + switch (d2.TAG) { case /* Tconstr */3 : exit$4 = 5; break; @@ -33893,13 +34179,13 @@ function unify3(env, t1, t1$p, t2, t2$p) { break; case /* Tpackage */11 : const tl1$2 = d1._2; - if (typeof d2 === "number") { + if (/* tag */typeof d2 === "number" || typeof d2 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (d2.TAG | 0) { + switch (d2.TAG) { case /* Tconstr */3 : exit$4 = 5; break; @@ -33939,11 +34225,11 @@ function unify3(env, t1, t1$p, t2, t2$p) { } } if (exit$4 === 5) { - if (typeof d2 === "number" || d2.TAG !== /* Tconstr */3) { + if (/* tag */typeof d2 === "number" || typeof d2 === "string" || d2.TAG !== /* Tconstr */3) { exit$3 = 4; } else { const path = d2._0; - switch (path.TAG | 0) { + switch (path.TAG) { case /* Pident */0 : if (d2._1 || !(is_newtype(env.contents, path) && generate_equations.contents)) { exit$2 = 2; @@ -33961,7 +34247,7 @@ function unify3(env, t1, t1$p, t2, t2$p) { } } if (exit$3 === 4) { - if (typeof d1 === "number") { + if (/* tag */typeof d1 === "number" || typeof d1 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -33994,13 +34280,18 @@ function unify3(env, t1, t1$p, t2, t2$p) { break; case 3 : const r = field_kind_repr(kind); - if (typeof r === "number") { + if (/* tag */typeof r === "number" || typeof r === "string") { + if (r === /* Fpresent */0) { + throw new Caml_js_exceptions.MelangeError(Unify, { + MEL_EXN_ID: Unify, + _1: /* [] */0 + }); + } throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); - } - if (f !== dummy_method) { + } else if (f !== dummy_method) { set_kind(r._0, /* Fabsent */1); if (Caml_obj.caml_equal(d2, /* Tnil */0)) { unify(env, rem, t2$p); @@ -34020,7 +34311,7 @@ function unify3(env, t1, t1$p, t2, t2$p) { return ; } const match$8 = t2.desc; - if (typeof match$8 === "number") { + if (/* tag */typeof match$8 === "number" || typeof match$8 === "string") { return ; } if (match$8.TAG !== /* Tconstr */3) { @@ -34052,7 +34343,7 @@ function unify3(env, t1, t1$p, t2, t2$p) { function make_rowvar(level, use1, rest1, use2, rest2) { const set_name = function (ty, name) { const match = ty.desc; - if (typeof match === "number" || !(match.TAG === /* Tvar */0 && match._0 === undefined)) { + if (/* tag */typeof match === "number" || typeof match === "string" || !(match.TAG === /* Tvar */0 && match._0 === undefined)) { return ; } else { log_type(ty); @@ -34067,13 +34358,13 @@ function make_rowvar(level, use1, rest1, use2, rest2) { const match$1 = rest2.desc; let name; let exit = 0; - if (typeof match === "number" || match.TAG !== /* Tvar */0) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tvar */0) { exit = 1; } else { const name1 = match._0; if (name1 !== undefined) { let exit$1 = 0; - if (typeof match$1 === "number" || match$1.TAG !== /* Tvar */0) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Tvar */0) { exit$1 = 2; } else { const name2 = match$1._0; @@ -34095,7 +34386,7 @@ function make_rowvar(level, use1, rest1, use2, rest2) { } } if (exit === 1) { - if (typeof match$1 === "number" || match$1.TAG !== /* Tvar */0) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Tvar */0) { name = undefined; } else { const name$1 = match$1._0; @@ -34127,12 +34418,12 @@ function unify_kind(k1, k2) { if (k1$1 === k2$1) { return ; } - if (typeof k1$1 === "number") { - if (!k1$1) { - if (typeof k2$1 !== "number") { + if (/* tag */typeof k1$1 === "number" || typeof k1$1 === "string") { + if (k1$1 === /* Fpresent */0) { + if (!/* tag */(typeof k2$1 === "number" || typeof k2$1 === "string")) { return set_kind(k2$1._0, k1$1); } - if (!k2$1) { + if (k2$1 === /* Fpresent */0) { return ; } @@ -34140,10 +34431,10 @@ function unify_kind(k1, k2) { } else { const r = k1$1._0; - if (typeof k2$1 !== "number") { + if (!/* tag */(typeof k2$1 === "number" || typeof k2$1 === "string")) { return set_kind(r, k2$1); } - if (!k2$1) { + if (k2$1 === /* Fpresent */0) { return set_kind(r, k2$1); } @@ -34193,7 +34484,7 @@ function unify_var(env, t1, t2) { return ; } const match = t1$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return unify$1({ contents: env }, t1$1, t2$1); @@ -34253,13 +34544,13 @@ function expand_head_trace(env, t) { function filter_arrow(env, t, l) { const t$1 = expand_head_trace(env, t); const match = t$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tvar */0 : const lv = t$1.level; const t1 = newty2(lv, { @@ -34307,13 +34598,13 @@ function filter_method_field(env, name, priv, _ty) { const ty = _ty; const ty$1 = expand_head_trace(env, ty); const match = ty$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tvar */0 : const level = ty$1.level; const ty1 = newty2(level, { @@ -34324,14 +34615,17 @@ function filter_method_field(env, name, priv, _ty) { TAG: /* Tvar */0, _0: undefined }); + let tmp; + tmp = priv === /* Private */0 ? ({ + TAG: /* Fvar */0, + _0: { + contents: undefined + } + }) : /* Fpresent */0; const ty$p = newty2(level, { TAG: /* Tfield */5, _0: name, - _1: priv ? /* Fpresent */0 : /* Fvar */({ - _0: { - contents: undefined - } - }), + _1: tmp, _2: ty1, _3: ty2 }); @@ -34359,13 +34653,13 @@ function filter_method_field(env, name, priv, _ty) { function filter_method(env, name, priv, ty) { const ty$1 = expand_head_trace(env, ty); const match = ty$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tvar */0 : const ty1 = newvar(undefined, undefined); const ty$p = newobj(ty1); @@ -34415,7 +34709,7 @@ function moregen_occur(env, level, ty) { } ty$1.level = pivot_level - ty$1.level | 0; const row = ty$1.desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { return iter_type_expr(occur, ty$1); } if (row.TAG !== /* Tvariant */8) { @@ -34468,10 +34762,10 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { const match = t1$1.desc; const match$1 = t2$1.desc; let exit = 0; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { exit = 1; } else { - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tvar */0 : if (may_instantiate(inst_nongen, t1$1)) { moregen_occur(env, t1$1.level, t2$1); @@ -34481,7 +34775,7 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { exit = 1; break; case /* Tconstr */3 : - if (match._1 || typeof match$1 === "number" || !(match$1.TAG === /* Tconstr */3 && !match$1._1)) { + if (match._1 || /* tag */typeof match$1 === "number" || typeof match$1 === "string" || !(match$1.TAG === /* Tconstr */3 && !match$1._1)) { exit = 1; } else { if (same(match._0, match$1._0)) { @@ -34517,8 +34811,8 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { ], undefined); const match$2 = t1$p$1.desc; const match$3 = t2$p$1.desc; - if (typeof match$2 === "number") { - if (typeof match$3 === "number") { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { return ; } throw new Caml_js_exceptions.MelangeError(Unify, { @@ -34526,7 +34820,7 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { _1: /* [] */0 }); } - switch (match$2.TAG | 0) { + switch (match$2.TAG) { case /* Tvar */0 : if (may_instantiate(inst_nongen, t1$p$1)) { moregen_occur(env, t1$p$1.level, t2$1); @@ -34537,7 +34831,7 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { _1: /* [] */0 }); case /* Tarrow */1 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -34560,7 +34854,7 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { _1: /* [] */0 }); case /* Ttuple */2 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -34574,7 +34868,7 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { _1: /* [] */0 }); case /* Tconstr */3 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -34594,7 +34888,7 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { _1: /* [] */0 }); case /* Tobject */4 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -34608,7 +34902,7 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { _1: /* [] */0 }); case /* Tfield */5 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -34628,7 +34922,7 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { _1: /* [] */0 }); case /* Tvariant */8 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -34666,10 +34960,10 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { const match$7 = rm2.desc; let exit$1 = 0; let exit$2 = 0; - if (typeof match$6 === "number" || match$6.TAG !== /* Tunivar */9) { + if (/* tag */typeof match$6 === "number" || typeof match$6 === "string" || match$6.TAG !== /* Tunivar */9) { exit$2 = 2; } else { - if (typeof match$7 === "number") { + if (/* tag */typeof match$7 === "number" || typeof match$7 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -34685,7 +34979,7 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { } } if (exit$2 === 2) { - if (typeof match$7 === "number") { + if (/* tag */typeof match$7 === "number" || typeof match$7 === "string") { exit$1 = 1; } else { if (match$7.TAG === /* Tunivar */9) { @@ -34713,14 +35007,14 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { moregen_occur(env, rm1.level, ext); link_type(rm1, ext); } else { - if (typeof match$6 === "number") { + if (/* tag */typeof match$6 === "number" || typeof match$6 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } if (match$6.TAG === /* Tconstr */3) { - if (typeof match$7 === "number") { + if (/* tag */typeof match$7 === "number" || typeof match$7 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -34748,19 +35042,24 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { if (f1 === f2) { return ; } - if (typeof f1 === "number") { - if (typeof f2 === "number") { + if (/* tag */typeof f1 === "number" || typeof f1 === "string") { + if (/* tag */typeof f2 === "number" || typeof f2 === "string") { return ; } + if (f2.TAG === /* Rpresent */0) { + throw new Caml_js_exceptions.MelangeError(Unify, { + MEL_EXN_ID: Unify, + _1: /* [] */0 + }); + } throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); - } - if (f1.TAG === /* Rpresent */0) { + } else if (f1.TAG === /* Rpresent */0) { const t1 = f1._0; if (t1 !== undefined) { - if (typeof f2 === "number") { + if (/* tag */typeof f2 === "number" || typeof f2 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -34781,7 +35080,7 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { _1: /* [] */0 }); } else { - if (typeof f2 === "number") { + if (/* tag */typeof f2 === "number" || typeof f2 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -34804,7 +35103,7 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { } else { const c1 = f1._0; if (c1) { - if (!f1._1 && typeof f2 !== "number" && f2.TAG === /* Rpresent */0) { + if (!f1._1 && !/* tag */(typeof f2 === "number" || typeof f2 === "string") && f2.TAG === /* Rpresent */0) { if (f2._0 !== undefined) { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, @@ -34820,7 +35119,7 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { }); } - } else if (typeof f2 !== "number" && f2.TAG === /* Rpresent */0) { + } else if (!/* tag */(typeof f2 === "number" || typeof f2 === "string") && f2.TAG === /* Rpresent */0) { const t2$1 = f2._0; if (t2$1 !== undefined) { if (may_inst) { @@ -34841,7 +35140,7 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { } const e1 = f1._3; const tl1 = f1._1; - if (typeof f2 === "number") { + if (/* tag */typeof f2 === "number" || typeof f2 === "string") { if (may_inst) { return set_row_field(e1, f2); } @@ -34901,7 +35200,7 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { _1: /* [] */0 }); case /* Tunivar */9 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -34921,7 +35220,7 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { if (tl1) { exit$3 = 2; } else { - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -34940,7 +35239,7 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { } } if (exit$3 === 2) { - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -34958,7 +35257,7 @@ function moregen(inst_nongen, type_pairs, env, t1, t2) { } break; case /* Tpackage */11 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -35084,38 +35383,41 @@ function moregen_kind(k1, k2) { if (k1$1 === k2$1) { return ; } - if (typeof k1$1 === "number") { - if (k1$1) { - throw new Caml_js_exceptions.MelangeError(Unify, { - MEL_EXN_ID: Unify, - _1: /* [] */0 - }); - } - if (typeof k2$1 === "number") { - if (!k2$1) { - return ; + if (/* tag */typeof k1$1 === "number" || typeof k1$1 === "string") { + if (k1$1 === /* Fpresent */0) { + if (/* tag */typeof k2$1 === "number" || typeof k2$1 === "string") { + if (k2$1 === /* Fpresent */0) { + return ; + } + throw new Caml_js_exceptions.MelangeError(Unify, { + MEL_EXN_ID: Unify, + _1: /* [] */0 + }); + } else { + throw new Caml_js_exceptions.MelangeError(Unify, { + MEL_EXN_ID: Unify, + _1: /* [] */0 + }); } + } else { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } + } else { + const r = k1$1._0; + if (!/* tag */(typeof k2$1 === "number" || typeof k2$1 === "string")) { + return set_kind(r, k2$1); + } + if (k2$1 === /* Fpresent */0) { + return set_kind(r, k2$1); + } throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - const r = k1$1._0; - if (typeof k2$1 !== "number") { - return set_kind(r, k2$1); - } - if (k2$1) { - throw new Caml_js_exceptions.MelangeError(Unify, { - MEL_EXN_ID: Unify, - _1: /* [] */0 - }); - } - set_kind(r, k2$1); } function moregen$1(inst_nongen, type_pairs, env, patt, subj) { @@ -35156,12 +35458,12 @@ function rigidify_rec(vars, _ty) { } ty$1.level = pivot_level - ty$1.level | 0; const row = ty$1.desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { return iter_type_expr((function (param) { return rigidify_rec(vars, param); }), ty$1); } - switch (row.TAG | 0) { + switch (row.TAG) { case /* Tvar */0 : if (!Stdlib__List.memq(ty$1, vars.contents)) { vars.contents = { @@ -35268,11 +35570,11 @@ function expand_head_rigid(env, ty) { function normalize_subst(subst) { if (Stdlib__List.exists((function (param) { const match = param[0].desc; - if (typeof match !== "number" && match.TAG === /* Tlink */6) { + if (!/* tag */(typeof match === "number" || typeof match === "string") && match.TAG === /* Tlink */6) { return true; } const match$1 = param[1].desc; - return typeof match$1 === "number" || match$1.TAG !== /* Tlink */6 ? false : true; + return /* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Tlink */6 ? false : true; }), subst.contents)) { subst.contents = Stdlib__List.map((function (param) { return [ @@ -35298,12 +35600,12 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { const match = t1$1.desc; const match$1 = t2$1.desc; let exit = 0; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { exit = 1; } else { - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tvar */0 : - if (typeof match$1 === "number" || !(match$1.TAG === /* Tvar */0 && rename)) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || !(match$1.TAG === /* Tvar */0 && rename)) { exit = 1; } else { try { @@ -35341,7 +35643,7 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { } break; case /* Tconstr */3 : - if (match._1 || typeof match$1 === "number" || !(match$1.TAG === /* Tconstr */3 && !match$1._1)) { + if (match._1 || /* tag */typeof match$1 === "number" || typeof match$1 === "string" || !(match$1.TAG === /* Tconstr */3 && !match$1._1)) { exit = 1; } else { if (same(match._0, match$1._0)) { @@ -35377,8 +35679,8 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { ], undefined); const match$2 = t1$p$1.desc; const match$3 = t2$p$1.desc; - if (typeof match$2 === "number") { - if (typeof match$3 === "number") { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { return ; } throw new Caml_js_exceptions.MelangeError(Unify, { @@ -35386,9 +35688,9 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { _1: /* [] */0 }); } - switch (match$2.TAG | 0) { + switch (match$2.TAG) { case /* Tvar */0 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -35441,7 +35743,7 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { }); } case /* Tarrow */1 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -35464,7 +35766,7 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { _1: /* [] */0 }); case /* Ttuple */2 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -35478,7 +35780,7 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { _1: /* [] */0 }); case /* Tconstr */3 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -35498,7 +35800,7 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { _1: /* [] */0 }); case /* Tobject */4 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -35512,7 +35814,7 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { _1: /* [] */0 }); case /* Tfield */5 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -35532,7 +35834,7 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { _1: /* [] */0 }); case /* Tvariant */8 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -35545,7 +35847,7 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { const row2 = _row2; const match$4 = expand_head_rigid(env, row_more(row2)); const row2$1 = match$4.desc; - if (typeof row2$1 !== "number" && row2$1.TAG === /* Tvariant */8) { + if (!/* tag */(typeof row2$1 === "number" || typeof row2$1 === "string") && row2$1.TAG === /* Tvariant */8) { _row2 = row2$1._0; continue ; } @@ -35566,19 +35868,24 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { return Stdlib__List.iter((function (param) { const match = row_field_repr_aux(/* [] */0, param[1]); const match$1 = row_field_repr_aux(/* [] */0, param[2]); - if (typeof match === "number") { - if (typeof match$1 === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return ; } + if (match$1.TAG === /* Rpresent */0) { + throw new Caml_js_exceptions.MelangeError(Unify, { + MEL_EXN_ID: Unify, + _1: /* [] */0 + }); + } throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); - } - if (match.TAG === /* Rpresent */0) { + } else if (match.TAG === /* Rpresent */0) { const t1 = match._0; if (t1 !== undefined) { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -35599,7 +35906,7 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { _1: /* [] */0 }); } else { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -35626,7 +35933,7 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { _1: /* [] */0 }); } - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -35656,7 +35963,7 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { if (match$2) { const tl1 = match$2.tl; const t1$1 = match$2.hd; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -35711,7 +36018,7 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { _1: /* [] */0 }); case /* Tunivar */9 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -35731,7 +36038,7 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { if (tl1) { exit$1 = 2; } else { - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -35750,7 +36057,7 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { } } if (exit$1 === 2) { - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -35768,7 +36075,7 @@ function eqtype(rename, type_pairs, subst, env, t1, t2) { } break; case /* Tpackage */11 : - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -35854,7 +36161,7 @@ function eqtype_fields(rename, type_pairs, subst, env, ty1, _ty2) { } const match$2 = expand_head_rigid(env, rest2); const match$3 = match$2.desc; - if (typeof match$3 !== "number" && match$3.TAG === /* Tobject */4) { + if (!/* tag */(typeof match$3 === "number" || typeof match$3 === "string") && match$3.TAG === /* Tobject */4) { _ty2 = match$3._0; continue ; } @@ -35911,17 +36218,33 @@ function eqtype_fields(rename, type_pairs, subst, env, ty1, _ty2) { function eqtype_kind(k1, k2) { const k1$1 = field_kind_repr(k1); const k2$1 = field_kind_repr(k2); - if (typeof k1$1 === "number") { - if (k1$1) { + if (/* tag */typeof k1$1 === "number" || typeof k1$1 === "string") { + if (k1$1 === /* Fpresent */0) { + if (/* tag */typeof k2$1 === "number" || typeof k2$1 === "string") { + if (k2$1 === /* Fpresent */0) { + return ; + } + throw new Caml_js_exceptions.MelangeError(Unify, { + MEL_EXN_ID: Unify, + _1: /* [] */0 + }); + } else { + throw new Caml_js_exceptions.MelangeError(Unify, { + MEL_EXN_ID: Unify, + _1: /* [] */0 + }); + } + } else { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 }); } - if (typeof k2$1 === "number") { - if (!k2$1) { - return ; - } + } else { + if (!/* tag */(typeof k2$1 === "number" || typeof k2$1 === "string")) { + return ; + } + if (k2$1 === /* Fpresent */0) { throw new Caml_js_exceptions.MelangeError(Unify, { MEL_EXN_ID: Unify, _1: /* [] */0 @@ -35932,13 +36255,6 @@ function eqtype_kind(k1, k2) { _1: /* [] */0 }); } - if (typeof k2$1 === "number") { - throw new Caml_js_exceptions.MelangeError(Unify, { - MEL_EXN_ID: Unify, - _1: /* [] */0 - }); - } - } function equal$5(env, rename, tyl1, tyl2) { @@ -35968,12 +36284,12 @@ const Failure = /* @__PURE__ */Caml_exceptions.create("Ocaml_typedtree_test.Ctyp function moregen_clty(trace, type_pairs, env, cty1, cty2) { try { let exit = 0; - switch (cty1.TAG | 0) { + switch (cty1.TAG) { case /* Cty_constr */0 : return moregen_clty(true, type_pairs, env, cty1._2, cty2); case /* Cty_signature */1 : const sign1 = cty1._0; - switch (cty2.TAG | 0) { + switch (cty2.TAG) { case /* Cty_constr */0 : exit = 1; break; @@ -36040,7 +36356,7 @@ function moregen_clty(trace, type_pairs, env, cty1, cty2) { } break; case /* Cty_arrow */2 : - switch (cty2.TAG | 0) { + switch (cty2.TAG) { case /* Cty_constr */0 : exit = 1; break; @@ -36135,13 +36451,19 @@ function match_class_types(traceOpt, env, pat_sch, subj_sch) { const error = Stdlib__List.fold_right((function (param, err) { const lab = param[0]; const k = field_kind_repr(param[1]); - const err$1 = typeof k === "number" ? ({ - hd: { - TAG: /* CM_Hide_public */10, - _0: lab - }, - tl: err - }) : (set_kind(k._0, /* Fabsent */1), err); + let err$1; + if (/* tag */typeof k === "number" || typeof k === "string") { + err$1 = { + hd: { + TAG: /* CM_Hide_public */10, + _0: lab + }, + tl: err + }; + } else { + set_kind(k._0, /* Fabsent */1); + err$1 = err; + } if (Curry._2(mem$2, lab, sign1.csig_concr)) { return err$1; } else { @@ -36280,10 +36602,10 @@ function match_class_types(traceOpt, env, pat_sch, subj_sch) { function equal_clty(trace, type_pairs, subst, env, cty1, cty2) { try { let exit = 0; - switch (cty1.TAG | 0) { + switch (cty1.TAG) { case /* Cty_constr */0 : let exit$1 = 0; - switch (cty2.TAG | 0) { + switch (cty2.TAG) { case /* Cty_constr */0 : return equal_clty(true, type_pairs, subst, env, cty1._2, cty2._2); case /* Cty_signature */1 : @@ -36298,7 +36620,7 @@ function equal_clty(trace, type_pairs, subst, env, cty1, cty2) { break; case /* Cty_signature */1 : const sign1 = cty1._0; - switch (cty2.TAG | 0) { + switch (cty2.TAG) { case /* Cty_constr */0 : exit = 1; break; @@ -36363,7 +36685,7 @@ function equal_clty(trace, type_pairs, subst, env, cty1, cty2) { } break; case /* Cty_arrow */2 : - switch (cty2.TAG | 0) { + switch (cty2.TAG) { case /* Cty_constr */0 : exit = 1; break; @@ -36462,7 +36784,8 @@ function match_class_declarations(env, patt_params, patt_type, subj_params, subj const error = Stdlib__List.fold_right((function (param, err) { const lab = param[0]; const k = field_kind_repr(param[1]); - const err$1 = typeof k === "number" ? ({ + let err$1; + err$1 = /* tag */typeof k === "number" || typeof k === "string" ? ({ hd: { TAG: /* CM_Hide_public */10, _0: lab @@ -36496,9 +36819,9 @@ function match_class_declarations(env, patt_params, patt_type, subj_params, subj const lab = param[0]; const k1 = field_kind_repr(param[1]); const k2 = field_kind_repr(param[3]); - if (typeof k1 === "number") { - if (!k1) { - if (typeof k2 !== "number") { + if (/* tag */typeof k1 === "number" || typeof k1 === "string") { + if (k1 === /* Fpresent */0) { + if (!/* tag */(typeof k2 === "number" || typeof k2 === "string")) { return { hd: { TAG: /* CM_Public_method */12, @@ -36507,17 +36830,17 @@ function match_class_declarations(env, patt_params, patt_type, subj_params, subj tl: err }; } - if (!k2) { + if (k2 === /* Fpresent */0) { return err; } } } else { - if (typeof k2 !== "number") { + if (!/* tag */(typeof k2 === "number" || typeof k2 === "string")) { return err; } - if (!k2) { + if (k2 === /* Fpresent */0) { return { hd: { TAG: /* CM_Private_method */13, @@ -36703,11 +37026,11 @@ function filter_visited(_l) { return /* [] */0; } const match = l.hd.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { _l = l.tl; continue ; } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tobject */4 : case /* Tvariant */8 : return l; @@ -36729,7 +37052,7 @@ function memq_warn(t, visited) { function lid_of_path(sharpOpt, id) { const sharp = sharpOpt !== undefined ? sharpOpt : ""; - switch (id.TAG | 0) { + switch (id.TAG) { case /* Pident */0 : return { TAG: /* Lident */0, @@ -36757,7 +37080,7 @@ function find_cltype_for_path(env, p) { const ty = cl_abbr.type_manifest; if (ty !== undefined) { const match$1 = repr(ty).desc; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { MEL_EXN_ID: Stdlib.Not_found }); @@ -36797,7 +37120,7 @@ function find_cltype_for_path(env, p) { function build_subtype(env, visited, loops, posi, level, t) { const t$1 = repr(t); const tlist = t$1.desc; - if (typeof tlist === "number") { + if (/* tag */typeof tlist === "number" || typeof tlist === "string") { if (posi) { const v = newvar(undefined, undefined); return [ @@ -36811,7 +37134,7 @@ function build_subtype(env, visited, loops, posi, level, t) { /* Unchanged */0 ]; } - switch (tlist.TAG | 0) { + switch (tlist.TAG) { case /* Tvar */0 : if (!posi) { return [ @@ -36906,7 +37229,7 @@ function build_subtype(env, visited, loops, posi, level, t) { const level$p = pred_expand(level); try { const match$2 = t$p$1.desc; - if (typeof match$2 === "number") { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { MEL_EXN_ID: Stdlib.Not_found }); @@ -36918,7 +37241,7 @@ function build_subtype(env, visited, loops, posi, level, t) { const ty$1 = repr(ty); const match$4 = ty$1.desc; let match$5; - if (typeof match$4 === "number") { + if (/* tag */typeof match$4 === "number" || typeof match$4 === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { MEL_EXN_ID: Stdlib.Not_found }); @@ -37187,7 +37510,7 @@ function build_subtype(env, visited, loops, posi, level, t) { const fields$1 = Stdlib__List.map((function (orig) { const l = orig[0]; const match = row_field_repr_aux(/* [] */0, orig[1]); - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -37357,10 +37680,10 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { let exit$2 = 0; let exit$3 = 0; let exit$4 = 0; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { exit$4 = 6; } else { - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tvar */0 : exit = 2; break; @@ -37368,10 +37691,10 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { const u1 = match._2; const t1$2 = match._1; const l1 = match._0; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : exit$4 = 6; break; @@ -37410,10 +37733,10 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { } break; case /* Ttuple */2 : - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : exit$4 = 6; break; @@ -37443,10 +37766,10 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { case /* Tconstr */3 : if (match._1) { exit$4 = 6; - } else if (typeof match$1 === "number") { + } else if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit$3 = 5; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : exit$4 = 6; break; @@ -37467,10 +37790,10 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { break; case /* Tobject */4 : const f1 = match._0; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : exit$4 = 6; break; @@ -37541,10 +37864,10 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { } break; case /* Tvariant */8 : - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : exit$4 = 6; break; @@ -37565,15 +37888,15 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { const match$6 = more1.desc; const match$7 = more2.desc; let exit$5 = 0; - if (typeof match$6 === "number") { + if (/* tag */typeof match$6 === "number" || typeof match$6 === "string") { exit$5 = 1; } else { - switch (match$6.TAG | 0) { + switch (match$6.TAG) { case /* Tvar */0 : exit$5 = 1; break; case /* Tconstr */3 : - if (typeof match$7 === "number" || match$7.TAG !== /* Tconstr */3) { + if (/* tag */typeof match$7 === "number" || typeof match$7 === "string" || match$7.TAG !== /* Tconstr */3) { exit$5 = 1; } else { if (same(match$6._0, match$7._0)) { @@ -37589,7 +37912,7 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { } break; case /* Tunivar */9 : - if (typeof match$7 === "number") { + if (/* tag */typeof match$7 === "number" || typeof match$7 === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { MEL_EXN_ID: Stdlib.Exit }); @@ -37608,18 +37931,22 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { const match$1 = row_field_repr_aux(/* [] */0, param[2]); let t1; let t2; - if (typeof match === "number") { - if (typeof match$1 === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return cstrs; } + if (match$1.TAG === /* Rpresent */0) { + throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { + MEL_EXN_ID: Stdlib.Exit + }); + } throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { MEL_EXN_ID: Stdlib.Exit }); - } - if (match.TAG === /* Rpresent */0) { + } else if (match.TAG === /* Rpresent */0) { const t1$1 = match._0; if (t1$1 !== undefined) { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { MEL_EXN_ID: Stdlib.Exit }); @@ -37640,7 +37967,7 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { }); } } else { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { MEL_EXN_ID: Stdlib.Exit }); @@ -37663,7 +37990,7 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { MEL_EXN_ID: Stdlib.Exit }); } - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { MEL_EXN_ID: Stdlib.Exit }); @@ -37692,7 +38019,7 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { MEL_EXN_ID: Stdlib.Exit }); } - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { MEL_EXN_ID: Stdlib.Exit }); @@ -37751,10 +38078,10 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { } if (exit$5 === 1) { let exit$6 = 0; - if (typeof match$7 === "number") { + if (/* tag */typeof match$7 === "number" || typeof match$7 === "string") { exit$6 = 2; } else { - switch (match$7.TAG | 0) { + switch (match$7.TAG) { case /* Tvar */0 : case /* Tconstr */3 : exit$6 = 2; @@ -37770,13 +38097,13 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { return Stdlib__List.fold_left((function (cstrs, param) { const match = row_field_repr_aux(/* [] */0, param[1]); const match$1 = row_field_repr_aux(/* [] */0, param[2]); - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return cstrs; } if (match.TAG === /* Rpresent */0) { const t1 = match._0; if (t1 !== undefined) { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { MEL_EXN_ID: Stdlib.Exit }); @@ -37805,7 +38132,7 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { const match$2 = match._1; if (match$2) { const t1$1 = match$2.hd; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { MEL_EXN_ID: Stdlib.Exit }); @@ -37834,7 +38161,7 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { }); } } - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { MEL_EXN_ID: Stdlib.Exit }); @@ -37886,10 +38213,10 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { let exit$7 = 0; if (tl1$1) { exit$7 = 7; - } else if (typeof match$1 === "number") { + } else if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : exit$4 = 6; break; @@ -37910,10 +38237,10 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { } } if (exit$7 === 7) { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : exit$4 = 6; break; @@ -37959,10 +38286,10 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { const tl1$2 = match._2; const nl1 = match._1; const p1 = match._0; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : exit$4 = 6; break; @@ -38043,14 +38370,14 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { } } if (exit$4 === 6) { - if (typeof match$1 === "number" || match$1.TAG !== /* Tvar */0) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Tvar */0) { exit$3 = 5; } else { exit = 2; } } if (exit$3 === 5) { - if (typeof match === "number" || match.TAG !== /* Tconstr */3) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tconstr */3) { exit$2 = 4; } else { if (generic_abbrev(env, match._0) && safe_abbrev(env, t1$1)) { @@ -38062,7 +38389,7 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { } } if (exit$2 === 4) { - if (typeof match$1 === "number" || match$1.TAG !== /* Tconstr */3) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Tconstr */3) { exit$1 = 3; } else { if (generic_abbrev(env, match$1._0) && safe_abbrev(env, t2$1)) { @@ -38074,12 +38401,12 @@ function subtype_rec(env, _trace, _t1, _t2, _cstrs) { } } if (exit$1 === 3) { - if (typeof match === "number" || match.TAG !== /* Tconstr */3) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tconstr */3) { exit = 1; } else { const p1$1 = match._0; let exit$8 = 0; - if (typeof match$1 === "number" || !(match$1.TAG === /* Tconstr */3 && same(p1$1, match$1._0))) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || !(match$1.TAG === /* Tconstr */3 && same(p1$1, match$1._0))) { exit$8 = 4; } else { try { @@ -38218,10 +38545,10 @@ function subtype(env, ty1, ty2) { function unalias_object(ty) { const ty$1 = repr(ty); const match = ty$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return newty2(ty$1.level, ty$1.desc); } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tvar */0 : return newty2(ty$1.level, ty$1.desc); case /* Tconstr */3 : @@ -38254,10 +38581,10 @@ function unalias_object(ty) { function unalias(ty) { const ty$1 = repr(ty); const row = ty$1.desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { return newty2(ty$1.level, ty$1.desc); } - switch (row.TAG | 0) { + switch (row.TAG) { case /* Tobject */4 : const ty$2 = row._0; return newty2(ty$2.level, { @@ -38289,7 +38616,7 @@ function unalias(ty) { function arity(ty) { const match = repr(ty).desc; - if (typeof match === "number" || match.TAG !== /* Tarrow */1) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tarrow */1) { return 0; } else { return 1 + arity(match._2) | 0; @@ -38300,7 +38627,7 @@ function cyclic_abbrev(env, id, ty) { const check_cycle = function (seen, ty) { const ty$1 = repr(ty); const match = ty$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return false; } if (match.TAG !== /* Tconstr */3) { @@ -38342,8 +38669,8 @@ function normalize_type_rec(env, visited, ty) { } visited.contents = Curry._2(add$3, ty$1, visited.contents); const row = ty$1.desc; - if (typeof row !== "number") { - switch (row.TAG | 0) { + if (!/* tag */(typeof row === "number" || typeof row === "string")) { + switch (row.TAG) { case /* Tobject */4 : const nm = row._1; const match = nm.contents; @@ -38362,7 +38689,7 @@ function normalize_type_rec(env, visited, ty) { const v$p = repr(v); const match$2 = v$p.desc; let exit = 0; - if (typeof match$2 === "number") { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string") { log_type(ty$1); ty$1.desc = { TAG: /* Tconstr */3, @@ -38373,7 +38700,7 @@ function normalize_type_rec(env, visited, ty) { } }; } else { - switch (match$2.TAG | 0) { + switch (match$2.TAG) { case /* Tvar */0 : case /* Tunivar */9 : exit = 1; @@ -38414,7 +38741,7 @@ function normalize_type_rec(env, visited, ty) { const f0 = param[1]; const f = row_field_repr_aux(/* [] */0, f0); let tmp; - if (typeof f === "number" || f.TAG === /* Rpresent */0) { + if (/* tag */typeof f === "number" || typeof f === "string" || f.TAG === /* Rpresent */0) { tmp = f; } else { const match = f._1; @@ -38503,10 +38830,10 @@ function nondep_type_rec(env, id, _ty) { const ty = _ty; const ty$1 = ty.desc; let exit = 0; - if (typeof ty$1 === "number") { + if (/* tag */typeof ty$1 === "number" || typeof ty$1 === "string") { exit = 1; } else { - switch (ty$1.TAG | 0) { + switch (ty$1.TAG) { case /* Tlink */6 : _ty = ty$1._0; continue ; @@ -38532,10 +38859,10 @@ function nondep_type_rec(env, id, _ty) { const row = ty.desc; let tmp; let exit$1 = 0; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { exit$1 = 2; } else { - switch (row.TAG | 0) { + switch (row.TAG) { case /* Tconstr */3 : const p = row._0; if (isfree(id, p)) { @@ -38727,7 +39054,7 @@ function nondep_type_decl(env, mid, id, is_covariant, decl) { let tk; try { const cstrs = decl.type_kind; - tk = typeof cstrs === "number" ? ( + tk = /* tag */typeof cstrs === "number" || typeof cstrs === "string" ? ( cstrs === /* Type_abstract */0 ? /* Type_abstract */0 : /* Type_open */1 ) : ( cstrs.TAG === /* Type_record */0 ? ({ @@ -38831,7 +39158,7 @@ function nondep_extension_constructor(env, mid, ext) { }); const ty$p = nondep_type_rec(env, mid, ty); const match$1 = repr(ty$p).desc; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { MEL_EXN_ID: Stdlib.Not_found }); @@ -38911,7 +39238,7 @@ function nondep_class_signature(env, id, sign) { function nondep_class_type(env, id, _sign) { while(true) { const sign = _sign; - switch (sign.TAG | 0) { + switch (sign.TAG) { case /* Cty_constr */0 : const p = sign._0; if (!isfree(id, p)) { @@ -39013,7 +39340,7 @@ function collapse_conj(env, visited, ty) { tl: visited }; const row = ty$1.desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { return iter_type_expr((function (param) { return collapse_conj(env, visited$1, param); }), ty$1); @@ -39026,7 +39353,7 @@ function collapse_conj(env, visited, ty) { const row$1 = row_repr_aux(/* [] */0, row._0); Stdlib__List.iter((function (param) { const match = row_field_repr_aux(/* [] */0, param[1]); - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return ; } if (match.TAG === /* Rpresent */0) { @@ -39073,9 +39400,10 @@ const out_ident = { }; function print_ident(ppf, s) { - switch (s.TAG | 0) { + switch (s.TAG) { case /* Oide_apply */0 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -39147,7 +39475,8 @@ function parenthesized_ident(name) { function value_ident(ppf, name) { if (parenthesized_ident(name)) { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "( ", @@ -39187,7 +39516,8 @@ function print_list(pr, sep, ppf, _param) { function pr_present(param, param$1) { return print_list((function (ppf, s) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '`' */96, @@ -39200,7 +39530,8 @@ function pr_present(param, param$1) { _1: "`%s" }), s); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -39218,7 +39549,8 @@ function pr_present(param, param$1) { function pr_vars(param, param$1) { return print_list((function (ppf, s) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '\'' */39, @@ -39231,7 +39563,8 @@ function pr_vars(param, param$1) { _1: "'%s" }), s); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -39248,17 +39581,19 @@ function pr_vars(param, param$1) { } function print_out_type(ppf, ty) { - if (typeof ty === "number") { + if (/* tag */typeof ty === "number" || typeof ty === "string") { return print_out_type_1(ppf, ty); } - switch (ty.TAG | 0) { + switch (ty.TAG) { case /* Otyp_alias */0 : - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -39292,12 +39627,14 @@ function print_out_type(ppf, ty) { _1: "@[%a@ as '%s@]" }), print_out_type, ty._0, ty._1); case /* Otyp_poly */12 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -39339,7 +39676,7 @@ function print_out_type(ppf, ty) { } function print_out_type_1(ppf, ty) { - if (typeof ty === "number") { + if (/* tag */typeof ty === "number" || typeof ty === "string") { return print_out_type_2(ppf, ty); } if (ty.TAG !== /* Otyp_arrow */1) { @@ -39359,15 +39696,17 @@ function print_out_type_1(ppf, ty) { } function print_out_type_2(ppf, tyl) { - if (typeof tyl === "number" || tyl.TAG !== /* Otyp_tuple */9) { + if (/* tag */typeof tyl === "number" || typeof tyl === "string" || tyl.TAG !== /* Otyp_tuple */9) { return print_simple_out_type(ppf, tyl); } else { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<0>", @@ -39393,17 +39732,19 @@ function print_out_type_2(ppf, tyl) { } function print_simple_out_type(ppf, s) { - if (typeof s === "number") { + if (/* tag */typeof s === "number" || typeof s === "string") { return ; } - switch (s.TAG | 0) { + switch (s.TAG) { case /* Otyp_class */2 : - return Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -39433,17 +39774,17 @@ function print_simple_out_type(ppf, s) { case /* Otyp_constr */3 : const id = s._0; let exit = 0; - switch (id.TAG | 0) { + switch (id.TAG) { case /* Oide_dot */1 : const match = id._0; let exit$1 = 0; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Oide_apply */0 : exit = 2; break; case /* Oide_dot */1 : const match$1 = match._0; - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Oide_apply */0 : case /* Oide_dot */1 : exit = 2; @@ -39479,7 +39820,7 @@ function print_simple_out_type(ppf, s) { const tyl = s._1; if (tyl) { const match$2 = tyl.hd; - if (typeof match$2 === "number" || match$2.TAG !== /* Otyp_variant */11) { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string" || match$2.TAG !== /* Otyp_variant */11) { exit = 2; } else { const match$3 = match$2._1; @@ -39493,7 +39834,7 @@ function print_simple_out_type(ppf, s) { const make = function (tys, result) { if (tys) { const single = tys.hd; - if (typeof single !== "number" && single.TAG === /* Otyp_tuple */9) { + if (!/* tag */(typeof single === "number" || typeof single === "string") && single.TAG === /* Otyp_tuple */9) { if (tys.tl) { throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { MEL_EXN_ID: Stdlib.Not_found @@ -39546,12 +39887,14 @@ function print_simple_out_type(ppf, s) { return Stdlib__Format.pp_close_box(ppf, undefined); } if (exit$3 === 5) { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<0>", @@ -39622,7 +39965,7 @@ function print_simple_out_type(ppf, s) { const tyl$1 = s._1; if (tyl$1) { const match$7 = tyl$1.hd; - if (typeof match$7 === "number" || match$7.TAG !== /* Otyp_variant */11) { + if (/* tag */typeof match$7 === "number" || typeof match$7 === "string" || match$7.TAG !== /* Otyp_variant */11) { exit = 2; } else { const match$8 = match$7._1; @@ -39651,7 +39994,7 @@ function print_simple_out_type(ppf, s) { } if (tys) { const single = tys.hd; - if (typeof single !== "number" && single.TAG === /* Otyp_tuple */9) { + if (!/* tag */(typeof single === "number" || typeof single === "string") && single.TAG === /* Otyp_tuple */9) { if (tys.tl) { throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { MEL_EXN_ID: Stdlib.Not_found @@ -39706,12 +40049,14 @@ function print_simple_out_type(ppf, s) { if (exit$4 === 5) { switch (name) { case "fn" : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<0>", @@ -39760,12 +40105,14 @@ function print_simple_out_type(ppf, s) { _1: "@[<0>(%a@ [@u])@]" }), print_out_type_1, res$1); case "meth" : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<0>", @@ -39857,12 +40204,14 @@ function print_simple_out_type(ppf, s) { break; case /* Otyp_object */5 : const rest = s._1; - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -39895,7 +40244,8 @@ function print_simple_out_type(ppf, s) { case /* Otyp_stuff */7 : return Stdlib__Format.pp_print_string(ppf, s._0); case /* Otyp_var */10 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '\'' */39, @@ -39915,7 +40265,8 @@ function print_simple_out_type(ppf, s) { const tags = s._3; const print_present = function (ppf, l) { if (l !== undefined && l) { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -39931,7 +40282,8 @@ function print_simple_out_type(ppf, s) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -39959,7 +40311,8 @@ function print_simple_out_type(ppf, s) { const print_fields$1 = function (ppf, fields) { if (fields.TAG === /* Ovar_fields */0) { return print_list(print_row_field, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -39978,12 +40331,14 @@ function print_simple_out_type(ppf, s) { }); }), ppf, fields._0); } else { - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -40004,7 +40359,8 @@ function print_simple_out_type(ppf, s) { }), print_typargs, fields._1, print_ident, fields._0); } }; - return Curry._6(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._6(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -40018,7 +40374,8 @@ function print_simple_out_type(ppf, s) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -40031,7 +40388,8 @@ function print_simple_out_type(ppf, s) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -40076,12 +40434,14 @@ function print_simple_out_type(ppf, s) { case /* Otyp_poly */12 : break; case /* Otyp_module */13 : - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<1>", @@ -40107,7 +40467,8 @@ function print_simple_out_type(ppf, s) { }; Stdlib__List.iter2((function (s, t) { const sep = first.contents ? (first.contents = false, "with") : "and"; - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -40135,7 +40496,8 @@ function print_simple_out_type(ppf, s) { _1: " %s type %s = %a" }), sep, s, print_out_type, t); }), s._1, s._2); - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ')' */41, @@ -40162,7 +40524,8 @@ function print_fields(rest, ppf, _param) { const param = _param; if (!param) { if (rest !== undefined) { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -40181,7 +40544,8 @@ function print_fields(rest, ppf, _param) { const match = param.hd; const s = match[0]; if (param.tl) { - return Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -40215,7 +40579,8 @@ function print_fields(rest, ppf, _param) { return print_fields(rest, param, param$1); }), param.tl); } - Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -40231,7 +40596,8 @@ function print_fields(rest, ppf, _param) { _1: "%s : %a" }), s, print_out_type, match[1]); if (rest !== undefined) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ';' */59, @@ -40259,7 +40625,8 @@ function print_row_field(ppf, param) { const opt_amp = param[1]; const pr_of = function (ppf) { if (opt_amp) { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " of", @@ -40290,7 +40657,8 @@ function print_row_field(ppf, param) { _1: " of@ &@ " }); } else if (Caml_obj.caml_notequal(tyl, /* [] */0)) { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " of", @@ -40308,18 +40676,21 @@ function print_row_field(ppf, param) { _1: " of@ " }); } else { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" }); } }; - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -40396,7 +40767,8 @@ const out_type = { function type_parameter(ppf, param) { const match = param[1]; const ty = param[0]; - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -40414,12 +40786,14 @@ function type_parameter(ppf, param) { function print_out_class_params(ppf, tyl) { if (tyl) { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<1>", @@ -40457,7 +40831,8 @@ function print_out_class_params(ppf, tyl) { _1: "@[<1>[%a]@]@ " }), (function (param, param$1) { return print_list(type_parameter, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: ", ", @@ -40472,19 +40847,21 @@ function print_out_class_params(ppf, tyl) { } function print_out_class_type(ppf, param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Octy_constr */0 : const pr_tyl = function (ppf, tyl) { if (!tyl) { return ; } const partial_arg = out_type.contents; - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<1>", @@ -40524,12 +40901,14 @@ function print_out_class_type(ppf, param) { return print_typlist(partial_arg, ",", param, param$1); }), tyl); }; - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -40550,12 +40929,14 @@ function print_out_class_type(ppf, param) { }), pr_tyl, param._1, print_ident, param._0); case /* Octy_arrow */1 : const lab = param._0; - return Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -40594,7 +40975,8 @@ function print_out_class_type(ppf, param) { case /* Octy_signature */2 : const pr_param = function (ppf, ty) { if (ty !== undefined) { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -40607,7 +40989,8 @@ function print_out_class_type(ppf, param) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -40635,12 +41018,14 @@ function print_out_class_type(ppf, param) { } }; - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -40653,7 +41038,8 @@ function print_out_class_type(ppf, param) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -40708,7 +41094,8 @@ function print_out_class_type(ppf, param) { _1: "@[@[<2>object%a@]@ %a@;<1 -2>end@]" }), pr_param, param._0, (function (param, param$1) { return print_list(print_out_class_sig_item, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -40728,14 +41115,16 @@ function print_out_class_type(ppf, param) { } function print_out_class_sig_item(ppf, param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Ocsg_constraint */0 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -40776,12 +41165,14 @@ function print_out_class_sig_item(ppf, param) { _1: "@[<2>constraint %a =@ %a@]" }), out_type.contents, param._0, out_type.contents, param._1); case /* Ocsg_method */1 : - return Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -40831,12 +41222,14 @@ function print_out_class_sig_item(ppf, param) { _1: "@[<2>method %s%s%s :@ %a@]" }), param._1 ? "private " : "", param._2 ? "virtual " : "", param._0, out_type.contents, param._3); case /* Ocsg_value */2 : - return Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -40930,10 +41323,11 @@ const out_type_extension = { }; function print_out_functor(ppf, m) { - if (typeof m !== "number" && m.TAG === /* Omty_functor */0) { + if (!/* tag */(typeof m === "number" || typeof m === "string") && m.TAG === /* Omty_functor */0) { const mty_arg = m._1; if (mty_arg !== undefined) { - return Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '(' */40, @@ -40960,7 +41354,8 @@ function print_out_functor(ppf, m) { _1: "(%s : %a) %a" }), m._0, print_out_module_type, mty_arg, print_out_functor, m._2); } else { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "() ", @@ -40973,7 +41368,8 @@ function print_out_functor(ppf, m) { }), print_out_functor, m._2); } } - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "->", @@ -41001,12 +41397,14 @@ function print_out_constr(ppf, param) { const name = param[0]; if (ret_type_opt !== undefined) { if (tyl) { - return Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -41053,12 +41451,14 @@ function print_out_constr(ppf, param) { return print_typlist(print_simple_out_type, " *", param, param$1); }), tyl, print_simple_out_type, ret_type_opt); } else { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -41097,12 +41497,14 @@ function print_out_constr(ppf, param) { }), name, print_simple_out_type, ret_type_opt); } } else if (tyl) { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -41147,12 +41549,14 @@ function print_out_constr(ppf, param) { } function print_out_label(ppf, param) { - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -41207,83 +41611,96 @@ function print_out_signature(ppf, param) { if (!param.tl) { return Curry._2(out_sig_item.contents, ppf, item); } - if (item.TAG === /* Osig_typext */2 && !item._1) { + if (item.TAG === /* Osig_typext */2) { const ext = item._0; - const gather_extensions = function (_acc, _items) { - while(true) { - const items = _items; - const acc = _acc; - if (!items) { - return [ - Stdlib__List.rev(acc), - items - ]; - } - const match = items.hd; - if (match.TAG !== /* Osig_typext */2) { - return [ - Stdlib__List.rev(acc), - items - ]; - } - if (match._1 !== 1) { - return [ - Stdlib__List.rev(acc), - items - ]; - } - const ext = match._0; - _items = items.tl; - _acc = { - hd: [ - ext.oext_name, - ext.oext_args, - ext.oext_ret_type - ], - tl: acc - }; - continue ; - }; - }; - const match = gather_extensions({ - hd: [ - ext.oext_name, - ext.oext_args, - ext.oext_ret_type - ], - tl: /* [] */0 - }, param.tl); - const te_otyext_name = ext.oext_type_name; - const te_otyext_params = ext.oext_type_params; - const te_otyext_constructors = match[0]; - const te_otyext_private = ext.oext_private; - const te = { - otyext_name: te_otyext_name, - otyext_params: te_otyext_params, - otyext_constructors: te_otyext_constructors, - otyext_private: te_otyext_private - }; - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ - _0: { - TAG: /* Alpha */15, - _0: { - TAG: /* Formatting_lit */17, - _0: { - TAG: /* Break */0, - _0: "@ ", - _1: 1, - _2: 0 - }, - _1: { - TAG: /* Alpha */15, - _0: /* End_of_format */0 - } - } - }, - _1: "%a@ %a" - }), out_type_extension.contents, te, print_out_signature, match[1]); + switch (item._1) { + case /* Oext_first */0 : + const gather_extensions = function (_acc, _items) { + while(true) { + const items = _items; + const acc = _acc; + if (!items) { + return [ + Stdlib__List.rev(acc), + items + ]; + } + const match = items.hd; + if (match.TAG !== /* Osig_typext */2) { + return [ + Stdlib__List.rev(acc), + items + ]; + } + const ext = match._0; + switch (match._1) { + case /* Oext_next */1 : + _items = items.tl; + _acc = { + hd: [ + ext.oext_name, + ext.oext_args, + ext.oext_ret_type + ], + tl: acc + }; + continue ; + case /* Oext_first */0 : + case /* Oext_exception */2 : + return [ + Stdlib__List.rev(acc), + items + ]; + + } + }; + }; + const match = gather_extensions({ + hd: [ + ext.oext_name, + ext.oext_args, + ext.oext_ret_type + ], + tl: /* [] */0 + }, param.tl); + const te_otyext_name = ext.oext_type_name; + const te_otyext_params = ext.oext_type_params; + const te_otyext_constructors = match[0]; + const te_otyext_private = ext.oext_private; + const te = { + otyext_name: te_otyext_name, + otyext_params: te_otyext_params, + otyext_constructors: te_otyext_constructors, + otyext_private: te_otyext_private + }; + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, + _0: { + TAG: /* Alpha */15, + _0: { + TAG: /* Formatting_lit */17, + _0: { + TAG: /* Break */0, + _0: "@ ", + _1: 1, + _2: 0 + }, + _1: { + TAG: /* Alpha */15, + _0: /* End_of_format */0 + } + } + }, + _1: "%a@ %a" + }), out_type_extension.contents, te, print_out_signature, match[1]); + case /* Oext_next */1 : + case /* Oext_exception */2 : + break; + + } } - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -41305,17 +41722,19 @@ function print_out_signature(ppf, param) { } function print_out_module_type(ppf, t) { - if (typeof t === "number") { + if (/* tag */typeof t === "number" || typeof t === "string") { return ; } - switch (t.TAG | 0) { + switch (t.TAG) { case /* Omty_functor */0 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -41349,7 +41768,8 @@ function print_out_module_type(ppf, t) { _1: "@[<2>functor@ %a@]" }), print_out_functor, t); case /* Omty_ident */1 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: /* End_of_format */0 @@ -41357,12 +41777,14 @@ function print_out_module_type(ppf, t) { _1: "%a" }), print_ident, t._0); case /* Omty_signature */2 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -41409,7 +41831,8 @@ function print_out_module_type(ppf, t) { _1: "@[sig@ %a@;<1 -2>end@]" }), out_signature.contents, t._0); case /* Omty_alias */3 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "(module ", @@ -41429,14 +41852,16 @@ function print_out_module_type(ppf, t) { } function print_out_sig_item(ppf, param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Osig_class */0 : - return Curry._7(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._7(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -41503,12 +41928,14 @@ function print_out_sig_item(ppf, param) { _1: "@[<2>%s%s@ %a%s@ :@ %a@]" }), param._4 === /* Orec_next */2 ? "and" : "class", param._0 ? " virtual" : "", print_out_class_params, param._2, param._1, out_class_type.contents, param._3); case /* Osig_class_type */1 : - return Curry._7(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._7(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -41576,241 +42003,259 @@ function print_out_sig_item(ppf, param) { }), param._4 === /* Orec_next */2 ? "and" : "class type", param._0 ? " virtual" : "", print_out_class_params, param._2, param._1, out_class_type.contents, param._3); case /* Osig_typext */2 : const ext = param._0; - if (param._1 >= 2) { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ - _0: { - TAG: /* Formatting_gen */18, + switch (param._1) { + case /* Oext_first */0 : + case /* Oext_next */1 : + const print_extended_type = function (ppf) { + const print_type_parameter = function (ppf, ty) { + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { - TAG: /* Open_box */1, - _0: /* Format */{ - _0: { - TAG: /* String_literal */11, - _0: "<2>", - _1: /* End_of_format */0 - }, - _1: "<2>" - } + TAG: /* String */2, + _0: /* No_padding */0, + _1: /* End_of_format */0 }, - _1: { - TAG: /* String_literal */11, - _0: "exception ", - _1: { - TAG: /* Alpha */15, - _0: { - TAG: /* Formatting_lit */17, - _0: /* Close_box */0, - _1: /* End_of_format */0 - } - } - } - }, - _1: "@[<2>exception %a@]" - }), print_out_constr, [ - ext.oext_name, - ext.oext_args, - ext.oext_ret_type - ]); - } else { - const print_extended_type = function (ppf) { - const print_type_parameter = function (ppf, ty) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ - _0: { - TAG: /* String */2, - _0: /* No_padding */0, - _1: /* End_of_format */0 - }, - _1: "%s" - }), ty === "_" ? ty : "'" + ty); - }; - const match = ext.oext_type_params; - if (match) { - if (match.tl) { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ - _0: { - TAG: /* Formatting_gen */18, - _0: { - TAG: /* Open_box */1, - _0: /* Format */{ - _0: /* End_of_format */0, - _1: "" - } - }, - _1: { - TAG: /* Char_literal */12, - _0: /* '(' */40, - _1: { + _1: "%s" + }), ty === "_" ? ty : "'" + ty); + }; + const match = ext.oext_type_params; + if (match) { + if (match.tl) { + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, + _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } }, _1: { - TAG: /* Alpha */15, - _0: { - TAG: /* Char_literal */12, - _0: /* ')' */41, + TAG: /* Char_literal */12, + _0: /* '(' */40, + _1: { + TAG: /* Formatting_gen */18, + _0: { + TAG: /* Open_box */1, + _0: { + TAG: /* Format */0, + _0: /* End_of_format */0, + _1: "" + } + }, _1: { - TAG: /* Formatting_lit */17, - _0: /* Close_box */0, - _1: { - TAG: /* Formatting_lit */17, - _0: { - TAG: /* Break */0, - _0: "@ ", - _1: 1, - _2: 0 - }, + TAG: /* Alpha */15, + _0: { + TAG: /* Char_literal */12, + _0: /* ')' */41, _1: { - TAG: /* String */2, - _0: /* No_padding */0, + TAG: /* Formatting_lit */17, + _0: /* Close_box */0, _1: { TAG: /* Formatting_lit */17, - _0: /* Close_box */0, - _1: /* End_of_format */0 + _0: { + TAG: /* Break */0, + _0: "@ ", + _1: 1, + _2: 0 + }, + _1: { + TAG: /* String */2, + _0: /* No_padding */0, + _1: { + TAG: /* Formatting_lit */17, + _0: /* Close_box */0, + _1: /* End_of_format */0 + } + } } } } } } } - } - } - }, - _1: "@[(@[%a)@]@ %s@]" - }), (function (param, param$1) { - return print_list(print_type_parameter, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ - _0: { - TAG: /* Char_literal */12, - _0: /* ',' */44, - _1: { - TAG: /* Formatting_lit */17, + }, + _1: "@[(@[%a)@]@ %s@]" + }), (function (param, param$1) { + return print_list(print_type_parameter, (function (ppf) { + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { - TAG: /* Break */0, - _0: "@ ", - _1: 1, - _2: 0 + TAG: /* Char_literal */12, + _0: /* ',' */44, + _1: { + TAG: /* Formatting_lit */17, + _0: { + TAG: /* Break */0, + _0: "@ ", + _1: 1, + _2: 0 + }, + _1: /* End_of_format */0 + } }, - _1: /* End_of_format */0 - } - }, - _1: ",@ " - }); - }), param, param$1); - }), ext.oext_type_params, ext.oext_type_name); - } else { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ - _0: { - TAG: /* Formatting_gen */18, + _1: ",@ " + }); + }), param, param$1); + }), ext.oext_type_params, ext.oext_type_name); + } else { + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, + _0: { + TAG: /* Formatting_gen */18, + _0: { + TAG: /* Open_box */1, + _0: { + TAG: /* Format */0, + _0: /* End_of_format */0, + _1: "" + } + }, + _1: { + TAG: /* Alpha */15, + _0: { + TAG: /* Formatting_lit */17, + _0: { + TAG: /* Break */0, + _0: "@ ", + _1: 1, + _2: 0 + }, + _1: { + TAG: /* String */2, + _0: /* No_padding */0, + _1: { + TAG: /* Formatting_lit */17, + _0: /* Close_box */0, + _1: /* End_of_format */0 + } + } + } + } + }, + _1: "@[%a@ %s@]" + }), print_type_parameter, match.hd, ext.oext_type_name); + } + } else { + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { - TAG: /* Open_box */1, - _0: /* Format */{ - _0: /* End_of_format */0, - _1: "" - } + TAG: /* String */2, + _0: /* No_padding */0, + _1: /* End_of_format */0 }, + _1: "%s" + }), ext.oext_type_name); + } + }; + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, + _0: { + TAG: /* Formatting_gen */18, + _0: { + TAG: /* Open_box */1, + _0: { + TAG: /* Format */0, + _0: { + TAG: /* String_literal */11, + _0: "", + _1: /* End_of_format */0 + }, + _1: "" + } + }, + _1: { + TAG: /* String_literal */11, + _0: "type ", _1: { - TAG: /* Alpha */15, + TAG: /* Theta */16, _0: { - TAG: /* Formatting_lit */17, - _0: { - TAG: /* Break */0, - _0: "@ ", - _1: 1, - _2: 0 - }, + TAG: /* String_literal */11, + _0: " +=", _1: { TAG: /* String */2, _0: /* No_padding */0, _1: { TAG: /* Formatting_lit */17, - _0: /* Close_box */0, - _1: /* End_of_format */0 + _0: { + TAG: /* Break */0, + _0: "@;<1 2>", + _1: 1, + _2: 2 + }, + _1: { + TAG: /* Alpha */15, + _0: { + TAG: /* Formatting_lit */17, + _0: /* Close_box */0, + _1: /* End_of_format */0 + } + } } } } } - }, - _1: "@[%a@ %s@]" - }), print_type_parameter, match.hd, ext.oext_type_name); - } - } else { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ - _0: { - TAG: /* String */2, - _0: /* No_padding */0, - _1: /* End_of_format */0 + } }, - _1: "%s" - }), ext.oext_type_name); - } - }; - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ - _0: { - TAG: /* Formatting_gen */18, - _0: { - TAG: /* Open_box */1, - _0: /* Format */{ + _1: "@[type %t +=%s@;<1 2>%a@]" + }), print_extended_type, ext.oext_private === /* Private */0 ? " private" : "", print_out_constr, [ + ext.oext_name, + ext.oext_args, + ext.oext_ret_type + ]); + case /* Oext_exception */2 : + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, + _0: { + TAG: /* Formatting_gen */18, _0: { - TAG: /* String_literal */11, - _0: "", - _1: /* End_of_format */0 + TAG: /* Open_box */1, + _0: { + TAG: /* Format */0, + _0: { + TAG: /* String_literal */11, + _0: "<2>", + _1: /* End_of_format */0 + }, + _1: "<2>" + } }, - _1: "" - } - }, - _1: { - TAG: /* String_literal */11, - _0: "type ", - _1: { - TAG: /* Theta */16, - _0: { + _1: { TAG: /* String_literal */11, - _0: " +=", + _0: "exception ", _1: { - TAG: /* String */2, - _0: /* No_padding */0, - _1: { + TAG: /* Alpha */15, + _0: { TAG: /* Formatting_lit */17, - _0: { - TAG: /* Break */0, - _0: "@;<1 2>", - _1: 1, - _2: 2 - }, - _1: { - TAG: /* Alpha */15, - _0: { - TAG: /* Formatting_lit */17, - _0: /* Close_box */0, - _1: /* End_of_format */0 - } - } + _0: /* Close_box */0, + _1: /* End_of_format */0 } } } - } - } - }, - _1: "@[type %t +=%s@;<1 2>%a@]" - }), print_extended_type, ext.oext_private === /* Private */0 ? " private" : "", print_out_constr, [ - ext.oext_name, - ext.oext_args, - ext.oext_ret_type - ]); + }, + _1: "@[<2>exception %a@]" + }), print_out_constr, [ + ext.oext_name, + ext.oext_args, + ext.oext_ret_type + ]); + } case /* Osig_modtype */3 : const name = param._0; - if (typeof param._1 === "number") { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + let tmp = param._1; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -41836,12 +42281,14 @@ function print_out_sig_item(ppf, param) { _1: "@[<2>module type %s@]" }), name); } else { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -41886,13 +42333,15 @@ function print_out_sig_item(ppf, param) { case /* Osig_module */4 : const name$1 = param._0; const id = param._1; - if (typeof id !== "number" && id.TAG === /* Omty_alias */3) { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + if (!/* tag */(typeof id === "number" || typeof id === "string") && id.TAG === /* Omty_alias */3) { + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -41934,25 +42383,27 @@ function print_out_sig_item(ppf, param) { _1: "@[<2>module %s =@ %a@]" }), name$1, print_ident, id._0); } - let tmp; + let tmp$1; switch (param._2) { case /* Orec_not */0 : - tmp = "module"; + tmp$1 = "module"; break; case /* Orec_first */1 : - tmp = "module rec"; + tmp$1 = "module rec"; break; case /* Orec_next */2 : - tmp = "and"; + tmp$1 = "and"; break; } - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -41996,25 +42447,26 @@ function print_out_sig_item(ppf, param) { } }, _1: "@[<2>%s %s :@ %a@]" - }), tmp, name$1, out_module_type.contents, param._1); + }), tmp$1, name$1, out_module_type.contents, param._1); case /* Osig_type */5 : - let tmp$1; + let tmp$2; switch (param._1) { case /* Orec_not */0 : - tmp$1 = "type nonrec"; + tmp$2 = "type nonrec"; break; case /* Orec_first */1 : - tmp$1 = "type"; + tmp$2 = "type"; break; case /* Orec_next */2 : - tmp$1 = "and"; + tmp$2 = "and"; break; } let td = param._0; const print_constraints = function (ppf) { Stdlib__List.iter((function (param) { - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -42027,7 +42479,8 @@ function print_out_sig_item(ppf, param) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -42074,12 +42527,14 @@ function print_out_sig_item(ppf, param) { const match = td.otype_params; if (match) { if (match.tl) { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -42091,7 +42546,8 @@ function print_out_sig_item(ppf, param) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -42131,7 +42587,8 @@ function print_out_sig_item(ppf, param) { _1: "@[(@[%a)@]@ %s@]" }), (function (param, param$1) { return print_list(type_parameter, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ',' */44, @@ -42151,12 +42608,14 @@ function print_out_sig_item(ppf, param) { }), param, param$1); }), td.otype_params, td.otype_name); } else { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -42191,10 +42650,11 @@ function print_out_sig_item(ppf, param) { } }; const print_manifest = function (ppf, param) { - if (typeof param === "number" || param.TAG !== /* Otyp_manifest */4) { + if (/* tag */typeof param === "number" || typeof param === "string" || param.TAG !== /* Otyp_manifest */4) { return ; } else { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " =", @@ -42217,7 +42677,8 @@ function print_out_sig_item(ppf, param) { } }; const print_name_params = function (ppf) { - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -42234,16 +42695,15 @@ function print_out_sig_item(ppf, param) { } }, _1: "%s %t%a" - }), tmp$1, type_defined, print_manifest, td.otype_type); + }), tmp$2, type_defined, print_manifest, td.otype_type); }; const match = td.otype_type; let ty; - ty = typeof match === "number" || match.TAG !== /* Otyp_manifest */4 ? td.otype_type : match._1; + ty = /* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Otyp_manifest */4 ? td.otype_type : match._1; const print_private = function (ppf, param) { - if (param) { - return ; - } else { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + if (param === /* Private */0) { + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " private", @@ -42252,13 +42712,15 @@ function print_out_sig_item(ppf, param) { _1: " private" }); } + }; const print_out_tkind = function (ppf, lbls) { - if (typeof lbls === "number") { + if (/* tag */typeof lbls === "number" || typeof lbls === "string") { if (lbls === /* Otyp_abstract */0) { return ; } else { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " = ..", @@ -42268,9 +42730,10 @@ function print_out_sig_item(ppf, param) { }); } } - switch (lbls.TAG | 0) { + switch (lbls.TAG) { case /* Otyp_record */6 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " =", @@ -42302,7 +42765,8 @@ function print_out_sig_item(ppf, param) { _1: " =%a {%a@;<1 -2>}" }), print_private, td.otype_private, (function (param, param$1) { const sep = function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -42329,7 +42793,8 @@ function print_out_sig_item(ppf, param) { }; }), lbls._0); case /* Otyp_sum */8 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " =", @@ -42353,7 +42818,8 @@ function print_out_sig_item(ppf, param) { _1: " =%a@;<1 2>%a" }), print_private, td.otype_private, (function (param, param$1) { return print_list(print_out_constr, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -42373,7 +42839,8 @@ function print_out_sig_item(ppf, param) { }), param, param$1); }), lbls._0); default: - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " =", @@ -42398,12 +42865,14 @@ function print_out_sig_item(ppf, param) { }), print_private, td.otype_private, out_type.contents, lbls); } }; - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -42416,7 +42885,8 @@ function print_out_sig_item(ppf, param) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -42452,7 +42922,8 @@ function print_out_sig_item(ppf, param) { const kwd = Caml_obj.caml_equal(prims, /* [] */0) ? "val" : "external"; const pr_prims = function (ppf, param) { if (param) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -42480,7 +42951,8 @@ function print_out_sig_item(ppf, param) { return Stdlib__List.iter((function (s) { const len = s.length; if (len >= 3 && Caml_string.get(s, 0) === /* 'B' */66 && Caml_string.get(s, 1) === /* 'S' */83 && Caml_string.get(s, 2) === /* ':' */58) { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -42498,7 +42970,8 @@ function print_out_sig_item(ppf, param) { _1: "@ \"BS-EXTERNAL\"" }); } else { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -42528,12 +43001,14 @@ function print_out_sig_item(ppf, param) { } }; - return Curry._7(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._7(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -42587,7 +43062,8 @@ function print_out_sig_item(ppf, param) { function print_out_type_extension(ppf, te) { const print_extended_type = function (ppf) { const print_type_parameter = function (ppf, ty) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -42599,12 +43075,14 @@ function print_out_type_extension(ppf, te) { const match = te.otyext_params; if (match) { if (match.tl) { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -42616,7 +43094,8 @@ function print_out_type_extension(ppf, te) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -42656,7 +43135,8 @@ function print_out_type_extension(ppf, te) { _1: "@[(@[%a)@]@ %s@]" }), (function (param, param$1) { return print_list(print_type_parameter, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ',' */44, @@ -42676,12 +43156,14 @@ function print_out_type_extension(ppf, te) { }), param, param$1); }), te.otyext_params, te.otyext_name); } else { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -42712,7 +43194,8 @@ function print_out_type_extension(ppf, te) { }), print_type_parameter, match.hd, te.otyext_name); } } else { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -42722,12 +43205,14 @@ function print_out_type_extension(ppf, te) { }), te.otyext_name); } }; - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -42772,7 +43257,8 @@ function print_out_type_extension(ppf, te) { _1: "@[type %t +=%s@;<1 2>%a@]" }), print_extended_type, te.otyext_private === /* Private */0 ? " private" : "", (function (param, param$1) { return print_list(print_out_constr, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -42802,11 +43288,12 @@ out_sig_item.contents = print_out_sig_item; out_type_extension.contents = print_out_type_extension; function longident(ppf, s) { - switch (s.TAG | 0) { + switch (s.TAG) { case /* Lident */0 : return Stdlib__Format.pp_print_string(ppf, s._0); case /* Ldot */1 : - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -42822,7 +43309,8 @@ function longident(ppf, s) { _1: "%a.%s" }), longident, s._0, s._1); case /* Lapply */2 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -42887,7 +43375,7 @@ const ident_pervasive = { }; function tree_of_path(id) { - switch (id.TAG | 0) { + switch (id.TAG) { case /* Pident */0 : return { TAG: /* Oide_ident */2, @@ -42895,7 +43383,7 @@ function tree_of_path(id) { }; case /* Pdot */1 : const id$1 = id._0; - switch (id$1.TAG | 0) { + switch (id$1.TAG) { case /* Pident */0 : if (Caml_obj.caml_equal(id$1._0, ident_pervasive)) { return { @@ -42925,12 +43413,12 @@ function tree_of_path(id) { } function path(ppf, id) { - switch (id.TAG | 0) { + switch (id.TAG) { case /* Pident */0 : return Stdlib__Format.pp_print_string(ppf, ident_name(id._0)); case /* Pdot */1 : const id$1 = id._0; - switch (id$1.TAG | 0) { + switch (id$1.TAG) { case /* Pident */0 : if (Caml_obj.caml_equal(id$1._0, ident_pervasive)) { return Stdlib__Format.pp_print_string(ppf, id._1); @@ -42945,7 +43433,8 @@ function path(ppf, id) { Stdlib__Format.pp_print_char(ppf, /* '.' */46); return Stdlib__Format.pp_print_string(ppf, id._1); case /* Papply */2 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -42968,7 +43457,7 @@ function path(ppf, id) { } function string_of_out_ident(s) { - switch (s.TAG | 0) { + switch (s.TAG) { case /* Oide_apply */0 : return Stdlib__String.concat("", { hd: string_of_out_ident(s._0), @@ -43001,9 +43490,22 @@ function string_of_path(p) { return string_of_out_ident(tree_of_path(p)); } +function tree_of_rec(param) { + switch (param) { + case /* Trec_not */0 : + return /* Orec_not */0; + case /* Trec_first */1 : + return /* Orec_first */1; + case /* Trec_next */2 : + return /* Orec_next */2; + + } +} + function raw_list(pr, ppf, param) { if (!param) { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "[]", @@ -43013,12 +43515,14 @@ function raw_list(pr, ppf, param) { }); } const l = param.tl; - Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<1>", @@ -43050,7 +43554,8 @@ function raw_list(pr, ppf, param) { _1: "@[<1>[%a%t]@]" }), pr, param.hd, (function (ppf) { Stdlib__List.iter((function (x) { - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ';' */59, @@ -43078,11 +43583,11 @@ function safe_kind_repr(_v, _param) { while(true) { const param = _param; const v = _v; - if (typeof param === "number") { - if (param) { - return "Fabsent"; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { + if (param === /* Fpresent */0) { return "Fpresent"; + } else { + return "Fabsent"; } } const k = param._0.contents; @@ -43105,11 +43610,11 @@ function safe_commu_repr(_v, _r) { while(true) { const r = _r; const v = _v; - if (typeof r === "number") { - if (r) { - return "Cunknown"; - } else { + if (/* tag */typeof r === "number" || typeof r === "string") { + if (r === /* Cok */0) { return "Cok"; + } else { + return "Cunknown"; } } const r$1 = r._0; @@ -43130,7 +43635,7 @@ function safe_repr(_v, _t) { const t = _t; const v = _v; const t$1 = t.desc; - if (typeof t$1 === "number") { + if (/* tag */typeof t$1 === "number" || typeof t$1 === "string") { return t; } if (t$1.TAG !== /* Tlink */6) { @@ -43152,7 +43657,7 @@ function safe_repr(_v, _t) { function list_of_memo(_rem) { while(true) { const rem = _rem; - if (typeof rem === "number") { + if (/* tag */typeof rem === "number" || typeof rem === "string") { return /* [] */0; } if (rem.TAG === /* Mcons */0) { @@ -43168,7 +43673,8 @@ function list_of_memo(_rem) { function print_name(ppf, name) { if (name !== undefined) { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '"' */34, @@ -43185,7 +43691,8 @@ function print_name(ppf, name) { _1: "\"%s\"" }), name); } else { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "None", @@ -43203,7 +43710,8 @@ const visited = { function raw_type(ppf, ty) { const ty$1 = safe_repr(/* [] */0, ty); if (Stdlib__List.memq(ty$1, visited.contents)) { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "{id=", @@ -43226,12 +43734,14 @@ function raw_type(ppf, ty) { hd: ty$1, tl: visited.contents }; - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<1>", @@ -43298,8 +43808,9 @@ function raw_type_list(tl) { } function raw_type_desc(ppf, name) { - if (typeof name === "number") { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + if (/* tag */typeof name === "number" || typeof name === "string") { + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Tnil", @@ -43308,9 +43819,10 @@ function raw_type_desc(ppf, name) { _1: "Tnil" }); } - switch (name.TAG | 0) { + switch (name.TAG) { case /* Tvar */0 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Tvar ", @@ -43322,12 +43834,14 @@ function raw_type_desc(ppf, name) { _1: "Tvar %a" }), print_name, name._0); case /* Tarrow */1 : - return Curry._6(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._6(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -43406,12 +43920,14 @@ function raw_type_desc(ppf, name) { _1: "@[Tarrow(%s,@,%a,@,%a,@,%s)@]" }), name._0, raw_type, name._1, raw_type, name._2, safe_commu_repr(/* [] */0, name._3)); case /* Ttuple */2 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<1>", @@ -43445,12 +43961,14 @@ function raw_type_desc(ppf, name) { _1: "@[<1>Ttuple@,%a@]" }), raw_type_list, name._0); case /* Tconstr */3 : - return Curry._6(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._6(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -43523,12 +44041,14 @@ function raw_type_desc(ppf, name) { }), list_of_memo(name._2.contents)); case /* Tobject */4 : const nm = name._1; - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -43565,7 +44085,8 @@ function raw_type_desc(ppf, name) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<1>", @@ -43605,7 +44126,8 @@ function raw_type_desc(ppf, name) { }), raw_type, name._0, (function (ppf) { const match = nm.contents; if (match !== undefined) { - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "(Some(", @@ -43646,7 +44168,8 @@ function raw_type_desc(ppf, name) { _1: "(Some(@,%a,@,%a))" }), path, match[0], raw_type_list, match[1]); } else { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " None", @@ -43657,12 +44180,14 @@ function raw_type_desc(ppf, name) { } })); case /* Tfield */5 : - return Curry._6(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._6(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -43750,12 +44275,14 @@ function raw_type_desc(ppf, name) { _1: "@[Tfield(@,%s,@,%s,@,%a,@;<0 -1>%a)@]" }), name._0, safe_kind_repr(/* [] */0, name._1), raw_type, name._2, raw_type, name._3); case /* Tlink */6 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<1>", @@ -43789,12 +44316,14 @@ function raw_type_desc(ppf, name) { _1: "@[<1>Tlink@,%a@]" }), raw_type, name._0); case /* Tsubst */7 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<1>", @@ -43829,12 +44358,14 @@ function raw_type_desc(ppf, name) { }), raw_type, name._0); case /* Tvariant */8 : const row = name._0; - return Curry.app(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry.app(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -43850,7 +44381,8 @@ function raw_type_desc(ppf, name) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -43886,7 +44418,8 @@ function raw_type_desc(ppf, name) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -43956,7 +44489,8 @@ function raw_type_desc(ppf, name) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<1>", @@ -44015,12 +44549,14 @@ function raw_type_desc(ppf, name) { "row_fields=", (function (param, param$1) { return raw_list((function (ppf, param) { - Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -44067,7 +44603,8 @@ function raw_type_desc(ppf, name) { (function (ppf) { const match = row.row_name; if (match !== undefined) { - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Some(", @@ -44108,7 +44645,8 @@ function raw_type_desc(ppf, name) { _1: "Some(@,%a,@,%a)" }), path, match[0], raw_type_list, match[1]); } else { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "None", @@ -44120,7 +44658,8 @@ function raw_type_desc(ppf, name) { }) ]); case /* Tunivar */9 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Tunivar ", @@ -44132,12 +44671,14 @@ function raw_type_desc(ppf, name) { _1: "Tunivar %a" }), print_name, name._0); case /* Tpoly */10 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -44191,12 +44732,14 @@ function raw_type_desc(ppf, name) { _1: "@[Tpoly(@,%a,@,%a)@]" }), raw_type, name._0, raw_type_list, name._1); case /* Tpackage */11 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -44250,8 +44793,9 @@ function raw_type_desc(ppf, name) { } function raw_field(ppf, param) { - if (typeof param === "number") { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + if (/* tag */typeof param === "number" || typeof param === "string") { + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Rabsent", @@ -44263,12 +44807,14 @@ function raw_field(ppf, param) { if (param.TAG === /* Rpresent */0) { const t = param._0; if (t !== undefined) { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<1>", @@ -44306,7 +44852,8 @@ function raw_field(ppf, param) { _1: "@[<1>Rpresent(Some@,%a)@]" }), raw_type, t); } else { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Rpresent None", @@ -44317,12 +44864,14 @@ function raw_field(ppf, param) { } } const e = param._3; - Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -44379,7 +44928,8 @@ function raw_field(ppf, param) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<1>", @@ -44424,7 +44974,8 @@ function raw_field(ppf, param) { }), param._0, raw_type_list, param._1, param._2, (function (ppf) { const f = e.contents; if (f !== undefined) { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -44437,7 +44988,8 @@ function raw_field(ppf, param) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<1>", @@ -44467,7 +45019,8 @@ function raw_field(ppf, param) { _1: "@,@[<1>(%a)@]" }), raw_field, f); } else { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " None", @@ -44488,7 +45041,7 @@ function raw_type_expr(ppf, t) { print_raw = raw_type_expr; function is_nth(param) { - if (typeof param === "number" || param.TAG !== /* Nth */0) { + if (/* tag */typeof param === "number" || typeof param === "string" || param.TAG !== /* Nth */0) { return false; } else { return true; @@ -44496,7 +45049,7 @@ function is_nth(param) { } function compose(l1, l2) { - if (typeof l2 === "number") { + if (/* tag */typeof l2 === "number" || typeof l2 === "string") { return { TAG: /* Map */1, _0: l1 @@ -44517,7 +45070,7 @@ function compose(l1, l2) { } function apply_subst(s1, tyl) { - if (typeof s1 === "number") { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return tyl; } else if (s1.TAG === /* Nth */0) { return { @@ -44555,11 +45108,11 @@ function compare$4(_p1, _p2) { while(true) { const p2 = _p2; const p1 = _p1; - switch (p1.TAG | 0) { + switch (p1.TAG) { case /* Pident */0 : return Caml_obj.caml_compare(p1, p2); case /* Pdot */1 : - switch (p2.TAG | 0) { + switch (p2.TAG) { case /* Pdot */1 : const c = compare$4(p1._0, p2._0); if (c !== 0) { @@ -44573,7 +45126,7 @@ function compare$4(_p1, _p2) { } case /* Papply */2 : - switch (p2.TAG | 0) { + switch (p2.TAG) { case /* Pident */0 : case /* Pdot */1 : return Caml_obj.caml_compare(p1, p2); @@ -44597,17 +45150,18 @@ const funarg$3 = { }; function height$6(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$7(l, x, d, r) { const hl = height$6(l); const hr = height$6(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -44617,32 +45171,35 @@ function create$7(l, x, d, r) { } function bal$6(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height$6(ll) >= height$6(lr)) { - return create$7(ll, lv, ld, create$7(lr, x, d, r)); - } - if (lr) { - return create$7(create$7(ll, lv, ld, lr.l), lr.v, lr.d, create$7(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height$6(ll) >= height$6(lr)) { + return create$7(ll, lv, ld, create$7(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$7(create$7(ll, lv, ld, lr.l), lr.v, lr.d, create$7(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -44650,22 +45207,22 @@ function bal$6(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height$6(rr) >= height$6(rl)) { - return create$7(create$7(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create$7(create$7(l, x, d, rl.l), rl.v, rl.d, create$7(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height$6(rr) >= height$6(rl)) { + return create$7(create$7(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$7(create$7(l, x, d, rl.l), rl.v, rl.d, create$7(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -44673,8 +45230,9 @@ function bal$6(l, x, d, r) { } function add$8(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -44691,7 +45249,8 @@ function add$8(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -44719,17 +45278,17 @@ function add$8(x, data, m) { function find$4(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(funarg$3.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(funarg$3.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } @@ -44776,7 +45335,7 @@ function normalize_type_path(cacheOpt, env, p) { const params = Stdlib__List.map(repr, match[0]); const ty = repr(match[1]); const match$1 = ty.desc; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return [ p, { @@ -44829,7 +45388,7 @@ function normalize_type_path(cacheOpt, env, p) { } function path_size(id) { - switch (id.TAG | 0) { + switch (id.TAG) { case /* Pident */0 : const id$1 = id._0; const s = id$1.name; @@ -45072,10 +45631,10 @@ function reset_names(param) { function add_named_var(ty) { const match = ty.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return ; } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tvar */0 : case /* Tunivar */9 : break; @@ -45124,10 +45683,10 @@ function name_of_type(t) { const match = t.desc; let name; let exit = 0; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { name = new_name(undefined); } else { - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tvar */0 : case /* Tunivar */9 : exit = 1; @@ -45221,10 +45780,10 @@ function add_alias(ty) { function aliasable(ty) { const match = ty.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return true; } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tconstr */3 : return !is_nth(best_type_path(match._0)[1]); case /* Tvar */0 : @@ -45240,7 +45799,7 @@ function namable_row(row) { if (row.row_name !== undefined) { return Stdlib__List.for_all((function (param) { const match = row_field_repr_aux(/* [] */0, param[1]); - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return true; } if (match.TAG === /* Rpresent */0) { @@ -45276,10 +45835,10 @@ function mark_loops_rec(_visited, _ty) { tl: visited }; const tyl = ty$1.desc; - if (typeof tyl === "number") { + if (/* tag */typeof tyl === "number" || typeof tyl === "string") { return ; } - switch (tyl.TAG | 0) { + switch (tyl.TAG) { case /* Tarrow */1 : mark_loops_rec(visited$1, tyl._1); _ty = tyl._2; @@ -45412,10 +45971,10 @@ function tree_of_typexp(sch, ty) { } const pr_typ = function (param) { const tyl = ty$1.desc; - if (typeof tyl === "number") { + if (/* tag */typeof tyl === "number" || typeof tyl === "string") { return tree_of_typobject(sch, ty$1, undefined); } - switch (tyl.TAG | 0) { + switch (tyl.TAG) { case /* Tvar */0 : return { TAG: /* Otyp_var */10, @@ -45430,7 +45989,7 @@ function tree_of_typexp(sch, ty) { let t1; if (is_optional(l)) { const match = repr(ty1).desc; - if (typeof match === "number" || match.TAG !== /* Tconstr */3) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tconstr */3) { t1 = { TAG: /* Otyp_stuff */7, _0: "" @@ -45488,7 +46047,7 @@ function tree_of_typexp(sch, ty) { }), row.row_fields) : row.row_fields; const present = Stdlib__List.filter((function (param) { const match = row_field_repr_aux(/* [] */0, param[1]); - if (typeof match === "number" || match.TAG !== /* Rpresent */0) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Rpresent */0) { return false; } else { return true; @@ -45526,7 +46085,7 @@ function tree_of_typexp(sch, ty) { let exit = 0; if (args) { const match$5 = args.hd; - if (typeof match$5 === "number" || !(match$5.TAG === /* Otyp_constr */3 && !(args.tl || !is_nth(s$1)))) { + if (/* tag */typeof match$5 === "number" || typeof match$5 === "string" || !(match$5.TAG === /* Otyp_constr */3 && !(args.tl || !is_nth(s$1)))) { exit = 2; } else { inh = { @@ -45561,7 +46120,7 @@ function tree_of_typexp(sch, ty) { const fields$1 = Stdlib__List.map((function (param) { const l = param[0]; const match = row_field_repr_aux(/* [] */0, param[1]); - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return [ l, false, @@ -45718,7 +46277,7 @@ function tree_of_typobject(sch, fi, nm) { const match = flatten_fields(fi); const present_fields = Stdlib__List.fold_right((function (param, l) { const match = field_kind_repr(param[1]); - if (typeof match === "number" && !match) { + if (/* tag */(typeof match === "number" || typeof match === "string") && match === /* Fpresent */0) { return { hd: [ param[0], @@ -45771,10 +46330,10 @@ function tree_of_typfields(sch, rest, param) { } const match$2 = rest.desc; let rest$1; - if (typeof match$2 === "number") { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string") { rest$1 = undefined; } else { - switch (match$2.TAG | 0) { + switch (match$2.TAG) { case /* Tconstr */3 : rest$1 = false; break; @@ -45891,7 +46450,7 @@ function tree_of_type_decl(id, decl) { const vars = free_variables$1(undefined, ty); Stdlib__List.iter((function (ty) { const match = ty.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return ; } if (match.TAG !== /* Tvar */0) { @@ -45917,14 +46476,14 @@ function tree_of_type_decl(id, decl) { const match = repr(ty$1); const row = match.desc; let ty$2; - if (typeof row === "number" || row.TAG !== /* Tvariant */8) { + if (/* tag */typeof row === "number" || typeof row === "string" || row.TAG !== /* Tvariant */8) { ty$2 = ty$1; } else { const row$1 = row_repr_aux(/* [] */0, row._0); const match$1 = row$1.row_name; if (match$1 !== undefined) { const id$p = match$1[0]; - switch (id$p.TAG | 0) { + switch (id$p.TAG) { case /* Pident */0 : ty$2 = Caml_obj.caml_equal(id, id$p._0) ? newty2(100000000, { TAG: /* Tvariant */8, @@ -45954,7 +46513,7 @@ function tree_of_type_decl(id, decl) { ty_manifest = undefined; } const cstrs = decl.type_kind; - if (typeof cstrs === "number") { + if (/* tag */typeof cstrs === "number" || typeof cstrs === "string") { cstrs === /* Type_abstract */0; } else if (cstrs.TAG === /* Type_record */0) { Stdlib__List.iter((function (l) { @@ -45967,7 +46526,7 @@ function tree_of_type_decl(id, decl) { }), cstrs._0); } const type_param = function (param) { - if (typeof param === "number" || param.TAG !== /* Otyp_var */10) { + if (/* tag */typeof param === "number" || typeof param === "string" || param.TAG !== /* Otyp_var */10) { return "?"; } else { return param._1; @@ -45976,7 +46535,7 @@ function tree_of_type_decl(id, decl) { const type_defined = function (decl) { const tll = decl.type_kind; let abstr; - abstr = typeof tll === "number" ? ( + abstr = /* tag */typeof tll === "number" || typeof tll === "string" ? ( tll === /* Type_abstract */0 ? decl.type_manifest === undefined || decl.type_private === /* Private */0 : decl.type_manifest === undefined ) : ( tll.TAG === /* Type_record */0 ? decl.type_private === /* Private */0 : decl.type_private === /* Private */0 || Stdlib__List.exists((function (cd) { @@ -46018,7 +46577,7 @@ function tree_of_type_decl(id, decl) { const constraints = tree_of_constraints(params); const cstrs$1 = decl.type_kind; let match$3; - match$3 = typeof cstrs$1 === "number" ? ( + match$3 = /* tag */typeof cstrs$1 === "number" || typeof cstrs$1 === "string" ? ( cstrs$1 === /* Type_abstract */0 ? ( ty_manifest !== undefined ? [ tree_of_typexp(false, ty_manifest), @@ -46059,7 +46618,7 @@ function tree_of_type_declaration(id, decl, rs) { return { TAG: /* Osig_type */5, _0: tree_of_type_decl(id, decl), - _1: rs + _1: tree_of_rec(rs) }; } @@ -46078,7 +46637,7 @@ function tree_of_extension_constructor(id, ext, es) { may(mark_loops, ext.ext_ret_type); const ty_params$1 = Stdlib__List.map((function (ty) { let param = tree_of_typexp(false, ty); - if (typeof param === "number" || param.TAG !== /* Otyp_var */10) { + if (/* tag */typeof param === "number" || typeof param === "string" || param.TAG !== /* Otyp_var */10) { return "?"; } else { return param._1; @@ -46118,10 +46677,23 @@ function tree_of_extension_constructor(id, ext, es) { oext_ret_type: ext_oext_ret_type, oext_private: ext_oext_private }; + let es$1; + switch (es) { + case /* Text_first */0 : + es$1 = /* Oext_first */0; + break; + case /* Text_next */1 : + es$1 = /* Oext_next */1; + break; + case /* Text_exception */2 : + es$1 = /* Oext_exception */2; + break; + + } return { TAG: /* Osig_typext */2, _0: ext$1, - _1: es + _1: es$1 }; } @@ -46134,7 +46706,7 @@ function tree_of_value_description(id, decl) { const ty = tree_of_type_scheme(decl.val_type); const p = decl.val_kind; let prims; - prims = typeof p === "number" || p.TAG !== /* Val_prim */0 ? /* [] */0 : description_list(p._0); + prims = /* tag */typeof p === "number" || typeof p === "string" || p.TAG !== /* Val_prim */0 ? /* [] */0 : description_list(p._0); return { TAG: /* Osig_value */6, _0: id$1, @@ -46150,20 +46722,20 @@ function value_description$1(id, ppf, decl) { function method_type(param) { const match = field_kind_repr(param[1]); const match$1 = repr(param[2]); - if (typeof match !== "number") { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { return [ match$1, /* [] */0 ]; } - if (match) { + if (match !== /* Fpresent */0) { return [ match$1, /* [] */0 ]; } const match$2 = match$1.desc; - if (typeof match$2 === "number" || match$2.TAG !== /* Tpoly */10) { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string" || match$2.TAG !== /* Tpoly */10) { return [ match$1, /* [] */0 @@ -46179,7 +46751,7 @@ function method_type(param) { function prepare_class_type(params, _sign) { while(true) { const sign = _sign; - switch (sign.TAG | 0) { + switch (sign.TAG) { case /* Cty_constr */0 : const cty = sign._2; const tyl = sign._1; @@ -46222,7 +46794,7 @@ function prepare_class_type(params, _sign) { function tree_of_class_type(sch, params, _sign) { while(true) { const sign = _sign; - switch (sign.TAG | 0) { + switch (sign.TAG) { case /* Cty_constr */0 : const cty = sign._2; const sty = repr(signature_of_class_type(cty).csig_self); @@ -46320,7 +46892,7 @@ function tree_of_class_type(sch, params, _sign) { if (is_optional(l)) { const match$1 = repr(ty).desc; let exit = 0; - if (typeof match$1 === "number" || match$1.TAG !== /* Tconstr */3) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Tconstr */3) { exit = 1; } else { const match$2 = match$1._1; @@ -46361,7 +46933,7 @@ function class_type$2(ppf, cty) { function tree_of_class_param(param, variance) { const match = tree_of_typexp(true, param); let tmp; - tmp = typeof match === "number" || match.TAG !== /* Otyp_var */10 ? "?" : match._1; + tmp = /* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Otyp_var */10 ? "?" : match._1; return [ tmp, is_Tvar(repr(param)) ? [ @@ -46399,7 +46971,7 @@ function tree_of_class_declaration(id, cl, rs) { _1: id.name, _2: Stdlib__List.map2(tree_of_class_param, params, class_variance(cl.cty_variance)), _3: tree_of_class_type(true, params, cl.cty_type), - _4: rs + _4: tree_of_rec(rs) }; } @@ -46437,7 +47009,7 @@ function tree_of_cltype_declaration(id, cl, rs) { _1: id.name, _2: Stdlib__List.map2(tree_of_class_param, params, class_variance(cl.clty_variance)), _3: tree_of_class_type(true, params, cl.clty_type), - _4: rs + _4: tree_of_rec(rs) }; } @@ -46454,7 +47026,7 @@ function wrap_env(fenv, ftree, arg) { } function filter_rem_sig(item, rem) { - switch (item.TAG | 0) { + switch (item.TAG) { case /* Sig_class */5 : if (!rem) { return [ @@ -46551,14 +47123,20 @@ function hide_rec_items(param) { return /* [] */0; } const match = param.hd; - if (match.TAG === /* Sig_type */1 && match._2 >= 2) { - return { - hd: match._0, - tl: get_ids(param.tl) - }; - } else { + if (match.TAG !== /* Sig_type */1) { return /* [] */0; } + switch (match._2) { + case /* Trec_not */0 : + case /* Trec_first */1 : + return /* [] */0; + case /* Trec_next */2 : + return { + hd: match._0, + tl: get_ids(param.tl) + }; + + } }; const ids_0 = match._0; const ids_1 = get_ids(param.tl); @@ -46575,7 +47153,7 @@ function hide_rec_items(param) { } function tree_of_modtype(p) { - switch (p.TAG | 0) { + switch (p.TAG) { case /* Mty_ident */0 : return { TAG: /* Omty_ident */1, @@ -46632,10 +47210,15 @@ function tree_of_signature_rec(env$p, in_type_group, param) { let exit = 0; if (in_type_group) { if (item.TAG === /* Sig_type */1) { - if (item._2 >= 2) { - in_type_group$1 = true; - } else { - exit = 1; + switch (item._2) { + case /* Trec_not */0 : + case /* Trec_first */1 : + exit = 1; + break; + case /* Trec_next */2 : + in_type_group$1 = true; + break; + } } else { set_printing_env(env$p); @@ -46645,13 +47228,28 @@ function tree_of_signature_rec(env$p, in_type_group, param) { exit = 1; } if (exit === 1) { - set_printing_env(env$p); - in_type_group$1 = item.TAG === /* Sig_type */1 && item._2 < 2 ? true : false; + if (item.TAG === /* Sig_type */1) { + switch (item._2) { + case /* Trec_not */0 : + case /* Trec_first */1 : + set_printing_env(env$p); + in_type_group$1 = true; + break; + case /* Trec_next */2 : + set_printing_env(env$p); + in_type_group$1 = false; + break; + + } + } else { + set_printing_env(env$p); + in_type_group$1 = false; + } } const match = filter_rem_sig(item, param.tl); const rem = match[1]; let trees; - switch (item.TAG | 0) { + switch (item.TAG) { case /* Sig_value */0 : trees = { hd: tree_of_value_description(item._0, item._1), @@ -46671,7 +47269,7 @@ function tree_of_signature_rec(env$p, in_type_group, param) { hd: { TAG: /* Osig_type */5, _0: tree_of_type_decl(id, item._1), - _1: item._2 + _1: tree_of_rec(item._2) }, tl: /* [] */0 }; @@ -46689,7 +47287,7 @@ function tree_of_signature_rec(env$p, in_type_group, param) { TAG: /* Osig_module */4, _0: item._0.name, _1: tree_of_modtype(item._1.md_type), - _2: item._2 + _2: tree_of_rec(item._2) }, tl: /* [] */0 }; @@ -46740,12 +47338,14 @@ function modtype_declaration$1(id, ppf, decl) { } function print_signature(ppf, tree) { - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -46768,7 +47368,8 @@ function print_signature(ppf, tree) { } function signature$3(ppf, sg) { - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: /* End_of_format */0 @@ -46785,13 +47386,13 @@ function same_path(t, t$p) { } const match = t$1.desc; const match$1 = t$p$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return false; } if (match.TAG !== /* Tconstr */3) { return false; } - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return false; } if (match$1.TAG !== /* Tconstr */3) { @@ -46802,11 +47403,11 @@ function same_path(t, t$p) { const match$3 = best_type_path(match$1._0); const s2 = match$3[1]; let exit = 0; - if (typeof s1 === "number") { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { exit = 1; } else { if (s1.TAG === /* Nth */0) { - if (typeof s2 === "number" || s2.TAG !== /* Nth */0) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string" || s2.TAG !== /* Nth */0) { return false; } else { return s1._0 === s2._0; @@ -46816,7 +47417,7 @@ function same_path(t, t$p) { } if (exit === 1) { let exit$1 = 0; - if (typeof s2 === "number") { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { exit$1 = 2; } else { if (s2.TAG === /* Nth */0) { @@ -46846,12 +47447,14 @@ function type_expansion(t, ppf, t$p) { return type_expr$1(ppf, t); } const t$p$1 = proxy(t) === proxy(t$p) ? unalias(t$p) : t$p; - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -46902,12 +47505,14 @@ function type_path_expansion(tp, ppf, tp$p) { if (same(tp, tp$p)) { return path(ppf, tp); } else { - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -46968,7 +47573,8 @@ function trace(fst, txt, ppf, param) { const match$2 = param.hd; const t1 = match$2[0]; if (!fst) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -46982,12 +47588,14 @@ function trace(fst, txt, ppf, param) { _1: "@," }); } - Curry._7(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._7(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -47100,7 +47708,8 @@ function type_path_list(ppf, param) { const match = param.hd; const tp = match[0]; if (param.tl) { - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -47129,7 +47738,7 @@ function type_path_list(ppf, param) { function hide_variant_name(t) { const t$1 = repr(t); const row = t$1.desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { return t; } if (row.TAG !== /* Tvariant */8) { @@ -47174,13 +47783,13 @@ function may_prepare_expansion(compact, param) { const t$p = param[1]; const t = param[0]; const match = repr(t$p).desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return prepare_expansion([ t, t$p ]); } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tobject */4 : case /* Tvariant */8 : break; @@ -47206,7 +47815,8 @@ function may_prepare_expansion(compact, param) { function print_tags(ppf, fields) { if (fields) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '`' */96, @@ -47219,7 +47829,8 @@ function print_tags(ppf, fields) { _1: "`%s" }), fields.hd[0]); return Stdlib__List.iter((function (param) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ',' */44, @@ -47254,11 +47865,11 @@ function has_explanation(unif, t3, t4) { const match$1 = t4.desc; let exit = 0; let exit$1 = 0; - if (typeof match === "number") { - if (typeof match$1 === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 2; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : exit$1 = 3; break; @@ -47269,11 +47880,11 @@ function has_explanation(unif, t3, t4) { } } } else { - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tvar */0 : return true; case /* Tconstr */3 : - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return true; } if (match$1.TAG === /* Tvar */0) { @@ -47285,8 +47896,8 @@ function has_explanation(unif, t3, t4) { case /* Tfield */5 : const match$2 = match._3.desc; let exit$2 = 0; - if (typeof match$2 === "number" && typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (/* tag */(typeof match$2 === "number" || typeof match$2 === "string") && !/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tvar */0 : exit$1 = 3; break; @@ -47295,7 +47906,7 @@ function has_explanation(unif, t3, t4) { break; case /* Tfield */5 : const match$3 = match$1._3.desc; - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { return match._0 === match$1._0; } else { return false; @@ -47307,10 +47918,10 @@ function has_explanation(unif, t3, t4) { exit$2 = 4; } if (exit$2 === 4) { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return true; } - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : exit$1 = 3; break; @@ -47322,10 +47933,10 @@ function has_explanation(unif, t3, t4) { } break; case /* Tvariant */8 : - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return false; } - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : exit$1 = 3; break; @@ -47340,7 +47951,7 @@ function has_explanation(unif, t3, t4) { } } if (exit$1 === 3) { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 2; } else { if (match$1.TAG === /* Tvar */0) { @@ -47349,10 +47960,10 @@ function has_explanation(unif, t3, t4) { exit = 2; } } - if (exit === 2 && typeof match !== "number" && match.TAG !== /* Tconstr */3) { + if (exit === 2 && !/* tag */(typeof match === "number" || typeof match === "string") && match.TAG !== /* Tconstr */3) { return false; } - if (typeof match$1 === "number" || match$1.TAG !== /* Tfield */5) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Tfield */5) { return false; } else { return true; @@ -47401,11 +48012,11 @@ function explanation(unif, mis, ppf) { let exit$2 = 0; let exit$3 = 0; let exit$4 = 0; - if (typeof match === "number") { - if (typeof match$1 === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return ; } - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : exit$4 = 9; break; @@ -47419,19 +48030,20 @@ function explanation(unif, mis, ppf) { return ; } } else { - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tvar */0 : - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit$1 = 5; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Ttuple */2 : exit$1 = match$1._0 ? 5 : 3; break; case /* Tconstr */3 : const p = match$1._0; if (unif && t3.level < binding_time(p)) { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -47444,7 +48056,8 @@ function explanation(unif, mis, ppf) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -47502,10 +48115,10 @@ function explanation(unif, mis, ppf) { if (match._0) { exit$4 = 9; } else { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return ; } - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : exit$1 = 3; break; @@ -47519,13 +48132,14 @@ function explanation(unif, mis, ppf) { break; case /* Tconstr */3 : const p$1 = match._0; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : if (unif && t4.level < binding_time(p$1)) { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -47538,7 +48152,8 @@ function explanation(unif, mis, ppf) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -47593,10 +48208,10 @@ function explanation(unif, mis, ppf) { } break; case /* Tvariant */8 : - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return ; } - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : exit$4 = 9; break; @@ -47624,7 +48239,8 @@ function explanation(unif, mis, ppf) { } const l1 = match$2.hd[0]; if (l1 === match$4.hd[0]) { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -47661,7 +48277,8 @@ function explanation(unif, mis, ppf) { exit$6 = 11; } else { if (match$5) { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -47682,7 +48299,8 @@ function explanation(unif, mis, ppf) { exit$6 = 11; } if (exit$6 === 11) { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -47695,7 +48313,8 @@ function explanation(unif, mis, ppf) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -47715,7 +48334,8 @@ function explanation(unif, mis, ppf) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -47752,7 +48372,8 @@ function explanation(unif, mis, ppf) { if (match$4 || !match$5) { return ; } else { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -47765,7 +48386,8 @@ function explanation(unif, mis, ppf) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -47785,7 +48407,8 @@ function explanation(unif, mis, ppf) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -47821,10 +48444,10 @@ function explanation(unif, mis, ppf) { } break; case /* Tunivar */9 : - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return ; } - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tvar */0 : exit$1 = 4; break; @@ -47840,14 +48463,14 @@ function explanation(unif, mis, ppf) { } } if (exit$4 === 9) { - if (typeof match$1 === "number" || match$1.TAG !== /* Tvar */0) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Tvar */0) { exit$3 = 8; } else { exit$1 = 5; } } if (exit$3 === 8) { - if (typeof match === "number" || match.TAG !== /* Tfield */5) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tfield */5) { exit$2 = 7; } else { lab = match._0; @@ -47855,10 +48478,10 @@ function explanation(unif, mis, ppf) { } } if (exit$2 === 7) { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 2; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tconstr */3 : exit = 2; break; @@ -47873,7 +48496,8 @@ function explanation(unif, mis, ppf) { } switch (exit$1) { case 3 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -47891,7 +48515,8 @@ function explanation(unif, mis, ppf) { _1: "@,Self type cannot escape its class" }); case 4 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -47926,7 +48551,8 @@ function explanation(unif, mis, ppf) { const t$p = match$6[1]; const t = match$6[0]; if (occur_in(empty, t, t$p)) { - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -47939,7 +48565,8 @@ function explanation(unif, mis, ppf) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -47981,7 +48608,8 @@ function explanation(unif, mis, ppf) { _1: "@,@[The type variable %a occurs inside@ %a@]" }), type_expr$1, t, type_expr$1, t$p); } else { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -47994,7 +48622,8 @@ function explanation(unif, mis, ppf) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -48039,7 +48668,8 @@ function explanation(unif, mis, ppf) { } case 6 : if (lab === dummy_method) { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -48063,7 +48693,8 @@ function explanation(unif, mis, ppf) { } switch (exit) { case 1 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -48076,7 +48707,8 @@ function explanation(unif, mis, ppf) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -48104,10 +48736,10 @@ function explanation(unif, mis, ppf) { }), Caml_obj.caml_equal(t4.desc, /* Tnil */0) ? "first" : "second"); case 2 : let exit$7 = 0; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { exit$7 = 3; } else { - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tconstr */3 : exit$7 = 3; break; @@ -48115,15 +48747,16 @@ function explanation(unif, mis, ppf) { const l = match._0; const match$7 = match._3.desc; let exit$8 = 0; - if (typeof match$7 === "number" && typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (/* tag */(typeof match$7 === "number" || typeof match$7 === "string") && !/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tconstr */3 : exit$8 = 4; break; case /* Tfield */5 : const match$8 = match$1._3.desc; - if (typeof match$8 === "number" && l === match$1._0) { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + if (/* tag */(typeof match$8 === "number" || typeof match$8 === "string") && l === match$1._0) { + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -48159,7 +48792,7 @@ function explanation(unif, mis, ppf) { } if (exit$8 === 4) { let exit$9 = 0; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit$9 = 5; } else { if (match$1.TAG !== /* Tconstr */3) { @@ -48168,7 +48801,8 @@ function explanation(unif, mis, ppf) { exit$9 = 5; } if (exit$9 === 5) { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -48181,7 +48815,8 @@ function explanation(unif, mis, ppf) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -48212,7 +48847,8 @@ function explanation(unif, mis, ppf) { } } if (exit$7 === 3) { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -48225,7 +48861,8 @@ function explanation(unif, mis, ppf) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -48259,9 +48896,9 @@ function path_same_name(_p1, _p2) { while(true) { const p2 = _p2; const p1 = _p1; - switch (p1.TAG | 0) { + switch (p1.TAG) { case /* Pident */0 : - switch (p2.TAG | 0) { + switch (p2.TAG) { case /* Pident */0 : let id1 = p1._0; let id2 = p2._0; @@ -48277,7 +48914,7 @@ function path_same_name(_p1, _p2) { } case /* Pdot */1 : - switch (p2.TAG | 0) { + switch (p2.TAG) { case /* Pdot */1 : if (p1._1 !== p2._1) { return ; @@ -48291,7 +48928,7 @@ function path_same_name(_p1, _p2) { } case /* Papply */2 : - switch (p2.TAG | 0) { + switch (p2.TAG) { case /* Pident */0 : case /* Pdot */1 : return ; @@ -48310,7 +48947,7 @@ function path_same_name(_p1, _p2) { function type_same_name(t1, t2) { const match = repr(t1).desc; const match$1 = repr(t2).desc; - if (typeof match === "number" || !(match.TAG === /* Tconstr */3 && !(typeof match$1 === "number" || match$1.TAG !== /* Tconstr */3))) { + if (/* tag */typeof match === "number" || typeof match === "string" || !(match.TAG === /* Tconstr */3 && !(/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Tconstr */3))) { return ; } else { return path_same_name(best_type_path(match._0)[0], best_type_path(match$1._0)[0]); @@ -48359,12 +48996,14 @@ function report_unification_error(ppf, env, unifOpt, tr, txt1, txt2) { const t2 = match$2[0]; print_labels.contents = !classic.contents; const tr$3 = Stdlib__List.map(prepare_expansion, tr$2); - Curry.app(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry.app(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -48377,7 +49016,8 @@ function report_unification_error(ppf, env, unifOpt, tr, txt1, txt2) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -48541,8 +49181,9 @@ function class_declarations(env, cty1, cty2) { } function include_err(ppf, lab) { - if (typeof lab === "number") { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + if (/* tag */typeof lab === "number" || typeof lab === "string") { + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "A class cannot be changed from virtual to concrete", @@ -48551,9 +49192,10 @@ function include_err(ppf, lab) { _1: "A class cannot be changed from virtual to concrete" }); } - switch (lab.TAG | 0) { + switch (lab.TAG) { case /* CM_Parameter_arity_mismatch */0 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The classes do not have the same number of type parameters", @@ -48563,7 +49205,8 @@ function include_err(ppf, lab) { }); case /* CM_Type_parameter_mismatch */1 : return report_unification_error(ppf, lab._0, false, lab._1, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "A type parameter has type", @@ -48572,7 +49215,8 @@ function include_err(ppf, lab) { _1: "A type parameter has type" }); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "but is expected to have type", @@ -48585,12 +49229,14 @@ function include_err(ppf, lab) { const cty2 = lab._2; const cty1 = lab._1; return wrap_printing_env(lab._0, (function (param) { - Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -48647,7 +49293,8 @@ function include_err(ppf, lab) { })); case /* CM_Parameter_mismatch */3 : return report_unification_error(ppf, lab._0, false, lab._1, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "A parameter has type", @@ -48656,7 +49303,8 @@ function include_err(ppf, lab) { _1: "A parameter has type" }); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "but is expected to have type", @@ -48668,7 +49316,8 @@ function include_err(ppf, lab) { case /* CM_Val_type_mismatch */4 : const lab$1 = lab._0; return report_unification_error(ppf, lab._1, false, lab._2, (function (ppf) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The instance variable ", @@ -48694,7 +49343,8 @@ function include_err(ppf, lab) { _1: "The instance variable %s@ has type" }), lab$1); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "but is expected to have type", @@ -48706,7 +49356,8 @@ function include_err(ppf, lab) { case /* CM_Meth_type_mismatch */5 : const lab$2 = lab._0; return report_unification_error(ppf, lab._1, false, lab._2, (function (ppf) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The method ", @@ -48732,7 +49383,8 @@ function include_err(ppf, lab) { _1: "The method %s@ has type" }), lab$2); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "but is expected to have type", @@ -48742,12 +49394,14 @@ function include_err(ppf, lab) { }); })); case /* CM_Non_mutable_value */6 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -48773,12 +49427,14 @@ function include_err(ppf, lab) { _1: "@[The non-mutable instance variable %s cannot become mutable@]" }), lab._0); case /* CM_Non_concrete_value */7 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -48804,12 +49460,14 @@ function include_err(ppf, lab) { _1: "@[The virtual instance variable %s cannot become concrete@]" }), lab._0); case /* CM_Missing_value */8 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -48831,12 +49489,14 @@ function include_err(ppf, lab) { _1: "@[The first class type has no instance variable %s@]" }), lab._0); case /* CM_Missing_method */9 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -48858,12 +49518,14 @@ function include_err(ppf, lab) { _1: "@[The first class type has no method %s@]" }), lab._0); case /* CM_Hide_public */10 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -48889,12 +49551,14 @@ function include_err(ppf, lab) { _1: "@[The public method %s cannot be hidden@]" }), lab._0); case /* CM_Hide_virtual */11 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -48928,12 +49592,14 @@ function include_err(ppf, lab) { _1: "@[The virtual %s %s cannot be hidden@]" }), lab._0, lab._1); case /* CM_Public_method */12 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -48955,7 +49621,8 @@ function include_err(ppf, lab) { _1: "@[The public method %s cannot become private" }), lab._0); case /* CM_Private_method */13 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The private method ", @@ -48972,12 +49639,14 @@ function include_err(ppf, lab) { _1: "The private method %s cannot become public" }), lab._0); case /* CM_Virtual_method */14 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -49008,7 +49677,8 @@ function report_error$3(ppf, param) { } const print_errs = function (ppf, errs) { Stdlib__List.iter((function (err) { - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -49026,12 +49696,14 @@ function report_error$3(ppf, param) { }), include_err, err); }), errs); }; - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -49061,35 +49733,37 @@ const Dont_match = /* @__PURE__ */Caml_exceptions.create("Ocaml_typedtree_test.I function private_flags(decl1, decl2) { const match = decl1.type_private; const match$1 = decl2.type_private; - if (match || !match$1) { - return true; - } else if (Caml_obj.caml_equal(decl2.type_kind, /* Type_abstract */0)) { - if (decl2.type_manifest === undefined) { - return true; + if (match === /* Private */0 && match$1 !== /* Private */0) { + if (Caml_obj.caml_equal(decl2.type_kind, /* Type_abstract */0)) { + if (decl2.type_manifest === undefined) { + return true; + } else { + return Caml_obj.caml_notequal(decl1.type_kind, /* Type_abstract */0); + } } else { - return Caml_obj.caml_notequal(decl1.type_kind, /* Type_abstract */0); + return false; } } else { - return false; + return true; } } function is_absrow(env, ty) { const match = ty.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return false; } if (match.TAG !== /* Tconstr */3) { return false; } - switch (match._0.TAG | 0) { + switch (match._0.TAG) { case /* Pident */0 : const match$1 = expand_head(env, ty); const match$2 = match$1.desc; - if (typeof match$2 === "number") { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string") { return false; } - switch (match$2.TAG | 0) { + switch (match$2.TAG) { case /* Tobject */4 : case /* Tvariant */8 : return true; @@ -49108,10 +49782,10 @@ function type_manifest(env, ty1, params1, ty2, params2, priv2) { const ty2$p = expand_head(env, ty2); const match = ty1$p.desc; const match$1 = ty2$p.desc; - if (typeof match !== "number") { - switch (match.TAG | 0) { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + switch (match.TAG) { case /* Tobject */4 : - if (typeof match$1 !== "number" && match$1.TAG === /* Tobject */4) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string") && match$1.TAG === /* Tobject */4) { const fi2 = match$1._0; if (is_absrow(env, flatten_fields(fi2)[1])) { const match$2 = flatten_fields(fi2); @@ -49127,10 +49801,10 @@ function type_manifest(env, ty1, params1, ty2, params2, priv2) { const match$3 = flatten_fields(match._0); const match$4 = match$3[1].desc; let tmp; - if (typeof match$4 === "number") { + if (/* tag */typeof match$4 === "number" || typeof match$4 === "string") { tmp = true; } else { - switch (match$4.TAG | 0) { + switch (match$4.TAG) { case /* Tvar */0 : case /* Tconstr */3 : tmp = true; @@ -49158,7 +49832,7 @@ function type_manifest(env, ty1, params1, ty2, params2, priv2) { } break; case /* Tvariant */8 : - if (typeof match$1 !== "number" && match$1.TAG === /* Tvariant */8) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string") && match$1.TAG === /* Tvariant */8) { const row2 = match$1._0; if (is_absrow(env, row_more(row2))) { const row1 = row_repr_aux(/* [] */0, match._0); @@ -49175,10 +49849,10 @@ function type_manifest(env, ty1, params1, ty2, params2, priv2) { const match$7 = row1.row_more; const match$8 = match$7.desc; let tmp$1; - if (typeof match$8 === "number") { + if (/* tag */typeof match$8 === "number" || typeof match$8 === "string") { tmp$1 = true; } else { - switch (match$8.TAG | 0) { + switch (match$8.TAG) { case /* Tvar */0 : case /* Tconstr */3 : tmp$1 = true; @@ -49196,7 +49870,7 @@ function type_manifest(env, ty1, params1, ty2, params2, priv2) { } if (!Stdlib__List.for_all((function (param) { const match = row_field_repr_aux(/* [] */0, param[1]); - if (typeof match === "number" || match.TAG !== /* Rpresent */0) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Rpresent */0) { return true; } else { return false; @@ -49210,8 +49884,8 @@ function type_manifest(env, ty1, params1, ty2, params2, priv2) { if (!Stdlib__List.for_all((function (param) { const match = row_field_repr_aux(/* [] */0, param[1]); const match$1 = row_field_repr_aux(/* [] */0, param[2]); - if (typeof match === "number") { - if (typeof match$1 === "number" || match$1.TAG !== /* Rpresent */0) { + if (/* tag */typeof match === "number" || typeof match === "string") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Rpresent */0) { return true; } else { return false; @@ -49220,7 +49894,7 @@ function type_manifest(env, ty1, params1, ty2, params2, priv2) { if (match.TAG === /* Rpresent */0) { const t1 = match._0; if (t1 === undefined) { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return false; } else if (match$1.TAG === /* Rpresent */0) { return match$1._0 === undefined; @@ -49231,7 +49905,7 @@ function type_manifest(env, ty1, params1, ty2, params2, priv2) { } } let t2; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return false; } if (match$1.TAG === /* Rpresent */0) { @@ -49263,7 +49937,7 @@ function type_manifest(env, ty1, params1, ty2, params2, priv2) { return true; } const tl1 = match._1; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return false; } if (match$1.TAG === /* Rpresent */0) { @@ -49322,7 +49996,8 @@ function report_type_mismatch(first, second, decl, ppf) { if (Caml_obj.caml_equal(err, /* Manifest */4)) { return ; } else { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -49342,10 +50017,11 @@ function report_type_mismatch(first, second, decl, ppf) { }, _1: "@ %a." }), (function (param, param$1) { - if (typeof param$1 === "number") { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { switch (param$1) { case /* Arity */0 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "They have different arities", @@ -49354,7 +50030,8 @@ function report_type_mismatch(first, second, decl, ppf) { _1: "They have different arities" }); case /* Privacy */1 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "A private type would be revealed", @@ -49363,7 +50040,8 @@ function report_type_mismatch(first, second, decl, ppf) { _1: "A private type would be revealed" }); case /* Kind */2 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Their kinds differ", @@ -49372,7 +50050,8 @@ function report_type_mismatch(first, second, decl, ppf) { _1: "Their kinds differ" }); case /* Constraint */3 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Their constraints differ", @@ -49383,7 +50062,8 @@ function report_type_mismatch(first, second, decl, ppf) { case /* Manifest */4 : return ; case /* Variance */5 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Their variances do not agree", @@ -49394,9 +50074,10 @@ function report_type_mismatch(first, second, decl, ppf) { } } else { - switch (param$1.TAG | 0) { + switch (param$1.TAG) { case /* Field_type */0 : - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The types for field ", @@ -49413,7 +50094,8 @@ function report_type_mismatch(first, second, decl, ppf) { _1: "The types for field %s are not equal" }), param$1._0.name); case /* Field_mutable */1 : - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The mutability of field ", @@ -49430,7 +50112,8 @@ function report_type_mismatch(first, second, decl, ppf) { _1: "The mutability of field %s is different" }), param$1._0.name); case /* Field_arity */2 : - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The arities for field ", @@ -49447,7 +50130,8 @@ function report_type_mismatch(first, second, decl, ppf) { _1: "The arities for field %s differ" }), param$1._0.name); case /* Field_names */3 : - return Curry._3(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Fields number ", @@ -49478,7 +50162,8 @@ function report_type_mismatch(first, second, decl, ppf) { _1: "Fields number %i have different names, %s and %s" }), param$1._0, param$1._1.name, param$1._2.name); case /* Field_missing */4 : - return Curry._3(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The field ", @@ -49507,7 +50192,8 @@ function report_type_mismatch(first, second, decl, ppf) { _1: "The field %s is only present in %s %s" }), param$1._1.name, param$1._0 ? second : first, decl); case /* Record_representation */5 : - return Curry._3(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Their internal representations differ:", @@ -49762,19 +50448,19 @@ function type_declarations$1(equalityOpt, env, name, decl1, id, decl2) { const match$1 = decl2.type_kind; let err; let exit = 0; - if (typeof match$1 === "number" && !match$1) { + if (/* tag */(typeof match$1 === "number" || typeof match$1 === "string") && match$1 === /* Type_abstract */0) { err = /* [] */0; } else { exit = 1; } if (exit === 1) { - if (typeof match === "number") { - err = match === /* Type_abstract */0 || typeof match$1 !== "number" ? ({ + if (/* tag */typeof match === "number" || typeof match === "string") { + err = match === /* Type_abstract */0 || !/* tag */(typeof match$1 === "number" || typeof match$1 === "string") ? ({ hd: /* Kind */2, tl: /* [] */0 }) : /* [] */0; } else if (match.TAG === /* Type_record */0) { - if (typeof match$1 === "number" || match$1.TAG !== /* Type_record */0) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Type_record */0) { err = { hd: /* Kind */2, tl: /* [] */0 @@ -49792,7 +50478,7 @@ function type_declarations$1(equalityOpt, env, name, decl1, id, decl2) { } } else { const cstrs1 = match._0; - if (typeof match$1 === "number" || match$1.TAG === /* Type_record */0) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG === /* Type_record */0) { err = { hd: /* Kind */2, tl: /* [] */0 @@ -49965,10 +50651,10 @@ function extension_constructors(env, id, ext1, ext2) { } const match$2 = ext1.ext_private; const match$3 = ext2.ext_private; - if (match$2 || !match$3) { - return true; - } else { + if (match$2 === /* Private */0 && match$3 !== /* Private */0) { return false; + } else { + return true; } } @@ -49990,7 +50676,7 @@ function scrape(env, mty) { function strengthen$1(env, mty, p) { const sg = scrape(env, mty); - switch (sg.TAG | 0) { + switch (sg.TAG) { case /* Mty_signature */1 : return { TAG: /* Mty_signature */1, @@ -50027,7 +50713,7 @@ function strengthen_sig(env, sg, p) { return /* [] */0; } const sigelt = sg.hd; - switch (sigelt.TAG | 0) { + switch (sigelt.TAG) { case /* Sig_type */1 : const decl = sigelt._1; const id = sigelt._0; @@ -50036,7 +50722,7 @@ function strengthen_sig(env, sg, p) { const match$2 = decl.type_kind; let newdecl; let exit = 0; - if (match !== undefined && (match$1 || typeof match$2 !== "number")) { + if (match !== undefined && !(match$1 === /* Private */0 && /* tag */(typeof match$2 === "number" || typeof match$2 === "string"))) { newdecl = decl; } else { exit = 1; @@ -50151,7 +50837,7 @@ function nondep_supertype(env, mid, mty) { const nondep_mty = function (env, va, _mty) { while(true) { const mty = _mty; - switch (mty.TAG | 0) { + switch (mty.TAG) { case /* Mty_ident */0 : const p = mty._0; if (!isfree(mid, p)) { @@ -50208,7 +50894,7 @@ function nondep_supertype(env, mid, mty) { } const item = param.hd; const rem$p = nondep_sig(env, va, param.tl); - switch (item.TAG | 0) { + switch (item.TAG) { case /* Sig_value */0 : const d = item._1; return { @@ -50275,25 +50961,30 @@ function nondep_supertype(env, mid, mty) { catch (raw_exn){ const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); if (exn.MEL_EXN_ID === Stdlib.Not_found) { - if (va) { - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + switch (va) { + case /* Co */0 : + return { + hd: { + TAG: /* Sig_modtype */4, + _0: id$1, + _1: { + mtd_type: undefined, + mtd_attributes: /* [] */0, + mtd_loc: none + } + }, + tl: rem$p + }; + case /* Contra */1 : + case /* Strict */2 : + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } - return { - hd: { - TAG: /* Sig_modtype */4, - _0: id$1, - _1: { - mtd_type: undefined, - mtd_attributes: /* [] */0, - mtd_loc: none - } - }, - tl: rem$p - }; + } else { + throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } - throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } case /* Sig_class */5 : return { @@ -50374,7 +51065,7 @@ function enrich_modtype(env, p, mty) { return { TAG: /* Mty_signature */1, _0: Stdlib__List.map((function (param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Sig_type */1 : const id = param._0; return { @@ -50434,11 +51125,11 @@ function type_paths_sig(_env, p, _pos, _sg) { return /* [] */0; } const match = sg.hd; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Sig_value */0 : const match$1 = match._1.val_kind; let pos$p; - pos$p = typeof match$1 === "number" || match$1.TAG !== /* Val_prim */0 ? pos + 1 | 0 : pos; + pos$p = /* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Val_prim */0 ? pos + 1 | 0 : pos; _sg = sg.tl; _pos = pos$p; continue ; @@ -50482,7 +51173,7 @@ function type_paths_sig(_env, p, _pos, _sg) { function contains_type(env, _path) { while(true) { const path = _path; - switch (path.TAG | 0) { + switch (path.TAG) { case /* Mty_ident */0 : try { const mty = find_modtype(path._0, env).mtd_type; @@ -50517,27 +51208,28 @@ function contains_type(env, _path) { function contains_type_sig(env) { return function (param) { return Stdlib__List.iter((function (param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Sig_type */1 : const match = param._1; - const match$1 = match.type_kind; if (match.type_manifest !== undefined) { - if (typeof match$1 !== "number") { + let tmp = match.type_kind; + if (!/* tag */(typeof tmp === "number" || typeof tmp === "string")) { return ; } - if (match$1) { + if (tmp !== /* Type_abstract */0) { return ; } - if (match.type_private) { + if (match.type_private !== /* Private */0) { return ; } throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { MEL_EXN_ID: Stdlib.Exit }); + } else { + throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { + MEL_EXN_ID: Stdlib.Exit + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { - MEL_EXN_ID: Stdlib.Exit - }); case /* Sig_module */3 : return contains_type(env, param._1.md_type); case /* Sig_modtype */4 : @@ -50578,17 +51270,20 @@ const P = { }; function height$7(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$8(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; - return /* Node */{ + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; + return { + TAG: /* Node */0, l: l, v: v, r: r, @@ -50597,52 +51292,55 @@ function create$8(l, v, r) { } function bal$7(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const lv = l.v; - const ll = l.l; - if (height$7(ll) >= height$7(lr)) { - return create$8(ll, lv, create$8(lr, v, r)); - } - if (lr) { - return create$8(create$8(ll, lv, lr.l), lr.v, create$8(lr.r, v, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const lr = l.r; + const lv = l.v; + const ll = l.l; + if (height$7(ll) >= height$7(lr)) { + return create$8(ll, lv, create$8(lr, v, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$8(create$8(ll, lv, lr.l), lr.v, create$8(lr.r, v, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: v, r: r, h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rv = r.v; - const rl = r.l; - if (height$7(rr) >= height$7(rl)) { - return create$8(create$8(l, v, rl), rv, rr); - } - if (rl) { - return create$8(create$8(l, v, rl.l), rl.v, create$8(rl.r, rv, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const rr = r.r; + const rv = r.v; + const rl = r.l; + if (height$7(rr) >= height$7(rl)) { + return create$8(create$8(l, v, rl), rv, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$8(create$8(l, v, rl.l), rl.v, create$8(rl.r, rv, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" @@ -50650,8 +51348,9 @@ function bal$7(l, v, r) { } function add$9(x, t) { - if (!t) { - return /* Node */{ + if (/* tag */typeof t === "number" || typeof t === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -50682,7 +51381,8 @@ function add$9(x, t) { } function singleton$3(x) { - return /* Node */{ + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -50691,30 +51391,30 @@ function singleton$3(x) { } function add_min_element$2(x, param) { - if (param) { - return bal$7(add_min_element$2(x, param.l), param.v, param.r); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton$3(x); + } else { + return bal$7(add_min_element$2(x, param.l), param.v, param.r); } } function add_max_element$2(x, param) { - if (param) { - return bal$7(param.l, param.v, add_max_element$2(x, param.r)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton$3(x); + } else { + return bal$7(param.l, param.v, add_max_element$2(x, param.r)); } } function join$3(l, v, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_element$2(v, r); } - if (!r) { + const lh = l.h; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_element$2(v, l); } const rh = r.h; - const lh = l.h; if (lh > (rh + 2 | 0)) { return bal$7(l.l, l.v, join$3(l.r, v, r)); } else if (rh > (lh + 2 | 0)) { @@ -50725,7 +51425,7 @@ function join$3(l, v, r) { } function split$3(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, false, @@ -50760,16 +51460,16 @@ function split$3(x, param) { } function union$4(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return s2; } - if (!s2) { + const h1 = s1.h; + const v1 = s1.v; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const h2 = s2.h; const v2 = s2.v; - const h1 = s1.h; - const v1 = s1.v; if (h1 >= h2) { if (h2 === 1) { return add$9(v2, s1); @@ -50788,7 +51488,7 @@ function fold$6(f, _s, _accu) { while(true) { const accu = _accu; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return accu; } _accu = Curry._2(f, s.v, fold$6(f, s.l, accu)); @@ -50798,17 +51498,18 @@ function fold$6(f, _s, _accu) { } function height$8(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$9(l, x, d, r) { const hl = height$8(l); const hr = height$8(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -50818,32 +51519,35 @@ function create$9(l, x, d, r) { } function bal$8(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height$8(ll) >= height$8(lr)) { - return create$9(ll, lv, ld, create$9(lr, x, d, r)); - } - if (lr) { - return create$9(create$9(ll, lv, ld, lr.l), lr.v, lr.d, create$9(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height$8(ll) >= height$8(lr)) { + return create$9(ll, lv, ld, create$9(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$9(create$9(ll, lv, ld, lr.l), lr.v, lr.d, create$9(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -50851,22 +51555,22 @@ function bal$8(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height$8(rr) >= height$8(rl)) { - return create$9(create$9(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create$9(create$9(l, x, d, rl.l), rl.v, rl.d, create$9(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height$8(rr) >= height$8(rl)) { + return create$9(create$9(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$9(create$9(l, x, d, rl.l), rl.v, rl.d, create$9(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -50874,8 +51578,9 @@ function bal$8(l, x, d, r) { } function add$10(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -50892,7 +51597,8 @@ function add$10(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -50920,17 +51626,17 @@ function add$10(x, data, m) { function find$5(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(P.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(P.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } @@ -50941,17 +51647,20 @@ const funarg$4 = { }; function height$9(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$10(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; - return /* Node */{ + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; + return { + TAG: /* Node */0, l: l, v: v, r: r, @@ -50960,52 +51669,55 @@ function create$10(l, v, r) { } function bal$9(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const lv = l.v; - const ll = l.l; - if (height$9(ll) >= height$9(lr)) { - return create$10(ll, lv, create$10(lr, v, r)); - } - if (lr) { - return create$10(create$10(ll, lv, lr.l), lr.v, create$10(lr.r, v, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const lr = l.r; + const lv = l.v; + const ll = l.l; + if (height$9(ll) >= height$9(lr)) { + return create$10(ll, lv, create$10(lr, v, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$10(create$10(ll, lv, lr.l), lr.v, create$10(lr.r, v, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: v, r: r, h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rv = r.v; - const rl = r.l; - if (height$9(rr) >= height$9(rl)) { - return create$10(create$10(l, v, rl), rv, rr); - } - if (rl) { - return create$10(create$10(l, v, rl.l), rl.v, create$10(rl.r, rv, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const rr = r.r; + const rv = r.v; + const rl = r.l; + if (height$9(rr) >= height$9(rl)) { + return create$10(create$10(l, v, rl), rv, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$10(create$10(l, v, rl.l), rl.v, create$10(rl.r, rv, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" @@ -51013,8 +51725,9 @@ function bal$9(l, v, r) { } function add$11(x, t) { - if (!t) { - return /* Node */{ + if (/* tag */typeof t === "number" || typeof t === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -51045,7 +51758,8 @@ function add$11(x, t) { } function singleton$4(x) { - return /* Node */{ + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -51054,30 +51768,30 @@ function singleton$4(x) { } function add_min_element$3(x, param) { - if (param) { - return bal$9(add_min_element$3(x, param.l), param.v, param.r); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton$4(x); + } else { + return bal$9(add_min_element$3(x, param.l), param.v, param.r); } } function add_max_element$3(x, param) { - if (param) { - return bal$9(param.l, param.v, add_max_element$3(x, param.r)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton$4(x); + } else { + return bal$9(param.l, param.v, add_max_element$3(x, param.r)); } } function join$4(l, v, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_element$3(v, r); } - if (!r) { + const lh = l.h; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_element$3(v, l); } const rh = r.h; - const lh = l.h; if (lh > (rh + 2 | 0)) { return bal$9(l.l, l.v, join$4(l.r, v, r)); } else if (rh > (lh + 2 | 0)) { @@ -51088,7 +51802,7 @@ function join$4(l, v, r) { } function split$4(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, false, @@ -51125,7 +51839,7 @@ function split$4(x, param) { function mem$5(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(funarg$4.compare, x, param.v); @@ -51138,16 +51852,16 @@ function mem$5(x, _param) { } function union$5(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return s2; } - if (!s2) { + const h1 = s1.h; + const v1 = s1.v; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const h2 = s2.h; const v2 = s2.v; - const h1 = s1.h; - const v1 = s1.v; if (h1 >= h2) { if (h2 === 1) { return add$11(v2, s1); @@ -51163,7 +51877,7 @@ function union$5(s1, s2) { } function get_prefixes(param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Pident */0 : return /* Empty */0; case /* Pdot */1 : @@ -51178,7 +51892,7 @@ function get_prefixes(param) { function get_arg_paths(_param) { while(true) { const param = _param; - switch (param.TAG | 0) { + switch (param.TAG) { case /* Pident */0 : return /* Empty */0; case /* Pdot */1 : @@ -51204,7 +51918,7 @@ function rollback_path(subst, _p) { catch (raw_exn){ const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); if (exn.MEL_EXN_ID === Stdlib.Not_found) { - switch (p.TAG | 0) { + switch (p.TAG) { case /* Pdot */1 : const p1 = p._0; const p1$p = rollback_path(subst, p1); @@ -51232,7 +51946,7 @@ function rollback_path(subst, _p) { function collect_ids(subst, bindings, p) { const id = rollback_path(subst, p); - switch (id.TAG | 0) { + switch (id.TAG) { case /* Pident */0 : const id$1 = id._0; let ids; @@ -51275,7 +51989,7 @@ function collect_arg_paths(mty) { } const p = si._1.md_type; const id = si._0; - switch (p.TAG | 0) { + switch (p.TAG) { case /* Mty_signature */1 : return Stdlib__List.iter((function (param) { if (param.TAG !== /* Sig_module */3) { @@ -51328,7 +52042,7 @@ function collect_arg_paths(mty) { function remove_aliases(env, excl, _mty) { while(true) { const mty = _mty; - switch (mty.TAG | 0) { + switch (mty.TAG) { case /* Mty_signature */1 : return { TAG: /* Mty_signature */1, @@ -51354,7 +52068,7 @@ function remove_aliases_sig(env, excl, sg) { return /* [] */0; } const it = sg.hd; - switch (it.TAG | 0) { + switch (it.TAG) { case /* Sig_module */3 : const md = it._1; const id = it._0; @@ -51408,9 +52122,9 @@ function value_descriptions(env, cxt, subst, id, vd1, vd2) { if (moregeneral(env, true, vd1.val_type, vd2$1.val_type)) { const match = vd1.val_kind; const match$1 = vd2$1.val_kind; - if (typeof match !== "number" && match.TAG === /* Val_prim */0) { + if (!/* tag */(typeof match === "number" || typeof match === "string") && match.TAG === /* Val_prim */0) { const p1 = match._0; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return { TAG: /* Tcoerce_primitive */2, _0: id, @@ -51431,7 +52145,7 @@ function value_descriptions(env, cxt, subst, id, vd1, vd2) { MEL_EXN_ID: Dont_match }); } - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return /* Tcoerce_none */0; } if (match$1.TAG !== /* Val_prim */0) { @@ -51639,7 +52353,7 @@ function expand_module_alias(env, cxt, path) { } function kind_of_field_desc(param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Field_value */0 : return "value"; case /* Field_type */1 : @@ -51659,7 +52373,7 @@ function kind_of_field_desc(param) { } function item_ident_name(param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Sig_value */0 : const id = param._0; return [ @@ -51735,10 +52449,10 @@ function item_ident_name(param) { } function is_runtime_component(param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Sig_value */0 : let tmp = param._1.val_kind; - if (typeof tmp === "number" || tmp.TAG !== /* Val_prim */0) { + if (/* tag */typeof tmp === "number" || typeof tmp === "string" || tmp.TAG !== /* Val_prim */0) { return true; } else { return false; @@ -51805,7 +52519,7 @@ function modtypes(env, cxt, subst, mty1, mty2) { function try_modtypes(env, cxt, subst, _mty1, mty2) { while(true) { const mty1 = _mty1; - switch (mty1.TAG | 0) { + switch (mty1.TAG) { case /* Mty_ident */0 : const p1 = mty1._0; if (may_expand_module_path(env, p1)) { @@ -51814,7 +52528,7 @@ function try_modtypes(env, cxt, subst, _mty1, mty2) { } break; case /* Mty_signature */1 : - switch (mty2.TAG | 0) { + switch (mty2.TAG) { case /* Mty_ident */0 : break; case /* Mty_signature */1 : @@ -51831,7 +52545,7 @@ function try_modtypes(env, cxt, subst, _mty1, mty2) { const arg1 = mty1._1; const param1 = mty1._0; if (arg1 !== undefined) { - switch (mty2.TAG | 0) { + switch (mty2.TAG) { case /* Mty_ident */0 : break; case /* Mty_functor */2 : @@ -51855,7 +52569,7 @@ function try_modtypes(env, cxt, subst, _mty1, mty2) { TAG: /* Pident */0, _0: param1 }, subst), mty1._2, mty2._2); - if (typeof cc_arg === "number" && typeof cc_res === "number") { + if (/* tag */(typeof cc_arg === "number" || typeof cc_arg === "string") && /* tag */(typeof cc_res === "number" || typeof cc_res === "string")) { return /* Tcoerce_none */0; } else { return { @@ -51876,7 +52590,7 @@ function try_modtypes(env, cxt, subst, _mty1, mty2) { } } else { - switch (mty2.TAG | 0) { + switch (mty2.TAG) { case /* Mty_ident */0 : break; case /* Mty_functor */2 : @@ -51892,7 +52606,7 @@ function try_modtypes(env, cxt, subst, _mty1, mty2) { }, tl: cxt }, subst, mty1._2, mty2._2); - if (typeof cc === "number") { + if (/* tag */typeof cc === "number" || typeof cc === "string") { return /* Tcoerce_none */0; } else { return { @@ -52112,7 +52826,7 @@ function signatures(env, cxt, subst, sig1, sig2) { const match$2 = find$2(name2$1, comps1); const id1 = match$2[0]; let new_subst; - switch (item2.TAG | 0) { + switch (item2.TAG) { case /* Sig_type */1 : new_subst = add_type(id2, { TAG: /* Pident */0, @@ -52227,7 +52941,7 @@ function signature_components(old_env, env, cxt, subst, paired) { } const match = paired.hd; const match$1 = match[0]; - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Sig_value */0 : const match$2 = match[1]; if (match$2.TAG === /* Sig_value */0) { @@ -52236,7 +52950,7 @@ function signature_components(old_env, env, cxt, subst, paired) { const valdecl2 = match$2._1; const cc = value_descriptions(env, cxt, subst, match$1._0, match$1._1, valdecl2); const p = valdecl2.val_kind; - if (typeof p === "number" || p.TAG !== /* Val_prim */0) { + if (/* tag */typeof p === "number" || typeof p === "string" || p.TAG !== /* Val_prim */0) { return { hd: [ pos, @@ -52389,7 +53103,7 @@ function modtype_infos(env, cxt, subst, id, info1, info2) { function check_modtype_equiv(env, cxt, mty1, mty2) { const match = modtypes(env, cxt, identity, mty1, mty2); const match$1 = modtypes(env, cxt, identity, mty2, mty1); - if (typeof match === "number" && typeof match$1 === "number") { + if (/* tag */(typeof match === "number" || typeof match === "string") && /* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { return ; } throw new Caml_js_exceptions.MelangeError($$Error$5, { @@ -52472,7 +53186,8 @@ function show_loc(msg, ppf, loc) { })) { return ; } else { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: /* Force_newline */3, @@ -52480,7 +53195,8 @@ function show_loc(msg, ppf, loc) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -52527,8 +53243,9 @@ function show_locs(ppf, param) { } function include_err$1(ppf, path$1) { - if (typeof path$1 === "number") { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + if (/* tag */typeof path$1 === "number" || typeof path$1 === "string") { + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Illegal permutation of structure fields", @@ -52537,9 +53254,10 @@ function include_err$1(ppf, path$1) { _1: "Illegal permutation of structure fields" }); } - switch (path$1.TAG | 0) { + switch (path$1.TAG) { case /* Missing_field */0 : - Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The ", @@ -52567,12 +53285,14 @@ function include_err$1(ppf, path$1) { const d2 = path$1._2; const d1 = path$1._1; const id = path$1._0; - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -52642,12 +53362,14 @@ function include_err$1(ppf, path$1) { const d2$1 = path$1._2; const d1$1 = path$1._1; const id$1 = path$1._0; - return Curry.app(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry.app(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -52660,7 +53382,8 @@ function include_err$1(ppf, path$1) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -52757,12 +53480,14 @@ function include_err$1(ppf, path$1) { const x2 = path$1._2; const x1 = path$1._1; const id$2 = path$1._0; - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -52829,12 +53554,14 @@ function include_err$1(ppf, path$1) { x2.ext_loc ]); case /* Module_types */4 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -52894,12 +53621,14 @@ function include_err$1(ppf, path$1) { }), modtype$1, path$1._0, modtype$1, path$1._1); case /* Modtype_infos */5 : const id$3 = path$1._0; - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -52962,12 +53691,14 @@ function include_err$1(ppf, path$1) { return modtype_declaration$1(id$3, param, param$1); }), path$1._2); case /* Interface_mismatch */6 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -53007,12 +53738,14 @@ function include_err$1(ppf, path$1) { }), path$1._0, path$1._1); case /* Class_type_declarations */7 : const id$4 = path$1._0; - return Curry._6(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._6(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -53088,12 +53821,14 @@ function include_err$1(ppf, path$1) { }), path$1._2, report_error$3, path$1._3); case /* Class_declarations */8 : const id$5 = path$1._0; - return Curry._6(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._6(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -53168,7 +53903,8 @@ function include_err$1(ppf, path$1) { return class_declaration$1(id$5, param, param$1); }), path$1._2, report_error$3, path$1._3); case /* Unbound_modtype_path */9 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unbound module type ", @@ -53180,7 +53916,8 @@ function include_err$1(ppf, path$1) { _1: "Unbound module type %a" }), path, path$1._0); case /* Unbound_module_path */10 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unbound module ", @@ -53192,7 +53929,8 @@ function include_err$1(ppf, path$1) { _1: "Unbound module %a" }), path, path$1._0); case /* Invalid_module_alias */11 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Module ", @@ -53213,7 +53951,8 @@ function include_err$1(ppf, path$1) { function context(ppf, param) { if (!param) { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -53223,14 +53962,16 @@ function context(ppf, param) { }); } const id = param.hd; - switch (id.TAG | 0) { + switch (id.TAG) { case /* Module */0 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -53258,12 +53999,14 @@ function context(ppf, param) { _1: "@[<2>module %a%a@]" }), ident$3, id._0, args, param.tl); case /* Modtype */1 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -53304,7 +54047,8 @@ function context(ppf, param) { _1: "@[<2>module type %a =@ %a@]" }), ident$3, id._0, context_mty, param.tl); case /* Arg */2 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "functor (", @@ -53327,7 +54071,8 @@ function context(ppf, param) { _1: "functor (%a : %a) -> ..." }), ident$3, id._0, context_mty, param.tl); case /* Body */3 : - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "functor (", @@ -53363,7 +54108,7 @@ function context_mty(ppf, rem) { if (!rem) { return context(ppf, rem); } - switch (rem.hd.TAG | 0) { + switch (rem.hd.TAG) { case /* Module */0 : case /* Modtype */1 : break; @@ -53372,12 +54117,14 @@ function context_mty(ppf, rem) { return context(ppf, rem); } - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -53428,12 +54175,13 @@ function context_mty(ppf, rem) { function args(ppf, cxt) { if (cxt) { const x = cxt.hd; - switch (x.TAG | 0) { + switch (x.TAG) { case /* Module */0 : case /* Modtype */1 : break; case /* Arg */2 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '(' */40, @@ -53465,7 +54213,8 @@ function args(ppf, cxt) { _1: "(%a :@ %a) : ..." }), ident$3, x._0, context_mty, cxt.tl); case /* Body */3 : - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '(' */40, @@ -53487,7 +54236,8 @@ function args(ppf, cxt) { } } - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " :", @@ -53579,7 +54329,8 @@ function context$1(ppf, cxt) { } else if (Stdlib__List.for_all((function (param) { return param.TAG === /* Module */0 ? true : false; }), cxt)) { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "In module ", @@ -53604,12 +54355,14 @@ function context$1(ppf, cxt) { _1: "In module %a:@ " }), path, path_of_context(cxt)); } else { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -53658,12 +54411,14 @@ function include_err$2(ppf, param) { const err = param[2]; const cxt = param[0]; wrap_printing_env(param[1], (function (param) { - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -53723,7 +54478,8 @@ function report_error$4(ppf, errs) { return Stdlib__List.iter((function (param) { if (is_big(param[2])) { if (pe.contents) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "...", @@ -53746,7 +54502,8 @@ function report_error$4(ppf, errs) { return ; } } else { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -53766,12 +54523,14 @@ function report_error$4(ppf, errs) { }), param); }; }; - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -53804,7 +54563,7 @@ register_error_of_exn(function (err) { }); function get_location(ti) { - switch (ti.TAG | 0) { + switch (ti.TAG) { case /* Ti_pat */0 : return ti._0.pat_loc; case /* Ti_expr */1 : @@ -53886,7 +54645,7 @@ function is_absent(tag, row) { function is_absent_pat(p) { const match = p.pat_desc; - if (typeof match === "number" || match.TAG !== /* Tpat_variant */5) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tpat_variant */5) { return false; } else { return is_absent(match._0, match._2); @@ -53894,7 +54653,7 @@ function is_absent_pat(p) { } function const_compare(x, y) { - switch (x.TAG | 0) { + switch (x.TAG) { case /* Const_string */2 : if (y.TAG === /* Const_string */2) { return Caml.caml_string_compare(x._0, y._0); @@ -54007,18 +54766,18 @@ function compat(_p, _q) { const match = p.pat_desc; const match$1 = q.pat_desc; let exit = 0; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { exit = 1; } else { - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tpat_alias */1 : _p = match._0; continue ; case /* Tpat_constant */2 : - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tpat_var */0 : case /* Tpat_alias */1 : exit = 1; @@ -54034,10 +54793,10 @@ function compat(_p, _q) { } break; case /* Tpat_tuple */3 : - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tpat_var */0 : case /* Tpat_alias */1 : exit = 1; @@ -54053,10 +54812,10 @@ function compat(_p, _q) { } break; case /* Tpat_construct */4 : - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tpat_var */0 : case /* Tpat_alias */1 : exit = 1; @@ -54079,10 +54838,10 @@ function compat(_p, _q) { const p1 = match._1; const l1 = match._0; if (p1 !== undefined) { - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tpat_var */0 : case /* Tpat_alias */1 : exit = 1; @@ -54105,10 +54864,10 @@ function compat(_p, _q) { exit = 3; } } - } else if (typeof match$1 === "number") { + } else if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tpat_var */0 : case /* Tpat_alias */1 : exit = 1; @@ -54128,10 +54887,10 @@ function compat(_p, _q) { } break; case /* Tpat_record */6 : - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tpat_var */0 : case /* Tpat_alias */1 : exit = 1; @@ -54149,10 +54908,10 @@ function compat(_p, _q) { break; case /* Tpat_array */7 : const ps = match._0; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tpat_var */0 : case /* Tpat_alias */1 : exit = 1; @@ -54173,10 +54932,10 @@ function compat(_p, _q) { } break; case /* Tpat_lazy */9 : - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 1; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tpat_var */0 : case /* Tpat_alias */1 : exit = 1; @@ -54199,17 +54958,17 @@ function compat(_p, _q) { } switch (exit) { case 1 : - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return true; } - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tpat_var */0 : return true; case /* Tpat_alias */1 : _q = match$1._0; continue ; default: - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return true; } if (match.TAG === /* Tpat_var */0) { @@ -54290,7 +55049,7 @@ function clean_copy(ty) { function get_type_path(ty, tenv) { const ty$1 = repr(expand_head(tenv, clean_copy(ty))); const match = ty$1.desc; - if (typeof match === "number" || match.TAG !== /* Tconstr */3) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tconstr */3) { return fatal_error("Parmatch.get_type_path"); } else { return match._0; @@ -54306,9 +55065,10 @@ function is_cons(param) { } function pretty_const(c) { - switch (c.TAG | 0) { + switch (c.TAG) { case /* Const_int */0 : - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -54319,7 +55079,8 @@ function pretty_const(c) { _1: "%d" }), c._0); case /* Const_char */1 : - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Caml_char */1, _0: /* End_of_format */0 @@ -54327,7 +55088,8 @@ function pretty_const(c) { _1: "%C" }), c._0); case /* Const_string */2 : - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Caml_string */3, _0: /* No_padding */0, @@ -54336,7 +55098,8 @@ function pretty_const(c) { _1: "%S" }), c._0); case /* Const_float */3 : - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -54345,7 +55108,8 @@ function pretty_const(c) { _1: "%s" }), c._0); case /* Const_int32 */4 : - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Int32 */5, _0: /* Int_d */0, @@ -54360,7 +55124,8 @@ function pretty_const(c) { _1: "%ldl" }), c._0); case /* Const_int64 */5 : - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_d */0, @@ -54375,7 +55140,8 @@ function pretty_const(c) { _1: "%LdL" }), c._0); case /* Const_nativeint */6 : - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Nativeint */6, _0: /* Int_d */0, @@ -54398,13 +55164,15 @@ function pretty_val(ppf, v) { if (match) { const rem = match.tl; let tmp = match.hd[0]; - if (typeof tmp === "number") { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -54436,12 +55204,14 @@ function pretty_val(ppf, v) { pat_attributes: v.pat_attributes }); } else if (tmp.TAG === /* Tpat_constraint */0) { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -54473,12 +55243,14 @@ function pretty_val(ppf, v) { pat_attributes: v.pat_attributes }); } else { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -54512,8 +55284,9 @@ function pretty_val(ppf, v) { } } const c = v.pat_desc; - if (typeof c === "number") { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + if (/* tag */typeof c === "number" || typeof c === "string") { + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '_' */95, @@ -54522,16 +55295,18 @@ function pretty_val(ppf, v) { _1: "_" }); } - switch (c.TAG | 0) { + switch (c.TAG) { case /* Tpat_var */0 : return print$2(ppf, c._0); case /* Tpat_alias */1 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -54572,7 +55347,8 @@ function pretty_val(ppf, v) { _1: "@[(%a@ as %a)@]" }), pretty_val, c._0, print$2, c._1); case /* Tpat_constant */2 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -54581,12 +55357,14 @@ function pretty_val(ppf, v) { _1: "%s" }), pretty_const(c._0)); case /* Tpat_tuple */3 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -54616,7 +55394,8 @@ function pretty_val(ppf, v) { const match$1 = c._2; const cstr = c._1; if (!match$1) { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -54626,12 +55405,14 @@ function pretty_val(ppf, v) { }), cstr.cstr_name); } if (!match$1.tl) { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -54670,12 +55451,14 @@ function pretty_val(ppf, v) { if (name === "::" && vs) { const match$2 = vs.tl; if (match$2 && !match$2.tl) { - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -54710,12 +55493,14 @@ function pretty_val(ppf, v) { } } - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -54739,7 +55524,8 @@ function pretty_val(ppf, v) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -54777,12 +55563,14 @@ function pretty_val(ppf, v) { const w = c._1; const l = c._0; if (w !== undefined) { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -54820,7 +55608,8 @@ function pretty_val(ppf, v) { _1: "@[<2>`%s@ %a@]" }), l, pretty_arg, w); } else { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '`' */96, @@ -54834,12 +55623,14 @@ function pretty_val(ppf, v) { }), l); } case /* Tpat_record */6 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -54863,19 +55654,22 @@ function pretty_val(ppf, v) { }, _1: "@[{%a}@]" }), pretty_lvals, Stdlib__List.filter((function (param) { - if (typeof param[2].pat_desc === "number") { + let tmp = param[2].pat_desc; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { return false; } else { return true; } }), c._0)); case /* Tpat_array */7 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -54902,12 +55696,14 @@ function pretty_val(ppf, v) { return pretty_vals(" ;", param, param$1); }), c._0); case /* Tpat_or */8 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -54948,12 +55744,14 @@ function pretty_val(ppf, v) { _1: "@[(%a|@,%a)@]" }), pretty_or, c._0, pretty_or, c._1); case /* Tpat_lazy */9 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -54992,7 +55790,7 @@ function pretty_val(ppf, v) { function pretty_car(ppf, v) { const match = v.pat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return pretty_val(ppf, v); } if (match.TAG !== /* Tpat_construct */4) { @@ -55004,7 +55802,8 @@ function pretty_car(ppf, v) { } const match$2 = match$1.tl; if (match$2 && !(match$2.tl || !is_cons(match._1))) { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '(' */40, @@ -55026,7 +55825,7 @@ function pretty_car(ppf, v) { function pretty_cdr(ppf, v) { const match = v.pat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return pretty_val(ppf, v); } if (match.TAG !== /* Tpat_construct */4) { @@ -55038,7 +55837,8 @@ function pretty_cdr(ppf, v) { } const match$2 = match$1.tl; if (match$2 && !(match$2.tl || !is_cons(match._1))) { - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -55068,10 +55868,10 @@ function pretty_cdr(ppf, v) { function pretty_arg(ppf, v) { const match = v.pat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return pretty_val(ppf, v); } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tpat_construct */4 : if (!match._2) { return pretty_val(ppf, v); @@ -55085,7 +55885,8 @@ function pretty_arg(ppf, v) { default: return pretty_val(ppf, v); } - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '(' */40, @@ -55104,10 +55905,11 @@ function pretty_arg(ppf, v) { function pretty_or(ppf, v) { const match = v.pat_desc; - if (typeof match === "number" || match.TAG !== /* Tpat_or */8) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tpat_or */8) { return pretty_val(ppf, v); } else { - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -55139,7 +55941,8 @@ function pretty_vals(sep, ppf, param) { } const v = param.hd; if (param.tl) { - return Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -55175,7 +55978,8 @@ function pretty_lvals(ppf, param) { } const match = param.hd; if (param.tl) { - return Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -55207,7 +56011,8 @@ function pretty_lvals(ppf, param) { _1: "%s=%a;@ %a" }), match[1].lbl_name, pretty_val, match[2], pretty_lvals, param.tl); } else { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -55226,12 +56031,14 @@ function pretty_lvals(ppf, param) { } function top_pretty(ppf, v) { - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -55256,11 +56063,11 @@ function top_pretty(ppf, v) { function simple_match(p1, p2) { const match = p1.pat_desc; const match$1 = p2.pat_desc; - if (typeof match !== "number") { - switch (match.TAG | 0) { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + switch (match.TAG) { case /* Tpat_constant */2 : - if (typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tpat_var */0 : break; case /* Tpat_constant */2 : @@ -55271,8 +56078,8 @@ function simple_match(p1, p2) { } break; case /* Tpat_tuple */3 : - if (typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tpat_var */0 : break; case /* Tpat_tuple */3 : @@ -55283,8 +56090,8 @@ function simple_match(p1, p2) { } break; case /* Tpat_construct */4 : - if (typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tpat_var */0 : break; case /* Tpat_construct */4 : @@ -55295,8 +56102,8 @@ function simple_match(p1, p2) { } break; case /* Tpat_variant */5 : - if (typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tpat_var */0 : break; case /* Tpat_variant */5 : @@ -55307,8 +56114,8 @@ function simple_match(p1, p2) { } break; case /* Tpat_record */6 : - if (typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tpat_var */0 : break; case /* Tpat_record */6 : @@ -55319,8 +56126,8 @@ function simple_match(p1, p2) { } break; case /* Tpat_array */7 : - if (typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tpat_var */0 : break; case /* Tpat_array */7 : @@ -55331,8 +56138,8 @@ function simple_match(p1, p2) { } break; case /* Tpat_lazy */9 : - if (typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tpat_var */0 : break; case /* Tpat_lazy */9 : @@ -55346,7 +56153,7 @@ function simple_match(p1, p2) { } } - if (typeof match$1 === "number" || match$1.TAG === /* Tpat_var */0) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG === /* Tpat_var */0) { return true; } else { return false; @@ -55355,7 +56162,7 @@ function simple_match(p1, p2) { function record_arg(p) { const match = p.pat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return /* [] */0; } else if (match.TAG === /* Tpat_record */6) { return match._0; @@ -55374,8 +56181,8 @@ function simple_match_args(p1, _p2) { while(true) { const p2 = _p2; const args = p2.pat_desc; - if (typeof args !== "number") { - switch (args.TAG | 0) { + if (!/* tag */(typeof args === "number" || typeof args === "string")) { + switch (args.TAG) { case /* Tpat_var */0 : break; case /* Tpat_alias */1 : @@ -55423,10 +56230,10 @@ function simple_match_args(p1, _p2) { } } const args$1 = p1.pat_desc; - if (typeof args$1 === "number") { + if (/* tag */typeof args$1 === "number" || typeof args$1 === "string") { return /* [] */0; } - switch (args$1.TAG | 0) { + switch (args$1.TAG) { case /* Tpat_tuple */3 : return Stdlib__List.map((function (param) { return omega; @@ -55467,10 +56274,10 @@ function normalize_pat(_q) { while(true) { const q = _q; const args = q.pat_desc; - if (typeof args === "number") { + if (/* tag */typeof args === "number" || typeof args === "string") { return q; } - switch (args.TAG | 0) { + switch (args.TAG) { case /* Tpat_var */0 : return make_pat(/* Tpat_any */0, q.pat_type, q.pat_env); case /* Tpat_alias */1 : @@ -55537,7 +56344,7 @@ function normalize_pat(_q) { function discr_pat(q, pss) { const q$1 = normalize_pat(q); let tmp = q$1.pat_desc; - if (typeof tmp === "number" || tmp.TAG === /* Tpat_record */6) { + if (/* tag */typeof tmp === "number" || typeof tmp === "string" || tmp.TAG === /* Tpat_record */6) { let _acc = q$1; let _pss = pss; while(true) { @@ -55552,11 +56359,11 @@ function discr_pat(q, pss) { } const p = match.hd; const match$1 = p.pat_desc; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { _pss = pss$1.tl; continue ; } - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tpat_var */0 : _pss = pss$1.tl; continue ; @@ -55648,13 +56455,13 @@ function read_args(xs, r) { function do_set_args(erase_mutable, q, r) { const omegas = q.pat_desc; - if (typeof omegas === "number") { + if (/* tag */typeof omegas === "number" || typeof omegas === "string") { return { hd: q, tl: r }; } - switch (omegas.TAG | 0) { + switch (omegas.TAG) { case /* Tpat_constant */2 : return { hd: q, @@ -55725,7 +56532,9 @@ function do_set_args(erase_mutable, q, r) { let tmp = false; if (erase_mutable) { const match = lbl.lbl_mut; - tmp = match ? true : false; + let tmp$1; + tmp$1 = match === /* Immutable */0 ? false : true; + tmp = tmp$1; } if (tmp) { return [ @@ -55784,8 +56593,8 @@ function filter_one(q, pss) { } const p = match.hd; const match$1 = p.pat_desc; - if (typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tpat_alias */1 : _param = { hd: { @@ -55839,13 +56648,13 @@ function filter_extra(pss) { const match = param.hd; if (match) { const match$1 = match.hd.pat_desc; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return { hd: match.tl, tl: filter_rec(param.tl) }; } - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tpat_var */0 : return { hd: match.tl, @@ -55938,11 +56747,11 @@ function filter_all(pat0, pss) { } const p = match.hd; const match$1 = p.pat_desc; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { _param = param.tl; continue ; } - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tpat_var */0 : _param = param.tl; continue ; @@ -55981,10 +56790,10 @@ function filter_all(pat0, pss) { const match = pat0.pat_desc; let tmp; let exit = 0; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { tmp = /* [] */0; } else { - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tpat_tuple */3 : case /* Tpat_record */6 : case /* Tpat_lazy */9 : @@ -56014,8 +56823,8 @@ function filter_all(pat0, pss) { const match$1 = param.hd; if (match$1) { const match$2 = match$1.hd.pat_desc; - if (typeof match$2 !== "number") { - switch (match$2.TAG | 0) { + if (!/* tag */(typeof match$2 === "number" || typeof match$2 === "string")) { + switch (match$2.TAG) { case /* Tpat_var */0 : break; case /* Tpat_alias */1 : @@ -56094,13 +56903,13 @@ function mark_partial(_param) { const ps = param.hd; if (ps) { const match = ps.hd.pat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return { hd: ps, tl: mark_partial(param.tl) }; } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tpat_var */0 : return { hd: ps, @@ -56146,7 +56955,7 @@ function close_variant(env, row) { const row$1 = row_repr_aux(/* [] */0, row); const nm = Stdlib__List.fold_left((function (nm, param) { const match = row_field_repr_aux(/* [] */0, param[1]); - if (typeof match === "number" || match.TAG === /* Rpresent */0 || match._2) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG === /* Rpresent */0 || match._2) { return nm; } else { set_row_field(match._3, /* Rabsent */0); @@ -56175,7 +56984,7 @@ function close_variant(env, row) { function row_of_pat(pat) { const match = expand_head(pat.pat_env, pat.pat_type); const row = match.desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -56200,7 +57009,7 @@ function row_of_pat(pat) { function generalized_constructor(x) { const match = x[0].pat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -56251,10 +57060,10 @@ function full_match(ignore_generalized, closing, env) { } const p = env.hd[0]; const match = p.pat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return fatal_error("Parmatch.full_match"); } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tpat_constant */2 : if (match._0.TAG === /* Const_char */1) { return Stdlib__List.length(env) === 256; @@ -56274,7 +57083,7 @@ function full_match(ignore_generalized, closing, env) { case /* Tpat_variant */5 : const fields = Stdlib__List.map((function (param) { const match = param[0].pat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -56301,7 +57110,7 @@ function full_match(ignore_generalized, closing, env) { return Stdlib__List.for_all((function (param) { const tag = param[0]; const match = row_field_repr_aux(/* [] */0, param[1]); - if (typeof match === "number" || !(match.TAG === /* Rpresent */0 || match._2)) { + if (/* tag */typeof match === "number" || typeof match === "string" || !(match.TAG === /* Rpresent */0 || match._2)) { return true; } else { return Stdlib__List.mem(tag, fields); @@ -56334,7 +57143,7 @@ function full_match_gadt(env) { return true; } const match = env.hd[0].pat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return true; } if (match.TAG !== /* Tpat_construct */4) { @@ -56353,13 +57162,13 @@ function should_extend(ext, env) { } const p = env.hd[0]; const match = p.pat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return false; } if (match.TAG !== /* Tpat_construct */4) { return false; } - switch (match._1.cstr_tag.TAG | 0) { + switch (match._1.cstr_tag.TAG) { case /* Cstr_constant */0 : case /* Cstr_block */1 : break; @@ -56375,7 +57184,7 @@ function complete_tags(nconsts, nconstrs, tags) { const seen_const = Caml_array.make(nconsts, false); const seen_constr = Caml_array.make(nconstrs, false); Stdlib__List.iter((function (i) { - switch (i.TAG | 0) { + switch (i.TAG) { case /* Cstr_constant */0 : return Caml_array.set(seen_const, i._0, true); case /* Cstr_block */1 : @@ -56472,7 +57281,7 @@ function get_variant_constructors(env, _ty) { while(true) { const ty = _ty; const match = repr(ty).desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return fatal_error("Parmatch.get_variant_constructors"); } if (match.TAG !== /* Tconstr */3) { @@ -56481,7 +57290,7 @@ function get_variant_constructors(env, _ty) { const path = match._0; const match$1 = find_type_full(path, env)[0]; let tmp = match$1.type_kind; - if (typeof tmp !== "number" && tmp.TAG === /* Type_variant */1) { + if (!/* tag */(typeof tmp === "number" || typeof tmp === "string") && tmp.TAG === /* Type_variant */1) { return find_type_full(path, env)[1][0]; } if (match$1.type_manifest === undefined) { @@ -56513,7 +57322,7 @@ function map_filter(f, _param) { function complete_constrs(p, all_tags) { const match = p.pat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return fatal_error("Parmatch.complete_constr"); } if (match.TAG !== /* Tpat_construct */4) { @@ -56553,15 +57362,15 @@ function build_other(ext, env) { } const p = env.hd[0]; const args = p.pat_desc; - if (typeof args === "number") { + if (/* tag */typeof args === "number" || typeof args === "string") { return omega; } - switch (args.TAG | 0) { + switch (args.TAG) { case /* Tpat_constant */2 : - switch (args._0.TAG | 0) { + switch (args._0.TAG) { case /* Const_int */0 : return build_other_constant((function (param) { - if (typeof param !== "number" && param.TAG === /* Tpat_constant */2) { + if (!/* tag */(typeof param === "number" || typeof param === "string") && param.TAG === /* Tpat_constant */2) { const i = param._0; if (i.TAG === /* Const_int */0) { return i._0; @@ -56590,7 +57399,7 @@ function build_other(ext, env) { case /* Const_char */1 : const all_chars = Stdlib__List.map((function (param) { const match = param[0].pat_desc; - if (typeof match !== "number" && match.TAG === /* Tpat_constant */2) { + if (!/* tag */(typeof match === "number" || typeof match === "string") && match.TAG === /* Tpat_constant */2) { const c = match._0; if (c.TAG === /* Const_char */1) { return c._0; @@ -56678,7 +57487,7 @@ function build_other(ext, env) { }; case /* Const_string */2 : return build_other_constant((function (param) { - if (typeof param !== "number" && param.TAG === /* Tpat_constant */2) { + if (!/* tag */(typeof param === "number" || typeof param === "string") && param.TAG === /* Tpat_constant */2) { const match = param._0; if (match.TAG === /* Const_string */2) { return match._0.length; @@ -56707,7 +57516,7 @@ function build_other(ext, env) { }), p, env); case /* Const_float */3 : return build_other_constant((function (param) { - if (typeof param !== "number" && param.TAG === /* Tpat_constant */2) { + if (!/* tag */(typeof param === "number" || typeof param === "string") && param.TAG === /* Tpat_constant */2) { const f = param._0; if (f.TAG === /* Const_float */3) { return Caml_format.caml_float_of_string(f._0); @@ -56735,7 +57544,7 @@ function build_other(ext, env) { }), p, env); case /* Const_int32 */4 : return build_other_constant((function (param) { - if (typeof param !== "number" && param.TAG === /* Tpat_constant */2) { + if (!/* tag */(typeof param === "number" || typeof param === "string") && param.TAG === /* Tpat_constant */2) { const i = param._0; if (i.TAG === /* Const_int32 */4) { return i._0; @@ -56761,7 +57570,7 @@ function build_other(ext, env) { }), 0, Stdlib__Int32.succ, p, env); case /* Const_int64 */5 : return build_other_constant((function (param) { - if (typeof param !== "number" && param.TAG === /* Tpat_constant */2) { + if (!/* tag */(typeof param === "number" || typeof param === "string") && param.TAG === /* Tpat_constant */2) { const i = param._0; if (i.TAG === /* Const_int64 */5) { return i._0; @@ -56799,7 +57608,7 @@ function build_other(ext, env) { case /* Tpat_construct */4 : let exit = 0; const c = args._1; - switch (c.cstr_tag.TAG | 0) { + switch (c.cstr_tag.TAG) { case /* Cstr_constant */0 : case /* Cstr_block */1 : exit = 1; @@ -56854,7 +57663,7 @@ function build_other(ext, env) { const all_tags = Stdlib__List.map((function (param) { let param$1 = param[0]; const match = param$1.pat_desc; - if (typeof match === "number" || match.TAG !== /* Tpat_construct */4) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tpat_construct */4) { return fatal_error("Parmatch.get_tag"); } else { return match._1.cstr_tag; @@ -56869,7 +57678,7 @@ function build_other(ext, env) { const r = args._2; const tags = Stdlib__List.map((function (param) { const match = param[0].pat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -56907,7 +57716,7 @@ function build_other(ext, env) { return others; } const arg = row_field_repr_aux(/* [] */0, param[1]); - if (typeof arg === "number") { + if (/* tag */typeof arg === "number" || typeof arg === "string") { return others; } else if (arg.TAG === /* Rpresent */0) { return { @@ -56936,7 +57745,7 @@ function build_other(ext, env) { case /* Tpat_array */7 : const all_lengths = Stdlib__List.map((function (param) { const args = param[0].pat_desc; - if (typeof args === "number") { + if (/* tag */typeof args === "number" || typeof args === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -56979,11 +57788,11 @@ function build_other_gadt(ext, env) { if (env) { const p = env.hd[0]; let tmp = p.pat_desc; - if (typeof tmp !== "number" && tmp.TAG === /* Tpat_construct */4) { + if (!/* tag */(typeof tmp === "number" || typeof tmp === "string") && tmp.TAG === /* Tpat_construct */4) { const all_tags = Stdlib__List.map((function (param) { let param$1 = param[0]; const match = param$1.pat_desc; - if (typeof match === "number" || match.TAG !== /* Tpat_construct */4) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tpat_construct */4) { return fatal_error("Parmatch.get_tag"); } else { return match._1.cstr_tag; @@ -57010,10 +57819,10 @@ function has_instance(_p) { while(true) { const p = _p; const p$1 = p.pat_desc; - if (typeof p$1 === "number") { + if (/* tag */typeof p$1 === "number" || typeof p$1 === "string") { return true; } - switch (p$1.TAG | 0) { + switch (p$1.TAG) { case /* Tpat_construct */4 : return has_instances(p$1._2); case /* Tpat_variant */5 : @@ -57076,10 +57885,10 @@ function satisfiable(_pss, _qs) { const q = qs.hd; const match = q.pat_desc; let exit = 0; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { exit = 2; } else { - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tpat_var */0 : exit = 2; break; @@ -57176,22 +57985,22 @@ function try_many_gadt(f, param) { match[1] ]); let r2 = try_many_gadt(f, param.tl); - if (r1) { - if (r2) { - return /* Rsome */{ - _0: Stdlib.$at(r1._0, r2._0) - }; - } else { - return r1; - } - } else { + if (/* tag */typeof r1 === "number" || typeof r1 === "string") { return r2; + } else if (/* tag */typeof r2 === "number" || typeof r2 === "string") { + return r1; + } else { + return { + TAG: /* Rsome */0, + _0: Stdlib.$at(r1._0, r2._0) + }; } } function exhaust(ext, pss, n) { if (!pss) { - return /* Rsome */{ + return { + TAG: /* Rsome */0, _0: omegas(n) }; } @@ -57207,12 +58016,13 @@ function exhaust(ext, pss, n) { return /* Rnone */0; } const r = exhaust(ext, param[1], (Stdlib__List.length(simple_match_args(p, omega)) + n | 0) - 1 | 0); - if (r) { - return /* Rsome */{ + if (/* tag */typeof r === "number" || typeof r === "string") { + return r; + } else { + return { + TAG: /* Rsome */0, _0: do_set_args(false, p, r._0) }; - } else { - return r; } }; if (full_match(true, false, constrs) && !should_extend(ext, constrs)) { @@ -57227,7 +58037,7 @@ function exhaust(ext, pss, n) { match[0], match[1] ]); - if (r) { + if (!/* tag */(typeof r === "number" || typeof r === "string")) { return r; } _param = param.tl; @@ -57235,11 +58045,12 @@ function exhaust(ext, pss, n) { }; } const r$1 = exhaust(ext, filter_extra(pss), n - 1 | 0); - if (!r$1) { + if (/* tag */typeof r$1 === "number" || typeof r$1 === "string") { return /* Rnone */0; } try { - return /* Rsome */{ + return { + TAG: /* Rsome */0, _0: { hd: build_other(ext, constrs), tl: r$1._0 @@ -57255,15 +58066,16 @@ function exhaust(ext, pss, n) { } } else { const r$2 = exhaust(ext, filter_extra(pss), n - 1 | 0); - if (r$2) { - return /* Rsome */{ + if (/* tag */typeof r$2 === "number" || typeof r$2 === "string") { + return r$2; + } else { + return { + TAG: /* Rsome */0, _0: { hd: q0, tl: r$2._0 } }; - } else { - return r$2; } } } @@ -57291,7 +58103,8 @@ function combinations(f, lst, lst$p) { function exhaust_gadt(ext, pss, n) { if (!pss) { - return /* Rsome */{ + return { + TAG: /* Rsome */0, _0: { hd: omegas(n), tl: /* [] */0 @@ -57310,14 +58123,15 @@ function exhaust_gadt(ext, pss, n) { return /* Rnone */0; } const r = exhaust_gadt(ext, param[1], (Stdlib__List.length(simple_match_args(p, omega)) + n | 0) - 1 | 0); - if (r) { - return /* Rsome */{ + if (/* tag */typeof r === "number" || typeof r === "string") { + return r; + } else { + return { + TAG: /* Rsome */0, _0: Stdlib__List.map((function (row) { return do_set_args(false, p, row); }), r._0) }; - } else { - return r; } }; const before = try_many_gadt(try_non_omega, constrs); @@ -57325,7 +58139,7 @@ function exhaust_gadt(ext, pss, n) { return before; } const r = exhaust_gadt(ext, filter_extra(pss), n - 1 | 0); - if (!r) { + if (/* tag */typeof r === "number" || typeof r === "string") { return before; } try { @@ -57336,13 +58150,15 @@ function exhaust_gadt(ext, pss, n) { tl: tail }; }), missing_trailing, r._0); - if (before) { - return /* Rsome */{ - _0: Stdlib.$at(before._0, dug) + if (/* tag */typeof before === "number" || typeof before === "string") { + return { + TAG: /* Rsome */0, + _0: dug }; } else { - return /* Rsome */{ - _0: dug + return { + TAG: /* Rsome */0, + _0: Stdlib.$at(before._0, dug) }; } } @@ -57355,8 +58171,11 @@ function exhaust_gadt(ext, pss, n) { } } else { const r$1 = exhaust_gadt(ext, filter_extra(pss), n - 1 | 0); - if (r$1) { - return /* Rsome */{ + if (/* tag */typeof r$1 === "number" || typeof r$1 === "string") { + return r$1; + } else { + return { + TAG: /* Rsome */0, _0: Stdlib__List.map((function (row) { return { hd: q0, @@ -57364,20 +58183,19 @@ function exhaust_gadt(ext, pss, n) { }; }), r$1._0) }; - } else { - return r$1; } } } function exhaust_gadt$1(ext, pss, n) { const ret = exhaust_gadt(ext, pss, n); - if (!ret) { + if (/* tag */typeof ret === "number" || typeof ret === "string") { return /* Rnone */0; } const lst = ret._0; if (Caml_obj.caml_equal(lst, /* [] */0)) { - return /* Rsome */{ + return { + TAG: /* Rsome */0, _0: omegas(n) }; } @@ -57404,7 +58222,8 @@ function exhaust_gadt$1(ext, pss, n) { ] }); }), lst); - return /* Rsome */{ + return { + TAG: /* Rsome */0, _0: { hd: Curry._1(orify_many, singletons), tl: /* [] */0 @@ -57449,7 +58268,7 @@ function pressure_variants(_tdefs, _pss) { if (constrs) { const p = constrs.hd[0]; let tmp = p.pat_desc; - if (typeof tmp !== "number" && tmp.TAG === /* Tpat_variant */5 && tdefs !== undefined) { + if (!/* tag */(typeof tmp === "number" || typeof tmp === "string") && tmp.TAG === /* Tpat_variant */5 && tdefs !== undefined) { const row = row_of_pat(p); if (row_fixed(row) || pressure_variants(undefined, filter_extra(pss))) { @@ -57478,7 +58297,7 @@ function unalias$1(_p) { while(true) { const p = _p; const match = p.pat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return p; } if (match.TAG !== /* Tpat_alias */1) { @@ -57495,7 +58314,7 @@ function is_var_column(rs) { if (match) { let p = match.hd; const match$1 = unalias$1(p).pat_desc; - if (typeof match$1 === "number" || match$1.TAG === /* Tpat_var */0) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG === /* Tpat_var */0) { return true; } else { return false; @@ -57516,7 +58335,7 @@ function or_args(_p) { while(true) { const p = _p; const match = p.pat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -57526,7 +58345,7 @@ function or_args(_p) { ] }); } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tpat_alias */1 : _p = match._0; continue ; @@ -57630,8 +58449,8 @@ function filter_one$1(q, rs) { if (match) { const p = match.hd; const match$1 = p.pat_desc; - if (typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tpat_alias */1 : _rs = { hd: { @@ -57772,10 +58591,10 @@ function every_satisfiables(_pss, _qs) { const uq = unalias$1(q); const match$1 = uq.pat_desc; let exit = 0; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { exit = 2; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Tpat_var */0 : exit = 2; break; @@ -57823,7 +58642,7 @@ function every_satisfiables(_pss, _qs) { const match$2 = qs.ors; if (match$2) { return Stdlib__List.fold_right2((function (pss, qs, r) { - if (typeof r === "number" && r) { + if (/* tag */(typeof r === "number" || typeof r === "string") && r !== /* Used */0) { return /* Unused */1; } const match = qs.active; @@ -57840,23 +58659,24 @@ function every_satisfiables(_pss, _qs) { } const match$1 = or_args(match.hd); const r_loc = every_both(pss, qs, match$1[0], match$1[1]); - if (typeof r === "number") { - if (r) { + if (/* tag */typeof r === "number" || typeof r === "string") { + if (r !== /* Used */0) { return /* Unused */1; } } else { - if (typeof r_loc !== "number") { - return /* Upartial */{ + if (!/* tag */(typeof r_loc === "number" || typeof r_loc === "string")) { + return { + TAG: /* Upartial */0, _0: Stdlib.$at(r._0, r_loc._0) }; } - if (!r_loc) { + if (r_loc === /* Used */0) { return r; } } - if (typeof r_loc === "number" && r_loc) { + if (/* tag */(typeof r_loc === "number" || typeof r_loc === "string") && r_loc !== /* Used */0) { return /* Unused */1; } else { return r_loc; @@ -57908,52 +58728,57 @@ function every_both(pss, qs, q1, q2) { hd: qs1, tl: pss }) : pss, qs2); - if (typeof r1 === "number") { - if (r1) { - if (typeof r2 === "number") { - if (r2) { - return /* Unused */1; - } else { - return /* Upartial */{ - _0: { - hd: q1, - tl: /* [] */0 - } - }; - } + if (/* tag */typeof r1 === "number" || typeof r1 === "string") { + if (r1 === /* Used */0) { + if (/* tag */(typeof r2 === "number" || typeof r2 === "string") && r2 !== /* Used */0) { + return { + TAG: /* Upartial */0, + _0: { + hd: q2, + tl: /* [] */0 + } + }; } else { - return /* Upartial */{ + return r2; + } + } else if (/* tag */typeof r2 === "number" || typeof r2 === "string") { + if (r2 === /* Used */0) { + return { + TAG: /* Upartial */0, _0: { hd: q1, - tl: r2._0 + tl: /* [] */0 } }; + } else { + return /* Unused */1; } - } else if (typeof r2 === "number" && r2) { - return /* Upartial */{ + } else { + return { + TAG: /* Upartial */0, _0: { - hd: q2, - tl: /* [] */0 + hd: q1, + tl: r2._0 } }; - } else { - return r2; } } const u1 = r1._0; - if (typeof r2 === "number") { - if (r2) { - return /* Upartial */{ + if (/* tag */typeof r2 === "number" || typeof r2 === "string") { + if (r2 === /* Used */0) { + return r1; + } else { + return { + TAG: /* Upartial */0, _0: Stdlib.$at(u1, { hd: q2, tl: /* [] */0 }) }; - } else { - return r1; } } else { - return /* Upartial */{ + return { + TAG: /* Upartial */0, _0: Stdlib.$at(u1, r2._0) }; } @@ -57966,18 +58791,18 @@ function le_pat(_p, _q) { const match = p.pat_desc; const match$1 = q.pat_desc; let exit = 0; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return true; } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tpat_var */0 : return true; case /* Tpat_alias */1 : _p = match._0; continue ; case /* Tpat_constant */2 : - if (typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tpat_alias */1 : exit = 2; break; @@ -57989,8 +58814,8 @@ function le_pat(_p, _q) { } break; case /* Tpat_tuple */3 : - if (typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tpat_alias */1 : exit = 2; break; @@ -58002,8 +58827,8 @@ function le_pat(_p, _q) { } break; case /* Tpat_construct */4 : - if (typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tpat_alias */1 : exit = 2; break; @@ -58022,8 +58847,8 @@ function le_pat(_p, _q) { const p1 = match._1; const l1 = match._0; if (p1 !== undefined) { - if (typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tpat_alias */1 : exit = 2; break; @@ -58043,8 +58868,8 @@ function le_pat(_p, _q) { } } - } else if (typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + } else if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tpat_alias */1 : exit = 2; break; @@ -58060,8 +58885,8 @@ function le_pat(_p, _q) { } break; case /* Tpat_record */6 : - if (typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tpat_alias */1 : exit = 2; break; @@ -58075,8 +58900,8 @@ function le_pat(_p, _q) { break; case /* Tpat_array */7 : const ps = match._0; - if (typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tpat_alias */1 : exit = 2; break; @@ -58096,8 +58921,8 @@ function le_pat(_p, _q) { exit = 2; break; case /* Tpat_lazy */9 : - if (typeof match$1 !== "number") { - switch (match$1.TAG | 0) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string")) { + switch (match$1.TAG) { case /* Tpat_alias */1 : exit = 2; break; @@ -58112,7 +58937,7 @@ function le_pat(_p, _q) { break; } - if (exit === 2 && typeof match$1 !== "number" && match$1.TAG === /* Tpat_alias */1) { + if (exit === 2 && !/* tag */(typeof match$1 === "number" || typeof match$1 === "string") && match$1.TAG === /* Tpat_alias */1) { _q = match$1._0; continue ; } @@ -58267,8 +59092,8 @@ function do_filter_one(q, pss) { } const p = match$1.hd; const match$2 = p.pat_desc; - if (typeof match$2 !== "number") { - switch (match$2.TAG | 0) { + if (!/* tag */(typeof match$2 === "number" || typeof match$2 === "string")) { + switch (match$2.TAG) { case /* Tpat_alias */1 : _param = { hd: [ @@ -58333,7 +59158,7 @@ function do_match(_pss, _qs) { const qs$1 = qs.tl; const q = qs.hd; const match = q.pat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { _qs = qs$1; _pss = do_filter_var(pss); continue ; @@ -58448,13 +59273,13 @@ function conv(typed) { while(true) { const pat = _pat; const lst = pat.pat_desc; - if (typeof lst === "number") { + if (/* tag */typeof lst === "number" || typeof lst === "string") { return { hd: mk$1(undefined, undefined, /* Ppat_any */0), tl: /* [] */0 }; } - switch (lst.TAG | 0) { + switch (lst.TAG) { case /* Tpat_alias */1 : _pat = lst._0; continue ; @@ -58603,7 +59428,7 @@ function conv(typed) { function do_check_partial(pred, exhaust, loc, casel, pss) { if (pss) { const match = Curry._3(exhaust, undefined, pss, Stdlib__List.length(pss.hd)); - if (!match) { + if (/* tag */typeof match === "number" || typeof match === "string") { return /* Total */1; } const match$1 = match._0; @@ -58627,7 +59452,7 @@ function do_check_partial(pred, exhaust, loc, casel, pss) { const match$3 = v.pat_desc; let errmsg; let exit = 0; - if (typeof match$3 === "number" || !(match$3.TAG === /* Tpat_construct */4 && match$3._1.cstr_name === "*extension*")) { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string" || !(match$3.TAG === /* Tpat_construct */4 && match$3._1.cstr_name === "*extension*")) { exit = 1; } else { errmsg = "_\nMatching over values of extensible variant types must include\na wild card pattern in order to be exhaustive."; @@ -58690,12 +59515,12 @@ function collect_paths_from_pat(_r, _p) { const p = _p; const r = _r; const p$1 = p.pat_desc; - if (typeof p$1 === "number") { + if (/* tag */typeof p$1 === "number" || typeof p$1 === "string") { return r; } - switch (p$1.TAG | 0) { + switch (p$1.TAG) { case /* Tpat_construct */4 : - switch (p$1._1.cstr_tag.TAG | 0) { + switch (p$1._1.cstr_tag.TAG) { case /* Cstr_constant */0 : case /* Cstr_block */1 : break; @@ -58746,14 +59571,13 @@ function do_check_fragile_param(exhaust, loc, casel, pss) { const ps = pss.hd; Stdlib__List.iter((function (ext) { const match = Curry._3(exhaust, ext, pss, Stdlib__List.length(ps)); - if (match) { - return ; - } else { + if (/* tag */typeof match === "number" || typeof match === "string") { return prerr_warning(loc, { TAG: /* Fragile_match */1, _0: name(undefined, ext) }); } + }), exts); } @@ -58795,7 +59619,7 @@ const $$Error$6 = /* @__PURE__ */Caml_exceptions.create("Ocaml_typedtree_test.Ty const Error_forward = /* @__PURE__ */Caml_exceptions.create("Ocaml_typedtree_test.Typetexp.Error_forward"); function string_of_payload(param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* PStr */0 : const match = param._0; if (!match) { @@ -58833,7 +59657,8 @@ function error_of_extension(ext) { exit = 1; break; default: - return Curry._1(errorf(match.loc, undefined, undefined, /* Format */{ + return Curry._1(errorf(match.loc, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Uninterpreted extension '", @@ -58865,7 +59690,8 @@ function error_of_extension(ext) { }; } else { return { - hd: Curry._1(errorf(loc, undefined, undefined, /* Format */{ + hd: Curry._1(errorf(loc, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Invalid syntax for sub-error of extension '", @@ -58886,7 +59712,7 @@ function error_of_extension(ext) { } }; let exit$1 = 0; - switch (p.TAG | 0) { + switch (p.TAG) { case /* PStr */0 : const match$1 = p._0; if (match$1) { @@ -58942,7 +59768,8 @@ function error_of_extension(ext) { } if (exit$1 === 2) { - return Curry._1(errorf(loc, undefined, undefined, /* Format */{ + return Curry._1(errorf(loc, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Invalid syntax for extension '", @@ -59009,7 +59836,7 @@ newrecord$1.attribute = (function (param, a) { } if (exit === 1) { const match = a[1]; - switch (match.TAG | 0) { + switch (match.TAG) { case /* PStr */0 : const match$1 = match._0; if (match$1) { @@ -59151,7 +59978,7 @@ function narrow_unbound_lid_error(env, loc, lid, make_error) { throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } }; - switch (lid.TAG | 0) { + switch (lid.TAG) { case /* Lident */0 : break; case /* Ldot */1 : @@ -59195,10 +60022,10 @@ function narrow_unbound_lid_error(env, loc, lid, make_error) { function find_component(lookup, make_error, env, loc, lid) { try { - switch (lid.TAG | 0) { + switch (lid.TAG) { case /* Ldot */1 : const match = lid._0; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Lident */0 : if (match._0 === "*predef*") { return Curry._2(lookup, { @@ -59499,7 +60326,7 @@ function validate_name(s) { function transl_type_param(env, styp) { const loc = styp.ptyp_loc; const name = styp.ptyp_desc; - if (typeof name === "number") { + if (/* tag */typeof name === "number" || typeof name === "string") { const ty = new_global_var(validate_name("_"), undefined); return { ctyp_desc: /* Ttyp_any */0, @@ -59599,7 +60426,7 @@ function transl_type(env, policy, styp) { }; }; const name = styp.ptyp_desc; - if (typeof name === "number") { + if (/* tag */typeof name === "number" || typeof name === "string") { let ty; if (policy === /* Univars */2) { ty = new_pre_univar(undefined, undefined); @@ -59619,7 +60446,7 @@ function transl_type(env, policy, styp) { } return ctyp(/* Ttyp_any */0, ty); } - switch (name.TAG | 0) { + switch (name.TAG) { case /* Ptyp_var */0 : const name$1 = name._0; if (name$1 !== "" && Caml_string.get(name$1, 0) === /* '_' */95) { @@ -59709,7 +60536,8 @@ function transl_type(env, policy, styp) { let stl$2; if (stl$1) { const t = stl$1.hd; - stl$2 = typeof t.ptyp_desc === "number" && !(stl$1.tl || decl.type_arity <= 1) ? Stdlib__List.map((function (param) { + let tmp = t.ptyp_desc; + stl$2 = /* tag */(typeof tmp === "number" || typeof tmp === "string") && !(stl$1.tl || decl.type_arity <= 1) ? Stdlib__List.map((function (param) { return t; }), decl.type_params) : stl$1; } else { @@ -59809,12 +60637,12 @@ function transl_type(env, policy, styp) { const ty = decl.type_manifest; if (ty !== undefined) { const row = repr(ty).desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { MEL_EXN_ID: Stdlib.Not_found }); } - switch (row.TAG | 0) { + switch (row.TAG) { case /* Tconstr */3 : _decl = find_type_full(row._0, env)[0]; continue ; @@ -59854,7 +60682,7 @@ function transl_type(env, policy, styp) { try { const s = lid$1.txt; let lid2; - switch (s.TAG | 0) { + switch (s.TAG) { case /* Lident */0 : lid2 = { TAG: /* Lident */0, @@ -59962,7 +60790,7 @@ function transl_type(env, policy, styp) { } const row = ty$6.desc; let ty$7; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -59972,7 +60800,7 @@ function transl_type(env, policy, styp) { ] }); } - switch (row.TAG | 0) { + switch (row.TAG) { case /* Tobject */4 : const match$4 = flatten_fields(row._0); if (policy === /* Univars */2) { @@ -59989,7 +60817,7 @@ function transl_type(env, policy, styp) { const f = param[1]; const match = row_field_repr_aux(/* [] */0, f); let tmp; - if (typeof match === "number" || match.TAG !== /* Rpresent */0) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Rpresent */0) { tmp = f; } else { const ty = match._0; @@ -60148,8 +60976,8 @@ function transl_type(env, policy, styp) { const t$3 = instance(undefined, env, t$2); const px = proxy(t$3); const match$5 = px.desc; - if (typeof match$5 !== "number") { - switch (match$5.TAG | 0) { + if (!/* tag */(typeof match$5 === "number" || typeof match$5 === "string")) { + switch (match$5.TAG) { case /* Tvar */0 : if (match$5._0 !== undefined) { @@ -60340,7 +61168,7 @@ function transl_type(env, policy, styp) { const match = repr(cty.ctyp_type); const match$1 = match.desc; let nm; - nm = typeof match$1 === "number" || match$1.TAG !== /* Tconstr */3 ? undefined : [ + nm = /* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Tconstr */3 ? undefined : [ match$1._0, match$1._1 ]; @@ -60364,10 +61192,10 @@ function transl_type(env, policy, styp) { let fl; let exit$1 = 0; const row = match$2.desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { exit$1 = 1; } else { - switch (row.TAG | 0) { + switch (row.TAG) { case /* Tvar */0 : if (nm !== undefined) { throw new Caml_js_exceptions.MelangeError($$Error$6, { @@ -60410,7 +61238,7 @@ function transl_type(env, policy, styp) { const l = param[0]; let f$1; if (present !== undefined && !Stdlib__List.mem(l, present)) { - if (typeof f === "number") { + if (/* tag */typeof f === "number" || typeof f === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -60549,7 +61377,7 @@ function transl_type(env, policy, styp) { return tyl; } const name = v.desc; - if (typeof name !== "number" && name.TAG === /* Tvar */0 && v.level === 100000000) { + if (!/* tag */(typeof name === "number" || typeof name === "string") && name.TAG === /* Tvar */0 && v.level === 100000000) { v.desc = { TAG: /* Tunivar */9, _0: name._0 @@ -60635,41 +61463,43 @@ function transl_poly_type(env, policy, t) { } function transl_fields(loc, env, policy, seen, o, param) { - if (!param) { - if (o) { - if (policy >= 2) { - return new_pre_univar(undefined, undefined); - } else { - return newvar(validate_name(undefined), undefined); - } - } else { - return newty2(current_level.contents, /* Tnil */0); + if (param) { + const match = param.hd; + const s = match[0]; + if (Stdlib__List.mem(s, seen)) { + throw new Caml_js_exceptions.MelangeError($$Error$6, { + MEL_EXN_ID: $$Error$6, + _1: loc, + _2: env, + _3: { + TAG: /* Repeated_method_label */16, + _0: s + } + }); } + const ty2 = transl_fields(loc, env, policy, { + hd: s, + tl: seen + }, o, param.tl); + return newty2(current_level.contents, { + TAG: /* Tfield */5, + _0: s, + _1: /* Fpresent */0, + _2: match[2].ctyp_type, + _3: ty2 + }); } - const match = param.hd; - const s = match[0]; - if (Stdlib__List.mem(s, seen)) { - throw new Caml_js_exceptions.MelangeError($$Error$6, { - MEL_EXN_ID: $$Error$6, - _1: loc, - _2: env, - _3: { - TAG: /* Repeated_method_label */16, - _0: s - } - }); + if (o === /* Closed */0) { + return newty2(current_level.contents, /* Tnil */0); + } + switch (policy) { + case /* Fixed */0 : + case /* Extensible */1 : + return newvar(validate_name(undefined), undefined); + case /* Univars */2 : + return new_pre_univar(undefined, undefined); + } - const ty2 = transl_fields(loc, env, policy, { - hd: s, - tl: seen - }, o, param.tl); - return newty2(current_level.contents, { - TAG: /* Tfield */5, - _0: s, - _1: /* Fpresent */0, - _2: match[2].ctyp_type, - _3: ty2 - }); } function make_fixed_univars(ty) { @@ -60679,7 +61509,7 @@ function make_fixed_univars(ty) { } mark_type_node(ty$1); const row = ty$1.desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { return iter_type_expr(make_fixed_univars, ty$1); } if (row.TAG !== /* Tvariant */8) { @@ -60692,7 +61522,7 @@ function make_fixed_univars(ty) { _0: { row_fields: Stdlib__List.map((function (p) { const match = row_field_repr_aux(/* [] */0, p[1]); - if (typeof match === "number" || match.TAG === /* Rpresent */0) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG === /* Rpresent */0) { return p; } else { return [ @@ -60838,7 +61668,7 @@ function transl_simple_type_univars(env, styp) { const univs = Stdlib__List.fold_left((function (acc, v) { const v$1 = repr(v); const name = v$1.desc; - if (typeof name === "number" || !(name.TAG === /* Tvar */0 && v$1.level === 100000000)) { + if (/* tag */typeof name === "number" || typeof name === "string" || !(name.TAG === /* Tvar */0 && v$1.level === 100000000)) { return acc; } else { v$1.desc = { @@ -60932,7 +61762,8 @@ function spellcheck(ppf, fold, env, lid) { return ; } const rev_rest = match.tl; - Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: /* Force_newline */3, @@ -60961,7 +61792,8 @@ function spellcheck(ppf, fold, env, lid) { _1: "@\nHint: Did you mean %s%s%s?" }), Stdlib__String.concat(", ", Stdlib__List.rev(rev_rest)), Caml_obj.caml_equal(rev_rest, /* [] */0) ? "" : " or ", match.hd); }; - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: /* FFlush */2, @@ -60969,7 +61801,7 @@ function spellcheck(ppf, fold, env, lid) { }, _1: "@?" }); - switch (lid.TAG | 0) { + switch (lid.TAG) { case /* Lident */0 : const s = lid._0; return handle(Curry._4(fold, (function (param, param$1) { @@ -61016,9 +61848,10 @@ register_error_of_exn(function (err) { } const env = err._2; return error_of_printer(err._1, (function (param, param$1) { - if (typeof param$1 === "number") { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { if (param$1 === /* Recursive_type */0) { - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This type is recursive", @@ -61027,7 +61860,8 @@ register_error_of_exn(function (err) { _1: "This type is recursive" }); } else { - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Illegal recursive module reference", @@ -61037,9 +61871,10 @@ register_error_of_exn(function (err) { }); } } - switch (param$1.TAG | 0) { + switch (param$1.TAG) { case /* Unbound_type_variable */0 : - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unbound type parameter ", @@ -61057,7 +61892,8 @@ register_error_of_exn(function (err) { }), param$1._0); case /* Unbound_type_constructor */1 : const lid = param$1._0; - Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unbound type constructor ", @@ -61070,7 +61906,8 @@ register_error_of_exn(function (err) { }), longident, lid); return spellcheck$1(param, fold_types)(env, lid); case /* Unbound_type_constructor_2 */2 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The type constructor", @@ -61104,12 +61941,14 @@ register_error_of_exn(function (err) { _1: "The type constructor@ %a@ is not yet completely defined" }), path, param$1._0); case /* Type_arity_mismatch */3 : - return Curry._4(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -61176,7 +62015,8 @@ register_error_of_exn(function (err) { _1: "@[The type constructor %a@ expects %i argument(s),@ but is here applied to %i argument(s)@]" }), longident, param$1._0, param$1._1, param$1._2); case /* Bound_type_variable */4 : - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Already bound type parameter '", @@ -61189,7 +62029,8 @@ register_error_of_exn(function (err) { _1: "Already bound type parameter '%s" }), param$1._0); case /* Unbound_row_variable */5 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unbound row variable in #", @@ -61202,7 +62043,8 @@ register_error_of_exn(function (err) { }), longident, param$1._0); case /* Type_mismatch */6 : return report_unification_error(param, empty, undefined, param$1._0, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This type", @@ -61211,7 +62053,8 @@ register_error_of_exn(function (err) { _1: "This type" }); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "should be an instance of type", @@ -61222,7 +62065,8 @@ register_error_of_exn(function (err) { })); case /* Alias_type_mismatch */7 : return report_unification_error(param, empty, undefined, param$1._0, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This alias is bound to type", @@ -61231,7 +62075,8 @@ register_error_of_exn(function (err) { _1: "This alias is bound to type" }); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "but is used as an instance of type", @@ -61241,7 +62086,8 @@ register_error_of_exn(function (err) { }); })); case /* Present_has_conjunction */8 : - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The present constructor ", @@ -61258,7 +62104,8 @@ register_error_of_exn(function (err) { _1: "The present constructor %s has a conjunctive type" }), param$1._0); case /* Present_has_no_type */9 : - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The present constructor ", @@ -61285,12 +62132,14 @@ register_error_of_exn(function (err) { tl: /* [] */0 } }); - Curry._6(Stdlib__Format.fprintf(param)(/* Format */{ + Curry._6(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -61348,12 +62197,14 @@ register_error_of_exn(function (err) { const ty$1 = param$1._0; reset(undefined); mark_loops(ty$1); - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -61387,12 +62238,14 @@ register_error_of_exn(function (err) { _1: "@[The type %a@ is not a polymorphic variant type@]" }), type_expr$1, ty$1); case /* Variant_tags */12 : - return Curry._3(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -61448,7 +62301,8 @@ register_error_of_exn(function (err) { _1: "@[Variant tags `%s@ and `%s have the same hash value.@ %s@]" }), param$1._0, param$1._1, "Change one of them."); case /* Invalid_variable_name */13 : - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The type variable name ", @@ -61466,12 +62320,14 @@ register_error_of_exn(function (err) { }), param$1._0); case /* Cannot_quantify */14 : const v = param$1._1; - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -61520,7 +62376,8 @@ register_error_of_exn(function (err) { is_Tunivar(v) ? "it is already bound to another variable" : "it is not a variable" )); case /* Multiple_constraints_on_type */15 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Multiple constraints for type ", @@ -61532,12 +62389,14 @@ register_error_of_exn(function (err) { _1: "Multiple constraints for type %a" }), longident, param$1._0); case /* Repeated_method_label */16 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -61577,7 +62436,8 @@ register_error_of_exn(function (err) { }), param$1._0, "Multiple occurences are not allowed."); case /* Unbound_value */17 : const lid$1 = param$1._0; - Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unbound value ", @@ -61591,7 +62451,8 @@ register_error_of_exn(function (err) { return spellcheck$1(param, fold_values)(env, lid$1); case /* Unbound_constructor */18 : const lid$2 = param$1._0; - Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unbound constructor ", @@ -61607,7 +62468,8 @@ register_error_of_exn(function (err) { }))(env, lid$2); case /* Unbound_label */19 : const lid$3 = param$1._0; - Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unbound record field ", @@ -61623,7 +62485,8 @@ register_error_of_exn(function (err) { }))(env, lid$3); case /* Unbound_module */20 : const lid$4 = param$1._0; - Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unbound module ", @@ -61637,7 +62500,8 @@ register_error_of_exn(function (err) { return spellcheck$1(param, fold_modules)(env, lid$4); case /* Unbound_class */21 : const lid$5 = param$1._0; - Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unbound class ", @@ -61651,7 +62515,8 @@ register_error_of_exn(function (err) { return spellcheck$1(param, fold_classs)(env, lid$5); case /* Unbound_modtype */22 : const lid$6 = param$1._0; - Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unbound module type ", @@ -61665,7 +62530,8 @@ register_error_of_exn(function (err) { return spellcheck$1(param, fold_modtypes)(env, lid$6); case /* Unbound_cltype */23 : const lid$7 = param$1._0; - Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unbound class type ", @@ -61678,7 +62544,8 @@ register_error_of_exn(function (err) { }), longident, lid$7); return spellcheck$1(param, fold_cltypes)(env, lid$7); case /* Ill_typed_functor_application */24 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Ill-typed functor application ", @@ -61690,7 +62557,8 @@ register_error_of_exn(function (err) { _1: "Ill-typed functor application %a" }), longident, param$1._0); case /* Access_functor_as_structure */25 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The module ", @@ -61800,7 +62668,7 @@ function iter_expression(f, e) { const e = _e; Curry._1(f, e); const pel = e.pexp_desc; - switch (pel.TAG | 0) { + switch (pel.TAG) { case /* Pexp_let */2 : expr(pel._2); return Stdlib__List.iter(binding, pel._1); @@ -61889,7 +62757,7 @@ function iter_expression(f, e) { while(true) { const me = _me; const str = me.pmod_desc; - switch (str.TAG | 0) { + switch (str.TAG) { case /* Pmod_structure */1 : return Stdlib__List.iter(structure_item, str._0); case /* Pmod_functor */2 : @@ -61913,7 +62781,7 @@ function iter_expression(f, e) { }; const structure_item = function (str) { const l = str.pstr_desc; - switch (l.TAG | 0) { + switch (l.TAG) { case /* Pstr_eval */0 : return expr(l._0); case /* Pstr_value */1 : @@ -61938,7 +62806,7 @@ function iter_expression(f, e) { while(true) { const ce = _ce; const match = ce.pcl_desc; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Pcl_structure */1 : return Stdlib__List.iter(class_field, match._0.pcstr_fields); case /* Pcl_fun */2 : @@ -61966,7 +62834,7 @@ function iter_expression(f, e) { }; const class_field = function (cf) { const e = cf.pcf_desc; - switch (e.TAG | 0) { + switch (e.TAG) { case /* Pcf_inherit */0 : return class_expr(e._1); case /* Pcf_val */1 : @@ -62003,7 +62871,7 @@ function all_idents_cases(el) { return ; } const id = match._0.txt; - switch (id.TAG | 0) { + switch (id.TAG) { case /* Lident */0 : return Stdlib__Hashtbl.replace(idents, id._0, undefined); case /* Ldot */1 : @@ -62027,7 +62895,7 @@ function all_idents_cases(el) { } function type_constant(param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Const_int */0 : return instance_def(type_int); case /* Const_char */1 : @@ -62111,7 +62979,7 @@ function option_some(texp) { function extract_option_type(env, ty) { const match = expand_head(env, ty); const match$1 = match.desc; - if (typeof match$1 !== "number" && match$1.TAG === /* Tconstr */3) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string") && match$1.TAG === /* Tconstr */3) { const match$2 = match$1._1; if (match$2 && !match$2.tl && same(match$1._0, path_option)) { return match$2.hd; @@ -62131,7 +62999,7 @@ function extract_option_type(env, ty) { function extract_concrete_record(env, ty) { const match = extract_concrete_typedecl(env, ty); const match$1 = match[2].type_kind; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { MEL_EXN_ID: Stdlib.Not_found }); @@ -62153,7 +63021,7 @@ function extract_concrete_variant(env, ty) { const cstrs = match[2].type_kind; const p = match[1]; const p0 = match[0]; - if (typeof cstrs === "number") { + if (/* tag */typeof cstrs === "number" || typeof cstrs === "string") { if (cstrs !== /* Type_abstract */0) { return [ p0, @@ -62382,7 +63250,7 @@ function unify_pat(env, pat, expected_ty) { function finalize_variant(pat) { const match = pat.pat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return ; } if (match.TAG !== /* Tpat_variant */5) { @@ -62392,7 +63260,7 @@ function finalize_variant(pat) { const match$1 = expand_head(pat.pat_env, pat.pat_type); const row = match$1.desc; let row$1; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -62417,7 +63285,7 @@ function finalize_variant(pat) { }); } const match$2 = row_field(match._0, row$1); - if (typeof match$2 === "number") { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string") { return ; } if (match$2.TAG === /* Rpresent */0) { @@ -62485,7 +63353,7 @@ function has_variants(p) { try { iter_pattern((function (param) { let tmp = param.pat_desc; - if (typeof tmp === "number") { + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { return ; } if (tmp.TAG !== /* Tpat_variant */5) { @@ -62686,10 +63554,10 @@ function build_as_type(env, _p) { while(true) { const p = _p; const pl = p.pat_desc; - if (typeof pl === "number") { + if (/* tag */typeof pl === "number" || typeof pl === "string") { return p.pat_type; } - switch (pl.TAG | 0) { + switch (pl.TAG) { case /* Tpat_alias */1 : _p = pl._0; continue ; @@ -62782,7 +63650,7 @@ function build_as_type(env, _p) { if (Stdlib__List.mem_assoc(lbl.lbl_pos, ppl)) { const match$1 = repr(lbl.lbl_arg).desc; let tmp$1; - tmp$1 = typeof match$1 === "number" || match$1.TAG !== /* Tpoly */10 ? true : false; + tmp$1 = /* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Tpoly */10 ? true : false; tmp = tmp$1; } refinable = tmp; @@ -62856,7 +63724,7 @@ function build_or_pat(env, loc, lid) { const row = ty.desc; let row0; let exit = 0; - if (typeof row === "number" || row.TAG !== /* Tvariant */8) { + if (/* tag */typeof row === "number" || typeof row === "string" || row.TAG !== /* Tvariant */8) { exit = 1; } else { const row$1 = row._0; @@ -62882,7 +63750,7 @@ function build_or_pat(env, loc, lid) { const fields = param[1]; const pats = param[0]; const match = row_field_repr_aux(/* [] */0, param$1[1]); - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return [ pats, fields @@ -63070,7 +63938,7 @@ function expand_path(env, _p) { if (ty !== undefined) { const match = repr(ty); const match$1 = match.desc; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { return p; } if (match$1.TAG !== /* Tconstr */3) { @@ -63102,7 +63970,7 @@ function wrap_disambiguate(kind, ty, f, x) { const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); if (exn.MEL_EXN_ID === $$Error$7) { const match = exn._3; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } if (match.TAG === /* Wrong_name */13) { @@ -63131,7 +63999,7 @@ const type_kind = "record"; function get_type_path$1(env, d) { const match = d.lbl_res.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -63158,7 +64026,7 @@ function lookup_from_type(env, tpath, lid) { const descrs = find_type_full(tpath, env)[1][1]; mark_type_used(env, last(tpath), find_type_full(tpath, env)[0]); const s = lid.txt; - switch (s.TAG | 0) { + switch (s.TAG) { case /* Lident */0 : const s$1 = s._0; try { @@ -63437,10 +64305,10 @@ function disambiguate_lid_a_list(loc, closed, env, opath, lid_a_list) { contents: "" }; const warn = function (loc, msg) { - if (typeof msg === "number") { + if (/* tag */typeof msg === "number" || typeof msg === "string") { return prerr_warning(loc, msg); } - switch (msg.TAG | 0) { + switch (msg.TAG) { case /* Not_principal */8 : w_pr.contents = true; return ; @@ -63564,7 +64432,7 @@ function find_record_qual(_param) { return ; } const match = param.hd[0].txt; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Ldot */1 : return match._0; case /* Lident */0 : @@ -63581,7 +64449,7 @@ function type_label_a_list(labels, loc, closed, env, type_lbl_a, opath, lid_a_li let exit = 0; if (lid_a_list) { const s = lid_a_list.hd[0].txt; - switch (s.TAG | 0) { + switch (s.TAG) { case /* Lident */0 : if (labels !== undefined) { const labels$1 = Caml_option.valFromOption(labels); @@ -63589,7 +64457,7 @@ function type_label_a_list(labels, loc, closed, env, type_lbl_a, opath, lid_a_li lbl_a_list = Stdlib__List.map((function (param) { const lid = param[0]; const s = lid.txt; - switch (s.TAG | 0) { + switch (s.TAG) { case /* Lident */0 : return [ lid, @@ -63630,7 +64498,7 @@ function type_label_a_list(labels, loc, closed, env, type_lbl_a, opath, lid_a_li const lid_a_list$1 = modname !== undefined ? Stdlib__List.map((function (lid_a) { const lid = lid_a[0]; const s = lid.txt; - switch (s.TAG | 0) { + switch (s.TAG) { case /* Lident */0 : return [ { @@ -63709,7 +64577,7 @@ const type_kind$1 = "variant"; function get_type_path$2(env, d) { const match = d.cstr_res.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -63736,7 +64604,7 @@ function lookup_from_type$1(env, tpath, lid) { const descrs = find_type_full(tpath, env)[1][0]; mark_type_used(env, last(tpath), find_type_full(tpath, env)[0]); const s = lid.txt; - switch (s.TAG | 0) { + switch (s.TAG) { case /* Lident */0 : const s$1 = s._0; try { @@ -63964,7 +64832,7 @@ function unify_head_only(loc, env, ty, constr) { const match = instance_constructor(undefined, constr); const ty_res = match[1]; const match$1 = repr(ty_res).desc; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -64006,7 +64874,7 @@ function type_pat(constrs, labels, no_existentials, mode, env, sp, expected_ty) }; const loc = sp.ppat_loc; const name = sp.ppat_desc; - if (typeof name === "number") { + if (/* tag */typeof name === "number" || typeof name === "string") { return rp({ pat_desc: /* Tpat_any */0, pat_loc: loc, @@ -64016,7 +64884,7 @@ function type_pat(constrs, labels, no_existentials, mode, env, sp, expected_ty) pat_attributes: sp.ppat_attributes }); } - switch (name.TAG | 0) { + switch (name.TAG) { case /* Ppat_var */0 : const name$1 = name._0; const id = enter_variable(undefined, undefined, loc, name$1, expected_ty); @@ -64175,7 +65043,7 @@ function type_pat(constrs, labels, no_existentials, mode, env, sp, expected_ty) const match$1 = lid.txt; let constrs$1; let exit = 0; - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Lident */0 : if (constrs !== undefined) { const constrs$2 = Caml_option.valFromOption(constrs); @@ -64242,7 +65110,7 @@ function type_pat(constrs, labels, no_existentials, mode, env, sp, expected_ty) let sargs; if (sarg !== undefined) { const spl$1 = sarg.ppat_desc; - if (typeof spl$1 === "number") { + if (/* tag */typeof spl$1 === "number" || typeof spl$1 === "string") { if (constr.cstr_arity !== 1) { if (constr.cstr_arity === 0) { prerr_warning(sarg.ppat_loc, /* Wildcard_arg_to_constant_constr */13); @@ -64521,12 +65389,12 @@ function type_pat(constrs, labels, no_existentials, mode, env, sp, expected_ty) const sp$1 = name._0; let exit$1 = 0; const name$3 = sp$1.ppat_desc; - if (typeof name$3 === "number" || name$3.TAG !== /* Ppat_var */0) { + if (/* tag */typeof name$3 === "number" || typeof name$3 === "string" || name$3.TAG !== /* Ppat_var */0) { exit$1 = 1; } else { const sty = name._1; let tmp = sty.ptyp_desc; - if (typeof tmp === "number" || tmp.TAG !== /* Ptyp_poly */8) { + if (/* tag */typeof tmp === "number" || typeof tmp === "string" || tmp.TAG !== /* Ptyp_poly */8) { exit$1 = 1; } else { const lloc = sp$1.ppat_loc; @@ -64540,7 +65408,7 @@ function type_pat(constrs, labels, no_existentials, mode, env, sp, expected_ty) tl: pattern_force.contents }; const match$6 = ty$1.desc; - if (typeof match$6 === "number") { + if (/* tag */typeof match$6 === "number" || typeof match$6 === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -64619,7 +65487,7 @@ function type_pat(constrs, labels, no_existentials, mode, env, sp, expected_ty) ]; const match$9 = p$2.pat_desc; let exit$2 = 0; - if (typeof match$9 === "number") { + if (/* tag */typeof match$9 === "number" || typeof match$9 === "string") { exit$2 = 2; } else { if (match$9.TAG === /* Tpat_var */0) { @@ -64783,12 +65651,12 @@ function check_partial$1(levOpt, env, expected_ty) { return partial_pred(lev, env, expected_ty, param, param$1, param$2); }; const first_check = check_partial(param, param$1); - if (first_check) { + if (first_check === /* Partial */0) { + return /* Partial */0; + } else { return check_partial_param((function (param, param$1, param$2) { return do_check_partial(pred, exhaust_gadt$1, param, param$1, param$2); }), do_check_fragile_gadt, param, param$1); - } else { - return /* Partial */0; } }; } @@ -65042,7 +65910,7 @@ function final_subexpression(_sexp) { while(true) { const sexp = _sexp; const match = sexp.pexp_desc; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Pexp_let */2 : _sexp = match._2; continue ; @@ -65070,7 +65938,7 @@ function is_nonexpansive(_exp) { while(true) { const exp = _exp; const el = exp.exp_desc; - switch (el.TAG | 0) { + switch (el.TAG) { case /* Texp_let */2 : if (!Stdlib__List.for_all((function (vb) { return is_nonexpansive(vb.vb_expr); @@ -65150,7 +66018,7 @@ function is_nonexpansive(_exp) { }; if (Stdlib__List.for_all((function (field) { const e = field.cf_desc; - switch (e.TAG | 0) { + switch (e.TAG) { case /* Tcf_inherit */0 : return false; case /* Tcf_val */1 : @@ -65186,11 +66054,11 @@ function is_nonexpansive_mod(_mexp) { while(true) { const mexp = _mexp; const str = mexp.mod_desc; - switch (str.TAG | 0) { + switch (str.TAG) { case /* Tmod_structure */1 : return Stdlib__List.for_all((function (item) { const id_mod_list = item.str_desc; - switch (id_mod_list.TAG | 0) { + switch (id_mod_list.TAG) { case /* Tstr_value */1 : return Stdlib__List.for_all((function (vb) { return is_nonexpansive(vb.vb_expr); @@ -65252,10 +66120,10 @@ function approx_type(env, _sty) { while(true) { const sty = _sty; const args = sty.ptyp_desc; - if (typeof args === "number") { + if (/* tag */typeof args === "number" || typeof args === "string") { return newvar(undefined, undefined); } - switch (args.TAG | 0) { + switch (args.TAG) { case /* Ptyp_arrow */1 : const p = args._0; const ty1 = is_optional(p) ? type_option$1(newvar(undefined, undefined)) : newvar(undefined, undefined); @@ -65310,7 +66178,7 @@ function type_approx(env, _sexp) { while(true) { const sexp = _sexp; const l = sexp.pexp_desc; - switch (l.TAG | 0) { + switch (l.TAG) { case /* Pexp_let */2 : _sexp = l._2; continue ; @@ -65450,7 +66318,7 @@ function list_labels(env, ty) { ]; } const match = ty.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return [ Stdlib__List.rev(ls), is_Tvar(ty) @@ -65492,7 +66360,7 @@ function check_univars(env, expans, kind, exp, ty_expected, vars) { contents: /* [] */0 }, t$1); const name = t$1.desc; - if (typeof name === "number" || !(name.TAG === /* Tvar */0 && t$1.level === 100000000)) { + if (/* tag */typeof name === "number" || typeof name === "string" || !(name.TAG === /* Tvar */0 && t$1.level === 100000000)) { return false; } else { log_type(t$1); @@ -65539,8 +66407,8 @@ function check_univars(env, expans, kind, exp, ty_expected, vars) { function check_application_result(env, statement, exp) { const loc = exp.exp_loc; const match = expand_head(env, exp.exp_type).desc; - if (typeof match !== "number") { - switch (match.TAG | 0) { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + switch (match.TAG) { case /* Tvar */0 : return ; case /* Tarrow */1 : @@ -65614,7 +66482,7 @@ function contains_variant_either(ty) { } mark_type_node(ty$1); const row = ty$1.desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { return iter_type_expr(loop, ty$1); } if (row.TAG !== /* Tvariant */8) { @@ -65624,7 +66492,7 @@ function contains_variant_either(ty) { if (!row$1.row_fixed) { Stdlib__List.iter((function (param) { const match = row_field_repr_aux(/* [] */0, param[1]); - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return ; } if (match.TAG === /* Rpresent */0) { @@ -65654,10 +66522,10 @@ function contains_variant_either(ty) { function iter_ppat(f, p) { const pats = p.ppat_desc; - if (typeof pats === "number") { + if (/* tag */typeof pats === "number" || typeof pats === "string") { return ; } - switch (pats.TAG | 0) { + switch (pats.TAG) { case /* Ppat_construct */5 : case /* Ppat_variant */6 : return may(f, pats._1); @@ -65684,10 +66552,10 @@ function iter_ppat(f, p) { function contains_polymorphic_variant(p) { const loop = function (p) { const match = p.ppat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return iter_ppat(loop, p); } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Ppat_variant */6 : case /* Ppat_type */11 : throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { @@ -65713,7 +66581,7 @@ function contains_polymorphic_variant(p) { function contains_gadt(env, p) { const loop = function (p) { const match = p.ppat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return iter_ppat(loop, p); } if (match.TAG !== /* Ppat_construct */5) { @@ -65756,7 +66624,7 @@ function check_absent_variant(env) { return function (param) { return iter_pattern((function (pat) { const match = pat.pat_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return ; } if (match.TAG !== /* Tpat_variant */5) { @@ -65830,7 +66698,7 @@ function duplicate_ident_types(loc, caselist, env) { }, env); const desc = match[1]; const path = match[0]; - switch (path.TAG | 0) { + switch (path.TAG) { case /* Pident */0 : const desc_val_type = type_expr(identity, desc.val_type); const desc_val_kind = desc.val_kind; @@ -65890,7 +66758,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { return exp; }; const lid = sexp.pexp_desc; - switch (lid.TAG | 0) { + switch (lid.TAG) { case /* Pexp_ident */0 : const lid$1 = lid._0; const match = find_value$1(env, loc, lid$1.txt); @@ -65912,7 +66780,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { } const match$1 = desc.val_kind; let tmp; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { if (match$1 === /* Val_unbound */1) { throw new Caml_js_exceptions.MelangeError($$Error$7, { MEL_EXN_ID: $$Error$7, @@ -65931,7 +66799,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { _2: desc }; } else { - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Val_ivar */1 : const match$2 = lookup_value$1({ TAG: /* Lident */0, @@ -65939,7 +66807,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { }, env); const txt = lid$1.txt; let tmp$1; - switch (txt.TAG | 0) { + switch (txt.TAG) { case /* Lident */0 : tmp$1 = { txt: txt._0, @@ -66026,7 +66894,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { }; const match$4 = ty_exp.desc; let is_format; - if (typeof match$4 === "number" || !(match$4.TAG === /* Tconstr */3 && same(match$4._0, fmt6_path))) { + if (/* tag */typeof match$4 === "number" || typeof match$4 === "string" || !(match$4.TAG === /* Tconstr */3 && same(match$4._0, fmt6_path))) { is_format = false; } else { if (principal.contents && ty_exp.level !== 100000000) { @@ -66063,9 +66931,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { case /* Pexp_let */2 : const rec_flag = lid._0; let exit = 0; - if (rec_flag) { - exit = 1; - } else { + if (rec_flag === /* Nonrecursive */0) { const match$5 = lid._1; if (match$5) { const match$6 = match$5.hd; @@ -66092,6 +66958,8 @@ function type_expect_(in_function, env, sexp, ty_expected) { } else { exit = 1; } + } else { + exit = 1; } if (exit === 1) { const sbody = lid._2; @@ -66104,12 +66972,12 @@ function type_expect_(in_function, env, sexp, ty_expected) { exit$1 = 2; } if (exit$1 === 2) { - scp = rec_flag ? ({ + scp = rec_flag === /* Nonrecursive */0 ? ({ TAG: /* Idef */1, - _0: loc + _0: sbody.pexp_loc }) : ({ TAG: /* Idef */1, - _0: sbody.pexp_loc + _0: loc }); } const match$8 = type_let(undefined, undefined, env, rec_flag, lid._1, scp, true); @@ -66248,7 +67116,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { return ; } const match = ty.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return ; } if (match.TAG !== /* Tarrow */1) { @@ -66319,7 +67187,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { } const c = param.hd; const p = c.pc_lhs.ppat_desc; - if (typeof p !== "number" && p.TAG === /* Ppat_exception */14) { + if (!/* tag */(typeof p === "number" || typeof p === "string") && p.TAG === /* Ppat_exception */14) { _param = param.tl; _ec = { hd: { @@ -66576,14 +67444,14 @@ function type_expect_(in_function, env, sexp, ty_expected) { const match$19 = expand_head(env, ty_expected0); if (sarg$1 !== undefined) { const row = match$18.desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { MEL_EXN_ID: Stdlib.Not_found }); } if (row.TAG === /* Tvariant */8) { const row0 = match$19.desc; - if (typeof row0 === "number") { + if (/* tag */typeof row0 === "number" || typeof row0 === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { MEL_EXN_ID: Stdlib.Not_found }); @@ -66592,7 +67460,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { const row$1 = row_repr_aux(/* [] */0, row._0); const match$20 = row_field_repr_aux(/* [] */0, Stdlib__List.assoc(l$1, row$1.row_fields)); const match$21 = row_field_repr_aux(/* [] */0, Stdlib__List.assoc(l$1, row0._0.row_fields)); - if (typeof match$20 === "number") { + if (/* tag */typeof match$20 === "number" || typeof match$20 === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { MEL_EXN_ID: Stdlib.Not_found }); @@ -66600,7 +67468,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { if (match$20.TAG === /* Rpresent */0) { const ty$1 = match$20._0; if (ty$1 !== undefined) { - if (typeof match$21 === "number") { + if (/* tag */typeof match$21 === "number" || typeof match$21 === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { MEL_EXN_ID: Stdlib.Not_found }); @@ -67056,7 +67924,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { const high = type_expect(undefined, env, lid._2, type_int); const match$27 = param.ppat_desc; let match$28; - if (typeof match$27 === "number") { + if (/* tag */typeof match$27 === "number" || typeof match$27 === "string") { match$28 = [ create("_for"), env @@ -67185,7 +68053,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { let exit$2 = 0; if (match$33.TAG === /* Texp_ident */0) { let tmp$2 = match$33._2.val_kind; - if (typeof tmp$2 === "number" || !(tmp$2.TAG === /* Val_self */2 && match$34 && !(typeof match$35 === "number" || match$35.TAG !== /* Tconstr */3))) { + if (/* tag */typeof tmp$2 === "number" || typeof tmp$2 === "string" || !(tmp$2.TAG === /* Val_self */2 && match$34 && !(/* tag */typeof match$35 === "number" || typeof match$35 === "string" || match$35.TAG !== /* Tconstr */3))) { exit$2 = 1; } else { const match$36 = match$34.hd; @@ -67324,10 +68192,10 @@ function type_expect_(in_function, env, sexp, ty_expected) { if (match$39.TAG === /* Texp_ident */0) { const match$41 = match$39._2.val_kind; const lid$5 = match$39._1; - if (typeof match$41 === "number") { + if (/* tag */typeof match$41 === "number" || typeof match$41 === "string") { exit$3 = 1; } else { - switch (match$41.TAG | 0) { + switch (match$41.TAG) { case /* Val_self */2 : const match$42 = filter_self_method(env, met, /* Private */0, match$41._0, match$41._3); const typ = match$42[1]; @@ -67377,7 +68245,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { }, env); const desc$3 = match$43[1]; const match$45 = desc$3.val_kind; - if (typeof match$45 === "number") { + if (/* tag */typeof match$45 === "number" || typeof match$45 === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -67491,7 +68359,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { const ty$6 = repr(typ$2); const match$48 = ty$6.desc; let typ$3; - if (typeof match$48 === "number") { + if (/* tag */typeof match$48 === "number" || typeof match$48 === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -67501,7 +68369,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { ] }); } - switch (match$48.TAG | 0) { + switch (match$48.TAG) { case /* Tvar */0 : const ty$p$3 = newvar(undefined, undefined); unify$2(env, instance_def(ty$6), newty2(current_level.contents, { @@ -67606,41 +68474,41 @@ function type_expect_(in_function, env, sexp, ty_expected) { const desc$4 = match$50[1]; const match$51 = desc$4.val_kind; let exit$4 = 0; - if (typeof match$51 === "number") { + if (/* tag */typeof match$51 === "number" || typeof match$51 === "string") { exit$4 = 1; } else { if (match$51.TAG === /* Val_ivar */1) { - if (match$51._0) { - const newval = type_expect(undefined, env, lid._1, instance(undefined, env, desc$4.val_type)); - const match$52 = lookup_value$1({ - TAG: /* Lident */0, - _0: "self-" + match$51._1 - }, env); - return rue({ - exp_desc: { - TAG: /* Texp_setinstvar */21, - _0: match$52[0], - _1: match$50[0], - _2: lab, - _3: newval - }, - exp_loc: loc, - exp_extra: /* [] */0, - exp_type: instance_def(type_unit), - exp_env: env, - exp_attributes: sexp.pexp_attributes - }); + if (match$51._0 === /* Immutable */0) { + throw new Caml_js_exceptions.MelangeError($$Error$7, { + MEL_EXN_ID: $$Error$7, + _1: loc, + _2: env, + _3: { + TAG: /* Instance_variable_not_mutable */22, + _0: true, + _1: lab.txt + } + }); } - throw new Caml_js_exceptions.MelangeError($$Error$7, { - MEL_EXN_ID: $$Error$7, - _1: loc, - _2: env, - _3: { - TAG: /* Instance_variable_not_mutable */22, - _0: true, - _1: lab.txt - } - }); + const newval = type_expect(undefined, env, lid._1, instance(undefined, env, desc$4.val_type)); + const match$52 = lookup_value$1({ + TAG: /* Lident */0, + _0: "self-" + match$51._1 + }, env); + return rue({ + exp_desc: { + TAG: /* Texp_setinstvar */21, + _0: match$52[0], + _1: match$50[0], + _2: lab, + _3: newval + }, + exp_loc: loc, + exp_extra: /* [] */0, + exp_type: instance_def(type_unit), + exp_env: env, + exp_attributes: sexp.pexp_attributes + }); } exit$4 = 1; } @@ -67723,7 +68591,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { } const match$54 = match$53[0][1]; const match$55 = match$54.val_kind; - if (typeof match$55 === "number") { + if (/* tag */typeof match$55 === "number" || typeof match$55 === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -67897,7 +68765,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { } const match$59 = expand_head(env, ty$11).desc; let exp$2; - if (typeof match$59 === "number") { + if (/* tag */typeof match$59 === "number" || typeof match$59 === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -67907,7 +68775,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { ] }); } - switch (match$59.TAG | 0) { + switch (match$59.TAG) { case /* Tvar */0 : const exp$3 = type_exp(env, sbody$1); const exp_exp_desc = exp$3.exp_desc; @@ -68041,14 +68909,14 @@ function type_expect_(in_function, env, sexp, ty_expected) { } Stdlib__Hashtbl.add(seen, t.id, undefined); const match = t.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return iter_type_expr(replace, t); } if (match.TAG !== /* Tconstr */3) { return iter_type_expr(replace, t); } const id$p = match._0; - switch (id$p.TAG | 0) { + switch (id$p.TAG) { case /* Pident */0 : if (id === id$p._0) { return link_type(t, ty$12); @@ -68086,7 +68954,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { const match$63 = expand_head(env, instance(undefined, env, ty_expected)); const match$64 = match$63.desc; let match$65; - if (typeof match$64 === "number") { + if (/* tag */typeof match$64 === "number" || typeof match$64 === "string") { throw new Caml_js_exceptions.MelangeError($$Error$7, { MEL_EXN_ID: $$Error$7, _1: loc, @@ -68097,7 +68965,7 @@ function type_expect_(in_function, env, sexp, ty_expected) { } }); } - switch (match$64.TAG | 0) { + switch (match$64.TAG) { case /* Tvar */0 : throw new Caml_js_exceptions.MelangeError($$Error$7, { MEL_EXN_ID: $$Error$7, @@ -68205,7 +69073,7 @@ function type_function(in_function, loc, attrs, env, ty_expected, l, caselist) { const ty = expand_head(env, ty_expected); let exit = 0; const match$2 = ty.desc; - if (typeof match$2 === "number") { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string") { exit = 1; } else { if (match$2.TAG === /* Tarrow */1) { @@ -68448,7 +69316,7 @@ function type_label_exp(create, env, loc, ty_expected, param) { const e = Caml_js_exceptions.internalToOCamlException(raw_e); if (e.MEL_EXN_ID === $$Error$7) { let tmp = e._3; - if (typeof tmp === "number") { + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } if (tmp.TAG === /* Less_general */31) { @@ -68489,7 +69357,7 @@ function type_argument(env, sarg, ty_expected$p, ty_expected) { while(true) { const sexp = _sexp; const match = sexp.pexp_desc; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Pexp_ifthenelse */15 : const e2 = match._2; if (e2 === undefined) { @@ -68521,7 +69389,7 @@ function type_argument(env, sarg, ty_expected$p, ty_expected) { }; const match = expand_head(env, ty_expected$p); const match$1 = match.desc; - if (typeof match$1 !== "number" && match$1.TAG === /* Tarrow */1 && match$1._0 === "") { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string") && match$1.TAG === /* Tarrow */1 && match$1._0 === "") { const ty_res = match$1._2; const lv = match.level; if (is_inferred(sarg)) { @@ -68538,8 +69406,8 @@ function type_argument(env, sarg, ty_expected$p, ty_expected) { const ty_fun = _ty_fun; const args = _args; const match = expand_head(env, ty_fun).desc; - if (typeof match !== "number") { - switch (match.TAG | 0) { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + switch (match.TAG) { case /* Tvar */0 : return [ Stdlib__List.rev(args), @@ -68810,7 +69678,7 @@ function type_application(env, funct, sargs) { const match$1 = expand_head(env, ty_fun0); let exit = 0; const match$2 = match.desc; - if (typeof match$2 === "number" || match$2.TAG !== /* Tarrow */1) { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string" || match$2.TAG !== /* Tarrow */1) { exit = 1; } else { const ty_fun$1 = match$2._2; @@ -68818,7 +69686,7 @@ function type_application(env, funct, sargs) { const l = match$2._0; const lv = match.level; const match$3 = match$1.desc; - if (typeof match$3 === "number" || match$3.TAG !== /* Tarrow */1) { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string" || match$3.TAG !== /* Tarrow */1) { exit = 1; } else { const ty0 = match$3._1; @@ -69058,10 +69926,10 @@ function type_application(env, funct, sargs) { const td = ty_fun$3.desc; let match$12; let exit$2 = 0; - if (typeof td === "number") { + if (/* tag */typeof td === "number" || typeof td === "string") { exit$2 = 1; } else { - switch (td.TAG | 0) { + switch (td.TAG) { case /* Tvar */0 : const t1 = newvar(undefined, undefined); const t2 = newvar(undefined, undefined); @@ -69070,7 +69938,7 @@ function type_application(env, funct, sargs) { return true; } const match = param._2.val_kind; - if (typeof match === "number" || !(match.TAG === /* Val_prim */0 && match._0.prim_name === "%identity")) { + if (/* tag */typeof match === "number" || typeof match === "string" || !(match.TAG === /* Val_prim */0 && match._0.prim_name === "%identity")) { return true; } else { return false; @@ -69084,7 +69952,8 @@ function type_application(env, funct, sargs) { _0: l1, _1: t1, _2: t2, - _3: /* Clink */{ + _3: { + TAG: /* Clink */0, _0: { contents: /* Cunknown */1 } @@ -69112,11 +69981,11 @@ function type_application(env, funct, sargs) { } if (exit$2 === 1) { let ty_fun$4; - ty_fun$4 = typeof td === "number" || td.TAG !== /* Tarrow */1 ? ty_fun$3 : newty2(current_level.contents, td); + ty_fun$4 = /* tag */typeof td === "number" || typeof td === "string" || td.TAG !== /* Tarrow */1 ? ty_fun$3 : newty2(current_level.contents, td); const ty_res = result_type(Stdlib.$at(omitted, ignored.contents), ty_fun$4); const match$13 = ty_res.desc; let exit$3 = 0; - if (typeof match$13 === "number") { + if (/* tag */typeof match$13 === "number" || typeof match$13 === "string") { exit$3 = 2; } else { if (match$13.TAG === /* Tarrow */1) { @@ -69184,14 +70053,14 @@ function type_application(env, funct, sargs) { const match$1 = funct.exp_desc; if (match$1.TAG === /* Texp_ident */0) { const match$2 = match$1._2.val_kind; - if (typeof match$2 !== "number" && match$2.TAG === /* Val_prim */0 && match$2._0.prim_name === "%ignore" && sargs) { + if (!/* tag */(typeof match$2 === "number" || typeof match$2 === "string") && match$2.TAG === /* Val_prim */0 && match$2._0.prim_name === "%ignore" && sargs) { const match$3 = sargs.hd; if (match$3[0] === "" && !sargs.tl) { const match$4 = filter_arrow(env, instance(undefined, env, funct.exp_type), ""); const exp = type_expect(undefined, env, match$3[1], match$4[0]); const match$5 = expand_head(env, exp.exp_type).desc; - if (typeof match$5 !== "number") { - switch (match$5.TAG | 0) { + if (!/* tag */(typeof match$5 === "number" || typeof match$5 === "string")) { + switch (match$5.TAG) { case /* Tvar */0 : add_delayed_check(function (param) { check_application_result(env, false, exp); @@ -69241,10 +70110,10 @@ function type_statement(env, sexp) { const ty = expand_head(env, exp.exp_type); const tv = newvar(undefined, undefined); const match = ty.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { prerr_warning(loc, /* Statement_type */4); } else { - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tvar */0 : if (ty.level > tv.level) { prerr_warning(loc, /* Nonreturning_statement */10); @@ -69458,8 +70327,8 @@ function type_cases(in_function, env, ty_arg, ty_res, partial_flag, loc, caselis ors: /* [] */0, active: qs }); - if (typeof r === "number") { - if (r) { + if (/* tag */typeof r === "number" || typeof r === "string") { + if (r !== /* Used */0) { prerr_warning(q.pat_loc, /* Unused_match */5); } @@ -69538,7 +70407,7 @@ function type_let(checkOpt, check_strictOpt, env, rec_flag, spat_sexp_list, scop const match$1 = match._0.pexp_desc; if (match$1.TAG === /* Pexp_ident */0) { const match$2 = match$1._0.txt; - switch (match$2.TAG | 0) { + switch (match$2.TAG) { case /* Lident */0 : is_fake_let = match$2._0 === "*opt*" && !spat_sexp_list.tl ? true : false; break; @@ -69563,13 +70432,13 @@ function type_let(checkOpt, check_strictOpt, env, rec_flag, spat_sexp_list, scop const match = spat.ppat_desc; const match$1 = param.pvb_expr.pexp_desc; let sty; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return spat; } if (match.TAG === /* Ppat_constraint */10) { return spat; } - switch (match$1.TAG | 0) { + switch (match$1.TAG) { case /* Pexp_constraint */19 : sty = match$1._1; break; @@ -69601,7 +70470,7 @@ function type_let(checkOpt, check_strictOpt, env, rec_flag, spat_sexp_list, scop Stdlib__List.iter2((function (pat, binding) { const match = pat.pat_type.desc; let pat$1; - pat$1 = typeof match === "number" || match.TAG !== /* Tpoly */10 ? pat : ({ + pat$1 = /* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tpoly */10 ? pat : ({ pat_desc: pat.pat_desc, pat_loc: pat.pat_loc, pat_extra: pat.pat_extra, @@ -69729,7 +70598,7 @@ function type_let(checkOpt, check_strictOpt, env, rec_flag, spat_sexp_list, scop current_slot.contents = param$1[1]; } const match = pat.pat_type.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return type_expect(undefined, exp_env, sexp$1, pat.pat_type); } if (match.TAG !== /* Tpoly */10) { @@ -69868,10 +70737,11 @@ register_error_of_exn(function (err) { const env = err._2; return error_of_printer(err._1, (function (param, param$1) { return wrap_printing_env(env, (function (param$2) { - if (typeof param$1 === "number") { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { switch (param$1) { case /* Outside_class */0 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This object duplication occurs outside a method definition", @@ -69880,7 +70750,8 @@ register_error_of_exn(function (err) { _1: "This object duplication occurs outside a method definition" }); case /* Incoherent_label_order */1 : - Stdlib__Format.fprintf(param)(/* Format */{ + Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This function is applied to arguments", @@ -69897,7 +70768,8 @@ register_error_of_exn(function (err) { }, _1: "This function is applied to arguments@ " }); - Stdlib__Format.fprintf(param)(/* Format */{ + Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "in an order different from other calls.", @@ -69914,7 +70786,8 @@ register_error_of_exn(function (err) { }, _1: "in an order different from other calls.@ " }); - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This is only allowed when the real type is known.", @@ -69923,7 +70796,8 @@ register_error_of_exn(function (err) { _1: "This is only allowed when the real type is known." }); case /* Modules_not_allowed */2 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Modules are not allowed in this pattern.", @@ -69932,7 +70806,8 @@ register_error_of_exn(function (err) { _1: "Modules are not allowed in this pattern." }); case /* Cannot_infer_signature */3 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The signature for this packaged module couldn't be inferred.", @@ -69941,7 +70816,8 @@ register_error_of_exn(function (err) { _1: "The signature for this packaged module couldn't be inferred." }); case /* Unexpected_existential */4 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unexpected existential", @@ -69950,12 +70826,14 @@ register_error_of_exn(function (err) { _1: "Unexpected existential" }); case /* Invalid_interval */5 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -69973,12 +70851,14 @@ register_error_of_exn(function (err) { _1: "@[Only character intervals are supported in patterns.@]" }); case /* Invalid_for_loop_index */6 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -69996,7 +70876,8 @@ register_error_of_exn(function (err) { _1: "@[Invalid for-loop index: only variables and _ are allowed.@]" }); case /* No_value_clauses */7 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "None of the patterns in this 'match' expression match values.", @@ -70005,12 +70886,14 @@ register_error_of_exn(function (err) { _1: "None of the patterns in this 'match' expression match values." }); case /* Exception_pattern_below_toplevel */8 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -70030,14 +70913,16 @@ register_error_of_exn(function (err) { } } else { - switch (param$1.TAG | 0) { + switch (param$1.TAG) { case /* Polymorphic_label */0 : - return Curry._3(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -70075,12 +70960,14 @@ register_error_of_exn(function (err) { _1: "@[The record field %a is polymorphic.@ %s@]" }), longident, param$1._0, "You cannot instantiate it in a pattern."); case /* Constructor_arity_mismatch */1 : - return Curry._4(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -70149,7 +71036,8 @@ register_error_of_exn(function (err) { case /* Label_mismatch */2 : const lid = param$1._0; return report_unification_error(param, env, undefined, param$1._1, (function (ppf) { - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The record field ", @@ -70174,7 +71062,8 @@ register_error_of_exn(function (err) { _1: "The record field %a@ belongs to the type" }), longident, lid); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "but is mixed here with fields of type", @@ -70185,7 +71074,8 @@ register_error_of_exn(function (err) { })); case /* Pattern_type_clash */3 : return report_unification_error(param, env, undefined, param$1._0, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This pattern matches values of type", @@ -70194,7 +71084,8 @@ register_error_of_exn(function (err) { _1: "This pattern matches values of type" }); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "but a pattern was expected which matches values of type", @@ -70206,7 +71097,8 @@ register_error_of_exn(function (err) { case /* Or_pattern_type_clash */4 : const id = param$1._0; return report_unification_error(param, env, undefined, param$1._1, (function (ppf) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The variable ", @@ -70223,7 +71115,8 @@ register_error_of_exn(function (err) { _1: "The variable %s on the left-hand side of this or-pattern has type" }), id.name); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "but on the right-hand side it has type", @@ -70233,7 +71126,8 @@ register_error_of_exn(function (err) { }); })); case /* Multiply_bound_variable */5 : - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Variable ", @@ -70250,7 +71144,8 @@ register_error_of_exn(function (err) { _1: "Variable %s is bound several times in this matching" }), param$1._0); case /* Orpat_vars */6 : - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Variable ", @@ -70268,7 +71163,8 @@ register_error_of_exn(function (err) { }), param$1._0.name); case /* Expr_type_clash */7 : return report_unification_error(param, env, undefined, param$1._0, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This expression has type", @@ -70277,7 +71173,8 @@ register_error_of_exn(function (err) { _1: "This expression has type" }); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "but an expression was expected of type", @@ -70291,13 +71188,15 @@ register_error_of_exn(function (err) { reset(undefined); mark_loops(typ); const match = repr(typ).desc; - if (typeof match !== "number" && match.TAG === /* Tarrow */1) { - Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + if (!/* tag */(typeof match === "number" || typeof match === "string") && match.TAG === /* Tarrow */1) { + Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -70310,7 +71209,8 @@ register_error_of_exn(function (err) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -70344,7 +71244,8 @@ register_error_of_exn(function (err) { }, _1: "@[@[<2>This function has type@ %a@]" }), type_expr$1, typ); - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -70357,7 +71258,8 @@ register_error_of_exn(function (err) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -70393,12 +71295,14 @@ register_error_of_exn(function (err) { _1: "@ @[It is applied to too many arguments;@ %s@]@]" }), "maybe you forgot a `;'."); } - return Curry._3(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -70411,7 +71315,8 @@ register_error_of_exn(function (err) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -70466,7 +71371,8 @@ register_error_of_exn(function (err) { const ty = param$1._1; const print_label = function (ppf, l) { if (l === "") { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "without label", @@ -70475,7 +71381,8 @@ register_error_of_exn(function (err) { _1: "without label" }); } else { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "with label ", @@ -70491,12 +71398,14 @@ register_error_of_exn(function (err) { }; reset(undefined); mark_loops(ty); - return Curry._4(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -70509,7 +71418,8 @@ register_error_of_exn(function (err) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -70559,7 +71469,8 @@ register_error_of_exn(function (err) { _1: "@[@[<2>The function applied to this argument has type@ %a@]@.This argument cannot be applied %a@]" }), type_expr$1, ty, print_label, param$1._0); case /* Label_multiply_defined */10 : - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The record field label ", @@ -70579,7 +71490,8 @@ register_error_of_exn(function (err) { const print_labels = function (ppf) { return function (param) { return Stdlib__List.iter((function (lbl) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -70599,12 +71511,14 @@ register_error_of_exn(function (err) { }), param); }; }; - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -70629,7 +71543,8 @@ register_error_of_exn(function (err) { _1: "@[Some record fields are undefined:%a@]" }), print_labels, param$1._0); case /* Label_not_mutable */12 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The record field ", @@ -70651,12 +71566,14 @@ register_error_of_exn(function (err) { const ty$1 = param$1._1; reset(undefined); mark_loops(ty$1); - Curry._3(Stdlib__Format.fprintf(param)(/* Format */{ + Curry._3(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -70665,7 +71582,8 @@ register_error_of_exn(function (err) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -70712,7 +71630,8 @@ register_error_of_exn(function (err) { }, _1: "@[@[<2>%s type@ %a@]@ " }), param$1._0, type_expr$1, ty$1); - Curry._5(Stdlib__Format.fprintf(param)(/* Format */{ + Curry._5(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The ", @@ -70766,7 +71685,8 @@ register_error_of_exn(function (err) { let param$3 = param$1._2; let tpl = param$1._3; const txt1 = function (ppf) { - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The ", @@ -70808,7 +71728,8 @@ register_error_of_exn(function (err) { }), name, longident, lid$2, kind$1); }; const txt2 = function (ppf) { - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The ", @@ -70850,7 +71771,8 @@ register_error_of_exn(function (err) { }), name, longident, lid$2, kind$1); }; const txt3 = function (ppf) { - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "but a ", @@ -70885,12 +71807,14 @@ register_error_of_exn(function (err) { }), tpl); if (tpl) { if (tpl.tl) { - return Curry._6(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._6(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -70909,7 +71833,8 @@ register_error_of_exn(function (err) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -70965,12 +71890,14 @@ register_error_of_exn(function (err) { } const match = tpl.hd; const tp = match[0]; - return Curry._6(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._6(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -71037,7 +71964,8 @@ register_error_of_exn(function (err) { }); })); case /* Invalid_format */15 : - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -71049,12 +71977,14 @@ register_error_of_exn(function (err) { const ty$2 = param$1._0; reset(undefined); mark_loops(ty$2); - return Curry._3(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -71067,7 +71997,8 @@ register_error_of_exn(function (err) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -71119,7 +72050,8 @@ register_error_of_exn(function (err) { _1: "@[@[This expression has type@;<1 2>%a@]@,It has no method %s@]" }), type_expr$1, ty$2, param$1._1); case /* Undefined_inherited_method */17 : - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This expression has no method ", @@ -71132,7 +72064,8 @@ register_error_of_exn(function (err) { _1: "This expression has no method %s" }), param$1._0); case /* Virtual_class */18 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Cannot instantiate the virtual class ", @@ -71144,7 +72077,8 @@ register_error_of_exn(function (err) { _1: "Cannot instantiate the virtual class %a" }), longident, param$1._0); case /* Private_type */19 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Cannot create values of the private type ", @@ -71156,7 +72090,8 @@ register_error_of_exn(function (err) { _1: "Cannot create values of the private type %a" }), type_expr$1, param$1._0); case /* Private_label */20 : - return Curry._4(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Cannot assign field ", @@ -71175,7 +72110,8 @@ register_error_of_exn(function (err) { _1: "Cannot assign field %a of the private type %a" }), longident, param$1._0, type_expr$1, param$1._1); case /* Unbound_instance_variable */21 : - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unbound instance variable ", @@ -71190,7 +72126,8 @@ register_error_of_exn(function (err) { case /* Instance_variable_not_mutable */22 : const v = param$1._1; if (param$1._0) { - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The instance variable ", @@ -71207,7 +72144,8 @@ register_error_of_exn(function (err) { _1: "The instance variable %s is not mutable" }), v); } else { - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The value ", @@ -71233,12 +72171,14 @@ register_error_of_exn(function (err) { const tr1$1 = Stdlib__List.map(prepare_expansion, tr1); const tr2$1 = Stdlib__List.map(prepare_expansion, tr2); const partial_arg = Caml_obj.caml_equal(tr2$1, /* [] */0); - Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -71257,7 +72197,8 @@ register_error_of_exn(function (err) { return trace$1(true, partial_arg, txt1$1, param, param$1); }), tr1$1); if (Caml_obj.caml_equal(tr2$1, /* [] */0)) { - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: /* Close_box */0, @@ -71268,7 +72209,8 @@ register_error_of_exn(function (err) { } const mis = mismatch(true, tr2$1); const partial_arg$1 = mis === undefined; - Curry._3(Stdlib__Format.fprintf(param)(/* Format */{ + Curry._3(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -71288,7 +72230,8 @@ register_error_of_exn(function (err) { })); })); case /* Value_multiply_overridden */24 : - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The instance variable ", @@ -71313,7 +72256,8 @@ register_error_of_exn(function (err) { ty$p ]); const ty$4 = match[0]; - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This expression cannot be coerced to type", @@ -71353,7 +72297,8 @@ register_error_of_exn(function (err) { return type_expansion(ty$4, param, param$1); }), match[1]); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "but is here used with type", @@ -71363,7 +72308,8 @@ register_error_of_exn(function (err) { }); })); if (param$1._3) { - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '.' */46, @@ -71374,7 +72320,8 @@ register_error_of_exn(function (err) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -71418,7 +72365,8 @@ register_error_of_exn(function (err) { reset(undefined); mark_loops(ty$4); if (param$1._0) { - Stdlib__Format.fprintf(param)(/* Format */{ + Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This function expects too many arguments,", @@ -71435,7 +72383,8 @@ register_error_of_exn(function (err) { }, _1: "This function expects too many arguments,@ " }); - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "it should have type", @@ -71456,7 +72405,8 @@ register_error_of_exn(function (err) { _1: "it should have type@ %a" }), type_expr$1, ty$4); } else { - Stdlib__Format.fprintf(param)(/* Format */{ + Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This expression should not be a function,", @@ -71473,7 +72423,8 @@ register_error_of_exn(function (err) { }, _1: "This expression should not be a function,@ " }); - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "the expected type is", @@ -71500,7 +72451,8 @@ register_error_of_exn(function (err) { if (l === "") { return "but its first argument is not labelled"; } else { - return Curry._1(Stdlib__Format.sprintf(/* Format */{ + return Curry._1(Stdlib__Format.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "but its first argument is labelled ", @@ -71516,12 +72468,14 @@ register_error_of_exn(function (err) { }; reset(undefined); mark_loops(ty$5); - return Curry._3(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -71534,7 +72488,8 @@ register_error_of_exn(function (err) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -71589,7 +72544,8 @@ register_error_of_exn(function (err) { const ty$6 = param$1._1; reset(undefined); mark_loops(ty$6); - Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This `let module' expression has type", @@ -71618,7 +72574,8 @@ register_error_of_exn(function (err) { }, _1: "This `let module' expression has type@ %a@ " }), type_expr$1, ty$6); - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "In this type, the locally bound module name ", @@ -71635,7 +72592,8 @@ register_error_of_exn(function (err) { _1: "In this type, the locally bound module name %s escapes its scope" }), param$1._0); case /* Masked_instance_variable */29 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The instance variable ", @@ -71660,7 +72618,8 @@ register_error_of_exn(function (err) { _1: "The instance variable %a@ cannot be accessed from the definition of another instance variable" }), longident, param$1._0); case /* Not_a_variant_type */30 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The type ", @@ -71687,7 +72646,8 @@ register_error_of_exn(function (err) { case /* Less_general */31 : const kind$2 = param$1._0; return report_unification_error(param, env, undefined, param$1._1, (function (ppf) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This ", @@ -71704,7 +72664,8 @@ register_error_of_exn(function (err) { _1: "This %s has type" }), kind$2); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "which is less general than", @@ -71714,7 +72675,8 @@ register_error_of_exn(function (err) { }); })); case /* Not_a_packed_module */32 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This expression is packed module, but the expected type is", @@ -71736,7 +72698,8 @@ register_error_of_exn(function (err) { }), type_expr$1, param$1._0); case /* Recursive_local_constraint */33 : return report_unification_error(param, env, undefined, param$1._0, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Recursive local constraint when unifying", @@ -71745,7 +72708,8 @@ register_error_of_exn(function (err) { _1: "Recursive local constraint when unifying" }); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "with", @@ -71755,12 +72719,14 @@ register_error_of_exn(function (err) { }); })); case /* Unqualified_gadt_pattern */34 : - return Curry._4(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -71853,15 +72819,15 @@ function is_fixed_type(sd) { while(true) { const sty$1 = _sty; const match = sty$1.ptyp_desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return false; } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Ptyp_object */4 : - if (match._1) { - return true; - } else { + if (match._1 === /* Closed */0) { return false; + } else { + return true; } case /* Ptyp_class */5 : return true; @@ -71869,10 +72835,10 @@ function is_fixed_type(sd) { _sty = match._0; continue ; case /* Ptyp_variant */7 : - if (match._1) { - return true; - } else { + if (match._1 === /* Closed */0) { return match._2 !== undefined; + } else { + return true; } default: return false; @@ -71900,7 +72866,7 @@ function set_fixed_row(env, loc, p, decl) { } const row = tm.desc; let rv; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { throw new Caml_js_exceptions.MelangeError($$Error$8, { MEL_EXN_ID: $$Error$8, _1: loc, @@ -71910,7 +72876,7 @@ function set_fixed_row(env, loc, p, decl) { } }); } - switch (row.TAG | 0) { + switch (row.TAG) { case /* Tobject */4 : rv = flatten_fields(row._0)[1]; break; @@ -71966,17 +72932,20 @@ const funarg$5 = { }; function height$10(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$11(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; - return /* Node */{ + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; + return { + TAG: /* Node */0, l: l, v: v, r: r, @@ -71985,52 +72954,55 @@ function create$11(l, v, r) { } function bal$10(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const lv = l.v; - const ll = l.l; - if (height$10(ll) >= height$10(lr)) { - return create$11(ll, lv, create$11(lr, v, r)); - } - if (lr) { - return create$11(create$11(ll, lv, lr.l), lr.v, create$11(lr.r, v, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const lr = l.r; + const lv = l.v; + const ll = l.l; + if (height$10(ll) >= height$10(lr)) { + return create$11(ll, lv, create$11(lr, v, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$11(create$11(ll, lv, lr.l), lr.v, create$11(lr.r, v, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: v, r: r, h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rv = r.v; - const rl = r.l; - if (height$10(rr) >= height$10(rl)) { - return create$11(create$11(l, v, rl), rv, rr); - } - if (rl) { - return create$11(create$11(l, v, rl.l), rl.v, create$11(rl.r, rv, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const rr = r.r; + const rv = r.v; + const rl = r.l; + if (height$10(rr) >= height$10(rl)) { + return create$11(create$11(l, v, rl), rv, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$11(create$11(l, v, rl.l), rl.v, create$11(rl.r, rv, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" @@ -72038,8 +73010,9 @@ function bal$10(l, v, r) { } function add$12(x, t) { - if (!t) { - return /* Node */{ + if (/* tag */typeof t === "number" || typeof t === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -72072,7 +73045,7 @@ function add$12(x, t) { function mem$6(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(funarg$5.compare, x, param.v); @@ -72122,7 +73095,7 @@ function make_constructor(env, type_path, type_params, sargs, sret_type) { const ret_type = tret_type.ctyp_type; const match = repr(ret_type).desc; let exit = 0; - if (typeof match === "number" || !(match.TAG === /* Tconstr */3 && same(type_path, match._0))) { + if (/* tag */typeof match === "number" || typeof match === "string" || !(match.TAG === /* Tconstr */3 && same(type_path, match._0))) { exit = 1; } if (exit === 1) { @@ -72161,7 +73134,7 @@ function make_constructor(env, type_path, type_params, sargs, sret_type) { function generalize_decl(decl) { Stdlib__List.iter(generalize, decl.type_params); const v = decl.type_kind; - if (typeof v === "number") { + if (/* tag */typeof v === "number" || typeof v === "string") { v === /* Type_abstract */0; } else if (v.TAG === /* Type_record */0) { Stdlib__List.iter((function (l) { @@ -72193,12 +73166,12 @@ function check_constraints_rec(env, loc, visited, _ty) { } visited.contents = Curry._2(add$3, ty$1, visited.contents); const match = ty$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return iter_type_expr((function (param) { return check_constraints_rec(env, loc, visited, param); }), ty$1); } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tconstr */3 : const args = match._1; const path = match._0; @@ -72264,17 +73237,18 @@ const funarg$6 = { }; function height$11(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$12(l, x, d, r) { const hl = height$11(l); const hr = height$11(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -72284,32 +73258,35 @@ function create$12(l, x, d, r) { } function bal$11(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height$11(ll) >= height$11(lr)) { - return create$12(ll, lv, ld, create$12(lr, x, d, r)); - } - if (lr) { - return create$12(create$12(ll, lv, ld, lr.l), lr.v, lr.d, create$12(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height$11(ll) >= height$11(lr)) { + return create$12(ll, lv, ld, create$12(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$12(create$12(ll, lv, ld, lr.l), lr.v, lr.d, create$12(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -72317,22 +73294,22 @@ function bal$11(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height$11(rr) >= height$11(rl)) { - return create$12(create$12(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create$12(create$12(l, x, d, rl.l), rl.v, rl.d, create$12(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height$11(rr) >= height$11(rl)) { + return create$12(create$12(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$12(create$12(l, x, d, rl.l), rl.v, rl.d, create$12(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -72340,8 +73317,9 @@ function bal$11(l, x, d, r) { } function add$13(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -72358,7 +73336,8 @@ function add$13(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -72386,31 +73365,31 @@ function add$13(x, data, m) { function find$6(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(funarg$6.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(funarg$6.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } function check_coherence(env, loc, id, decl) { - const match = decl.type_kind; - if (typeof match === "number" && !match) { + let tmp = decl.type_kind; + if (/* tag */(typeof tmp === "number" || typeof tmp === "string") && tmp === /* Type_abstract */0) { return ; } const ty = decl.type_manifest; if (ty === undefined) { return ; } - const match$1 = repr(ty).desc; - if (typeof match$1 === "number") { + const match = repr(ty).desc; + if (/* tag */typeof match === "number" || typeof match === "string") { throw new Caml_js_exceptions.MelangeError($$Error$8, { MEL_EXN_ID: $$Error$8, _1: loc, @@ -72421,9 +73400,9 @@ function check_coherence(env, loc, id, decl) { } }); } - if (match$1.TAG === /* Tconstr */3) { - const args = match$1._1; - const path = match$1._0; + if (match.TAG === /* Tconstr */3) { + const args = match._1; + const path = match._0; try { const decl$p = find_type_full(path, env)[0]; const err = Stdlib__List.length(args) !== Stdlib__List.length(decl.type_params) ? ({ @@ -72484,7 +73463,7 @@ function check_well_founded(env, loc, path, to_check, ty) { if (Curry._2(mem$3, ty$1, exp_nodes)) { const match = ty0.desc; let tmp; - tmp = typeof match === "number" || match.TAG !== /* Tconstr */3 ? false : same(match._0, path); + tmp = /* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tconstr */3 ? false : same(match._0, path); if (tmp) { throw new Caml_js_exceptions.MelangeError($$Error$8, { MEL_EXN_ID: $$Error$8, @@ -72535,7 +73514,7 @@ function check_well_founded(env, loc, path, to_check, ty) { try { visited.contents = Curry._3(add$4, ty$1, exp_nodes$1, visited.contents); const match$2 = ty$1.desc; - if (typeof match$2 === "number") { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string") { throw new Caml_js_exceptions.MelangeError(Cannot_expand, { MEL_EXN_ID: Cannot_expand }); @@ -72561,10 +73540,10 @@ function check_well_founded(env, loc, path, to_check, ty) { if (!(recursive_types.contents && is_contractive(env, ty$1))) { const match$3 = ty$1.desc; let tmp$2; - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { tmp$2 = false; } else { - switch (match$3.TAG | 0) { + switch (match$3.TAG) { case /* Tobject */4 : case /* Tvariant */8 : tmp$2 = true; @@ -72636,12 +73615,12 @@ function check_recursion(env, loc, path, decl, to_check) { tl: visited.contents }; const match = ty$1.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return iter_type_expr((function (param) { return check_regular(cpath, args, prev_exp, param); }), ty$1); } - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tconstr */3 : const args$p = match._1; const path$p = match._0; @@ -72746,10 +73725,10 @@ function compute_variance(env, visited, vari, ty) { return compute_variance_rec(vari$1, param); }; const tl = ty$1.desc; - if (typeof tl === "number") { + if (/* tag */typeof tl === "number" || typeof tl === "string") { return ; } - switch (tl.TAG | 0) { + switch (tl.TAG) { case /* Tarrow */1 : const v = Curry._1(Types_Variance.conjugate, vari$1); const v1 = Curry._2(Types_Variance.mem, /* May_pos */0, v) || Curry._2(Types_Variance.mem, /* May_neg */1, v) ? Curry._3(Types_Variance.set, /* May_weak */2, true, v) : v; @@ -72797,7 +73776,7 @@ function compute_variance(env, visited, vari, ty) { const row = row_repr_aux(/* [] */0, tl._0); Stdlib__List.iter((function (param) { const match = row_field_repr_aux(/* [] */0, param[1]); - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return ; } if (match.TAG === /* Rpresent */0) { @@ -73042,7 +74021,7 @@ function add_false(param) { function constrained(env, vars, ty) { const match = ty.desc; - if (typeof match === "number" || match.TAG !== /* Tvar */0) { + if (/* tag */typeof match === "number" || typeof match === "string" || match.TAG !== /* Tvar */0) { return true; } else { return Stdlib__List.exists((function (tl) { @@ -73070,7 +74049,7 @@ function compute_variance_gadt(env, check, rloc, decl, param) { } const match = repr(ret_type_opt); const match$1 = match.desc; - if (typeof match$1 === "number") { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -73171,7 +74150,7 @@ function compute_variance_decl(env, check, decl, rloc) { tl: /* [] */0 }) : /* [] */0; const tll = decl.type_kind; - if (typeof tll === "number") { + if (/* tag */typeof tll === "number" || typeof tll === "string") { return compute_variance_type(env, check, rloc, decl, mn); } if (tll.TAG === /* Type_record */0) { @@ -73395,7 +74374,7 @@ function check_duplicates(sdecl_list) { const constrs = Stdlib__Hashtbl.create(undefined, 7); Stdlib__List.iter((function (sdecl) { const cl = sdecl.ptype_kind; - if (typeof cl === "number") { + if (/* tag */typeof cl === "number" || typeof cl === "string") { return ; } else if (cl.TAG === /* Ptype_variant */0) { return Stdlib__List.iter((function (pcd) { @@ -73443,14 +74422,14 @@ function check_duplicates(sdecl_list) { } function name_recursion(sdecl, id, decl) { - const match = decl.type_kind; - if (typeof match !== "number") { + let tmp = decl.type_kind; + if (!/* tag */(typeof tmp === "number" || typeof tmp === "string")) { return decl; } - if (match) { + if (tmp !== /* Type_abstract */0) { return decl; } - if (decl.type_private) { + if (decl.type_private !== /* Private */0) { return decl; } const ty = decl.type_manifest; @@ -73518,7 +74497,8 @@ function transl_type_decl(env, rec_flag, sdecl_list) { }), sdecl_list$1); init_def(currentstamp.contents); begin_def(undefined); - const temp_env = rec_flag ? Stdlib__List.fold_left2(enter_type$1, env, sdecl_list$1, id_list) : env; + let temp_env; + temp_env = rec_flag === /* Nonrecursive */0 ? env : Stdlib__List.fold_left2(enter_type$1, env, sdecl_list$1, id_list); const current_slot = { contents: undefined }; @@ -73527,7 +74507,7 @@ function transl_type_decl(env, rec_flag, sdecl_list) { _0: "" }); const id_slots = function (id) { - if (!rec_flag) { + if (rec_flag === /* Nonrecursive */0) { return [ id, undefined @@ -73588,7 +74568,7 @@ function transl_type_decl(env, rec_flag, sdecl_list) { }), name_sdecl.ptype_cstrs); const scstrs = name_sdecl.ptype_kind; let match; - if (typeof scstrs === "number") { + if (/* tag */typeof scstrs === "number" || typeof scstrs === "string") { match = scstrs === /* Ptype_abstract */0 ? [ /* Ttype_abstract */0, /* Type_abstract */0 @@ -73712,7 +74692,7 @@ function transl_type_decl(env, rec_flag, sdecl_list) { const ty = ld.ld_type.ctyp_type; const match = ty.desc; let ty$1; - ty$1 = typeof match === "number" || !(match.TAG === /* Tpoly */10 && !match._1) ? ty : match._0; + ty$1 = /* tag */typeof match === "number" || typeof match === "string" || !(match.TAG === /* Tpoly */10 && !match._1) ? ty : match._0; return { ld_id: ld.ld_id, ld_mutable: ld.ld_mutable, @@ -73725,7 +74705,7 @@ function transl_type_decl(env, rec_flag, sdecl_list) { let ty = l.ld_type; const match = repr(expand_head_opt(temp_env, ty)); const match$1 = match.desc; - if (typeof match$1 === "number" || match$1.TAG !== /* Tconstr */3) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string" || match$1.TAG !== /* Tconstr */3) { return false; } else { return same(match$1._0, path_float); @@ -73860,7 +74840,7 @@ function transl_type_decl(env, rec_flag, sdecl_list) { const newenv = Stdlib__List.fold_right((function (param, env) { return add_type$1(true, param[0], param[1], env); }), decls, env); - if (rec_flag) { + if (rec_flag !== /* Nonrecursive */0) { Stdlib__List.iter2((function (id, sdecl) { let loc = sdecl.ptype_loc; const path = { @@ -73924,7 +74904,7 @@ function transl_type_decl(env, rec_flag, sdecl_list) { }), newconstr(path, args)); }), decls); const to_check = function (id) { - switch (id.TAG | 0) { + switch (id.TAG) { case /* Pident */0 : return Stdlib__List.mem_assoc(id._0, id_loc_list); case /* Pdot */1 : @@ -73970,11 +74950,11 @@ function transl_type_decl(env, rec_flag, sdecl_list) { contents: /* Empty */0 }; const l = decl.type_kind; - if (typeof l === "number") { + if (/* tag */typeof l === "number" || typeof l === "string") { l === /* Type_abstract */0; } else if (l.TAG === /* Type_record */0) { const find_pl = function (pl) { - if (typeof pl === "number") { + if (/* tag */typeof pl === "number" || typeof pl === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -74023,7 +75003,7 @@ function transl_type_decl(env, rec_flag, sdecl_list) { }), l._0); } else { const find_pl$1 = function (pl) { - if (typeof pl === "number") { + if (/* tag */typeof pl === "number" || typeof pl === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -74204,7 +75184,7 @@ function transl_extension_constructor(env, check_open, type_path, type_params, t })); Stdlib__List.iter((function (ty) { const match = ty.desc; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return ; } if (match.TAG !== /* Tvar */0) { @@ -74223,7 +75203,7 @@ function transl_extension_constructor(env, check_open, type_path, type_params, t } const match$4 = cdescr.cstr_res.desc; let match$5; - if (typeof match$4 === "number") { + if (/* tag */typeof match$4 === "number" || typeof match$4 === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -74289,7 +75269,7 @@ function transl_extension_constructor(env, check_open, type_path, type_params, t }); } const match$6 = cdescr.cstr_private; - if (!match$6 && priv) { + if (match$6 === /* Private */0 && priv !== /* Private */0) { throw new Caml_js_exceptions.MelangeError($$Error$8, { MEL_EXN_ID: $$Error$8, _1: lid$1.loc, @@ -74301,7 +75281,7 @@ function transl_extension_constructor(env, check_open, type_path, type_params, t } const match$7 = cdescr.cstr_tag; let path; - switch (match$7.TAG | 0) { + switch (match$7.TAG) { case /* Cstr_constant */0 : case /* Cstr_block */1 : throw new Caml_js_exceptions.MelangeError("Assert_failure", { @@ -74357,8 +75337,8 @@ function transl_type_extension(check_open, env, loc, styext) { const type_decl = match[1]; const type_path = match[0]; const match$1 = type_decl.type_kind; - if (typeof match$1 === "number") { - if (!match$1 && check_open) { + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { + if (match$1 === /* Type_abstract */0 && check_open) { try { const match$2 = Stdlib__List.find((function (param) { if (param.pext_kind.TAG === /* Pext_decl */0) { @@ -74386,6 +75366,16 @@ function transl_type_extension(check_open, env, loc, styext) { } } else { + if (match$1.TAG === /* Type_record */0) { + throw new Caml_js_exceptions.MelangeError($$Error$8, { + MEL_EXN_ID: $$Error$8, + _1: loc, + _2: { + TAG: /* Not_extensible_type */11, + _0: type_path + } + }); + } throw new Caml_js_exceptions.MelangeError($$Error$8, { MEL_EXN_ID: $$Error$8, _1: loc, @@ -74529,7 +75519,7 @@ function customize_arity(arity, pval_attributes) { return ; } const match = x[1]; - switch (match.TAG | 0) { + switch (match.TAG) { case /* PStr */0 : const match$1 = match._0; if (!match$1) { @@ -74832,7 +75822,8 @@ function explain_unbound(ppf, tv, tl, typ, kwd, lab) { tl: /* [] */0 } }); - return Curry._6(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._6(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '.' */46, @@ -74843,7 +75834,8 @@ function explain_unbound(ppf, tv, tl, typ, kwd, lab) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -74917,10 +75909,11 @@ function explain_unbound(ppf, tv, tl, typ, kwd, lab) { } function report_error$5(ppf, s) { - if (typeof s === "number") { + if (/* tag */typeof s === "number" || typeof s === "string") { switch (s) { case /* Repeated_parameter */0 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "A type parameter occurs several times", @@ -74929,12 +75922,14 @@ function report_error$5(ppf, s) { _1: "A type parameter occurs several times" }); case /* Too_many_constructors */1 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -74979,7 +75974,8 @@ function report_error$5(ppf, s) { _1: "@[Too many non-constant constructors@ -- maximum is %i %s@]" }), 246, "non-constant constructors"); case /* Null_arity_external */2 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "External identifiers must be functions", @@ -74988,12 +75984,14 @@ function report_error$5(ppf, s) { _1: "External identifiers must be functions" }); case /* Missing_native_external */3 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -75028,12 +76026,14 @@ function report_error$5(ppf, s) { _1: "@[An external function with more than 5 arguments requires a second stub function@ for native-code compilation@]" }); case /* Varying_anonymous */4 : - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -75079,9 +76079,10 @@ function report_error$5(ppf, s) { } } else { - switch (s.TAG | 0) { + switch (s.TAG) { case /* Duplicate_constructor */0 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Two constructors are named ", @@ -75094,7 +76095,8 @@ function report_error$5(ppf, s) { _1: "Two constructors are named %s" }), s._0); case /* Duplicate_label */1 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Two labels are named ", @@ -75107,7 +76109,8 @@ function report_error$5(ppf, s) { _1: "Two labels are named %s" }), s._0); case /* Recursive_abbrev */2 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The type abbreviation ", @@ -75127,12 +76130,14 @@ function report_error$5(ppf, s) { const ty = s._1; reset(undefined); mark_loops(ty); - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -75177,12 +76182,14 @@ function report_error$5(ppf, s) { const ty$1 = s._0; reset(undefined); mark_loops(ty$1); - return Curry._6(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._6(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -75195,7 +76202,8 @@ function report_error$5(ppf, s) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -75257,12 +76265,14 @@ function report_error$5(ppf, s) { reset(undefined); mark_loops(ty$2); mark_loops(ty$p); - return Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -75282,7 +76292,8 @@ function report_error$5(ppf, s) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -75348,7 +76359,8 @@ function report_error$5(ppf, s) { _1: "@[%s@ @[Type@ %a@ should be an instance of@ %a@]@]" }), "Constraints are not satisfied in this type.", type_expr$1, ty$2, type_expr$1, ty$p); case /* Inconsistent_constraint */6 : - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The type constraints are not consistent.", @@ -75361,7 +76373,8 @@ function report_error$5(ppf, s) { _1: "The type constraints are not consistent.@." }); return report_unification_error(ppf, s._0, undefined, s._1, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Type", @@ -75370,7 +76383,8 @@ function report_error$5(ppf, s) { _1: "Type" }); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "is not compatible with type", @@ -75381,7 +76395,8 @@ function report_error$5(ppf, s) { })); case /* Type_clash */7 : return report_unification_error(ppf, s._0, undefined, s._1, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This type constructor expands to type", @@ -75390,7 +76405,8 @@ function report_error$5(ppf, s) { _1: "This type constructor expands to type" }); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "but is used here with type", @@ -75405,12 +76421,14 @@ function report_error$5(ppf, s) { reset(undefined); mark_loops(ty$3); mark_loops(ty$p$1); - return Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -75478,7 +76496,8 @@ function report_error$5(ppf, s) { }), name(undefined, s._0), type_expr$1, ty$3, type_expr$1, ty$p$1); case /* Unbound_type_var */9 : const decl = s._1; - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "A type variable is unbound in this type declaration", @@ -75489,7 +76508,7 @@ function report_error$5(ppf, s) { const ty$4 = repr(s._0); const match = decl.type_kind; const match$1 = decl.type_manifest; - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { if (match === /* Type_abstract */0 && match$1 !== undefined) { const trivial = function (ty$5) { explain_unbound(ppf, ty$4, { @@ -75502,10 +76521,10 @@ function report_error$5(ppf, s) { })); }; const row = repr(match$1).desc; - if (typeof row === "number") { + if (/* tag */typeof row === "number" || typeof row === "string") { return trivial(match$1); } - switch (row.TAG | 0) { + switch (row.TAG) { case /* Tobject */4 : const match$2 = flatten_fields(row._0); if (match$2[1] === ty$4) { @@ -75524,7 +76543,7 @@ function report_error$5(ppf, s) { } else { return explain_unbound(ppf, ty$4, row$1.row_fields, (function (param) { const match = row_field_repr_aux(/* [] */0, param[1]); - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { return newty2(100000000, { TAG: /* Ttuple */2, _0: /* [] */0 @@ -75577,12 +76596,14 @@ function report_error$5(ppf, s) { })); } case /* Not_open_type */10 : - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -75612,12 +76633,14 @@ function report_error$5(ppf, s) { _1: "@[%s@ %a@]" }), "Cannot extend type definition", path, s._0); case /* Not_extensible_type */11 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -75660,12 +76683,14 @@ function report_error$5(ppf, s) { _1: "@[%s@ %a@ %s@]" }), "Type", path, s._0, "is not extensible"); case /* Extension_mismatch */12 : - return Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -75678,7 +76703,8 @@ function report_error$5(ppf, s) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -75738,7 +76764,8 @@ function report_error$5(ppf, s) { case /* Rebind_wrong_type */13 : const lid = s._0; return report_unification_error(ppf, s._1, undefined, s._2, (function (ppf) { - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The constructor ", @@ -75763,7 +76790,8 @@ function report_error$5(ppf, s) { _1: "The constructor %a@ has type" }), longident, lid); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "but was expected to be of type", @@ -75773,12 +76801,14 @@ function report_error$5(ppf, s) { }); })); case /* Rebind_mismatch */14 : - return Curry._8(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._8(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -75873,12 +76903,14 @@ function report_error$5(ppf, s) { _1: "@[%s@ %a@ %s@ %s@ %s@ %s@ %s@]" }), "The constructor", longident, s._0, "extends type", name(undefined, s._1), "whose declaration does not match", "the declaration of type", name(undefined, s._2)); case /* Rebind_private */15 : - return Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -75966,12 +76998,14 @@ function report_error$5(ppf, s) { } }; if (n === -1) { - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -76011,12 +77045,14 @@ function report_error$5(ppf, s) { _1: "@[%s@ %s@ It" }), "In this definition, a type variable has a variance that", "is not reflected by its occurrence in type parameters."); } else if (n === -2) { - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -76047,12 +77083,14 @@ function report_error$5(ppf, s) { _1: "@[%s@ %s@]" }), "In this definition, a type variable cannot be deduced", "from the type parameters."); } else if (n === -3) { - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -76092,12 +77130,14 @@ function report_error$5(ppf, s) { _1: "@[%s@ %s@ It" }), "In this definition, a type variable has a variance that", "cannot be deduced from the type parameters."); } else { - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -76152,7 +77192,8 @@ function report_error$5(ppf, s) { }), "In this definition, expected parameter", "variances are not satisfied.", n, suffix(n)); } if (n !== -2) { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " was expected to be ", @@ -76197,7 +77238,8 @@ function report_error$5(ppf, s) { return ; } case /* Unavailable_type_constructor */17 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The definition of type ", @@ -76222,7 +77264,8 @@ function report_error$5(ppf, s) { _1: "The definition of type %a@ is unavailable" }), path, s._0); case /* Bad_fixed_type */18 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This fixed type ", @@ -76235,7 +77278,8 @@ function report_error$5(ppf, s) { _1: "This fixed type %s" }), s._0); case /* Unbound_type_var_ext */19 : - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "A type variable is unbound in this extension constructor", @@ -76282,7 +77326,7 @@ const unbound_class = { function scrape_class_type(_cty) { while(true) { const cty = _cty; - switch (cty.TAG | 0) { + switch (cty.TAG) { case /* Cty_constr */0 : _cty = cty._2; continue ; @@ -76297,7 +77341,7 @@ function scrape_class_type(_cty) { function generalize_class_type(gen, _param) { while(true) { const param = _param; - switch (param.TAG | 0) { + switch (param.TAG) { case /* Cty_constr */0 : Stdlib__List.iter(gen, param._1); _param = param._2; @@ -76338,7 +77382,7 @@ function virtual_methods(sign) { function constructor_type(constr, _cty) { while(true) { const cty = _cty; - switch (cty.TAG | 0) { + switch (cty.TAG) { case /* Cty_constr */0 : _cty = cty._2; continue ; @@ -76364,7 +77408,7 @@ function constructor_type(constr, _cty) { function class_body(_cty) { while(true) { const cty = _cty; - switch (cty.TAG | 0) { + switch (cty.TAG) { case /* Cty_constr */0 : case /* Cty_signature */1 : return cty; @@ -76402,7 +77446,7 @@ function extract_constraints(cty) { } function abbreviate_class_type(path, params, cty) { - switch (cty.TAG | 0) { + switch (cty.TAG) { case /* Cty_constr */0 : case /* Cty_signature */1 : return { @@ -76427,7 +77471,7 @@ function closed_class$1(cty) { let _sign = cty.cty_type; while(true) { const sign = _sign; - switch (sign.TAG | 0) { + switch (sign.TAG) { case /* Cty_constr */0 : return Stdlib__List.for_all(closed_schema, sign._1); case /* Cty_signature */1 : @@ -76460,7 +77504,7 @@ function closed_class$1(cty) { function limited_generalize$1(rv, _sign) { while(true) { const sign = _sign; - switch (sign.TAG | 0) { + switch (sign.TAG) { case /* Cty_constr */0 : Stdlib__List.iter((function (param) { return limited_generalize(rv, param); @@ -76604,7 +77648,7 @@ function concr_vals(vars) { function inheritance(self_type, env, ovf, concr_meths, warn_vals, loc, parent) { const cl_sig = scrape_class_type(parent); - switch (cl_sig.TAG | 0) { + switch (cl_sig.TAG) { case /* Cty_signature */1 : const cl_sig$1 = cl_sig._0; try { @@ -76623,7 +77667,7 @@ function inheritance(self_type, env, ovf, concr_meths, warn_vals, loc, parent) { const match$2 = match$1.tl; if (match$2) { const match$3 = match$2.hd[0].desc; - if (typeof match$3 === "number") { + if (/* tag */typeof match$3 === "number" || typeof match$3 === "string") { exit = 1; } else { if (match$3.TAG === /* Tfield */5) { @@ -76672,9 +77716,23 @@ function inheritance(self_type, env, ovf, concr_meths, warn_vals, loc, parent) { const concr_vals$1 = concr_vals(cl_sig$1.csig_vars); const over_vals = Curry._2(inter$1, concr_vals$1, warn_vals); if (ovf !== undefined) { - if (ovf) { + if (ovf === /* Override */0) { + if (Curry._1(is_empty$1, over_meths) && Curry._1(is_empty$1, over_vals)) { + throw new Caml_js_exceptions.MelangeError($$Error$9, { + MEL_EXN_ID: $$Error$9, + _1: loc, + _2: env, + _3: { + TAG: /* No_overriding */23, + _0: "", + _1: "" + } + }); + } + + } else { let cname; - switch (parent.TAG | 0) { + switch (parent.TAG) { case /* Cty_constr */0 : cname = name(undefined, parent._0); break; @@ -76703,19 +77761,7 @@ function inheritance(self_type, env, ovf, concr_meths, warn_vals, loc, parent) { }); } - } else if (Curry._1(is_empty$1, over_meths) && Curry._1(is_empty$1, over_vals)) { - throw new Caml_js_exceptions.MelangeError($$Error$9, { - MEL_EXN_ID: $$Error$9, - _1: loc, - _2: env, - _3: { - TAG: /* No_overriding */23, - _0: "", - _1: "" - } - }); } - } const concr_meths$1 = Curry._2(union$2, cl_sig$1.csig_concr, concr_meths); const warn_vals$1 = Curry._2(union$2, concr_vals$1, warn_vals); @@ -76798,27 +77844,30 @@ function declare_method(val_env, meths, self_type, lab, priv, sty, loc) { }; const sty$1 = force_poly(sty); const match$1 = sty$1.ptyp_desc; - if (typeof match$1 !== "number" && match$1.TAG === /* Ptyp_poly */8 && !match$1._0 && priv) { + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string") && match$1.TAG === /* Ptyp_poly */8 && !match$1._0) { const sty$p = match$1._1; - const returned_cty = ctyp(/* Ttyp_any */0, newty2(current_level.contents, /* Tnil */0), val_env, loc); - delayed_meth_specs.contents = { - hd: { - LAZY_DONE: false, - VAL: (function () { - const cty = transl_simple_type_univars(val_env, sty$p); - const ty = cty.ctyp_type; - unif(ty); - returned_cty.ctyp_desc = { - TAG: /* Ttyp_poly */8, - _0: /* [] */0, - _1: cty - }; - returned_cty.ctyp_type = ty; - }) - }, - tl: delayed_meth_specs.contents - }; - return returned_cty; + if (priv !== /* Private */0) { + const returned_cty = ctyp(/* Ttyp_any */0, newty2(current_level.contents, /* Tnil */0), val_env, loc); + delayed_meth_specs.contents = { + hd: { + LAZY_DONE: false, + VAL: (function () { + const cty = transl_simple_type_univars(val_env, sty$p); + const ty = cty.ctyp_type; + unif(ty); + returned_cty.ctyp_desc = { + TAG: /* Ttyp_poly */8, + _0: /* [] */0, + _1: cty + }; + returned_cty.ctyp_type = ty; + }) + }, + tl: delayed_meth_specs.contents + }; + return returned_cty; + } + } const cty = transl_simple_type(val_env, false, sty$1); const ty = cty.ctyp_type; @@ -76940,13 +77989,13 @@ function class_signature$1(env, param) { }; }; const sparent = param$1.pctf_desc; - switch (sparent.TAG | 0) { + switch (sparent.TAG) { case /* Pctf_inherit */0 : const sparent$1 = sparent._0; const parent = class_type$3(env, sparent$1); const match = parent.cltyp_type; let inher$1; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Cty_constr */0 : inher$1 = { hd: [ @@ -77013,7 +78062,8 @@ function class_signature$1(env, param) { const priv = match$3[1]; const lab$1 = match$3[0]; const cty$1 = declare_method(env, meths, self_type, lab$1, priv, match$3[3], param$1.pctf_loc); - const concr_meths$1 = virt$1 ? Curry._2(add$2, lab$1, concr_meths) : concr_meths; + let concr_meths$1; + concr_meths$1 = virt$1 === /* Virtual */0 ? concr_meths : Curry._2(add$2, lab$1, concr_meths); return [ { hd: mkctf({ @@ -77108,7 +78158,7 @@ function class_type$3(env, scty) { }; }; const pcsig = scty.pcty_desc; - switch (pcsig.TAG | 0) { + switch (pcsig.TAG) { case /* Pcty_constr */0 : const styl = pcsig._1; const lid = pcsig._0; @@ -77318,7 +78368,7 @@ function class_structure(cl_num, $$final, val_env, met_env, loc, param) { }; }; const expr = param$1.pcf_desc; - switch (expr.TAG | 0) { + switch (expr.TAG) { case /* Pcf_inherit */0 : const $$super = expr._2; const sparent = expr._1; @@ -77326,7 +78376,7 @@ function class_structure(cl_num, $$final, val_env, met_env, loc, param) { const parent = class_expr(cl_num, val_env, par_env, sparent); const match = parent.cl_type; let inher$1; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Cty_constr */0 : inher$1 = { hd: [ @@ -77666,7 +78716,7 @@ function class_structure(cl_num, $$final, val_env, met_env, loc, param) { unify$2(val_env, ty$p, ty$1); } const match$13 = repr(ty$1).desc; - if (typeof match$13 === "number") { + if (/* tag */typeof match$13 === "number" || typeof match$13 === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ @@ -77676,7 +78726,7 @@ function class_structure(cl_num, $$final, val_env, met_env, loc, param) { ] }); } - switch (match$13.TAG | 0) { + switch (match$13.TAG) { case /* Tvar */0 : const ty$p$1 = newvar(undefined, undefined); unify$2(val_env, newty2(current_level.contents, { @@ -77942,12 +78992,11 @@ function class_structure(cl_num, $$final, val_env, met_env, loc, param) { const lab = param[0]; if (lab === dummy_method) { const r = field_kind_repr(kind); - if (typeof r === "number") { - return rem; - } else { - set_kind(r._0, /* Fabsent */1); + if (/* tag */typeof r === "number" || typeof r === "string") { return rem; } + set_kind(r._0, /* Fabsent */1); + return rem; } const desc_1 = copy_kind(kind); const desc_2 = param[2]; @@ -78040,7 +79089,7 @@ function class_expr(cl_num, val_env, met_env, _scl) { while(true) { const scl = _scl; const cl_str = scl.pcl_desc; - switch (cl_str.TAG | 0) { + switch (cl_str.TAG) { case /* Pcl_constr */0 : const lid = cl_str._0; const match = find_class$1(val_env, scl.pcl_loc, lid.txt); @@ -78244,7 +79293,7 @@ function class_expr(cl_num, val_env, met_env, _scl) { ]; }), match$4[1]); const not_function = function (param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Cty_constr */0 : case /* Cty_signature */1 : return true; @@ -78316,7 +79365,7 @@ function class_expr(cl_num, val_env, met_env, _scl) { while(true) { const ty_fun = _ty_fun; const ls = _ls; - switch (ty_fun.TAG | 0) { + switch (ty_fun.TAG) { case /* Cty_constr */0 : case /* Cty_signature */1 : return ls; @@ -78354,14 +79403,14 @@ function class_expr(cl_num, val_env, met_env, _scl) { const ty_fun = _ty_fun; const omitted = _omitted; const args = _args; - switch (ty_fun.TAG | 0) { + switch (ty_fun.TAG) { case /* Cty_constr */0 : case /* Cty_signature */1 : break; case /* Cty_arrow */2 : const ty = ty_fun._1; const l = ty_fun._0; - switch (ty_fun0.TAG | 0) { + switch (ty_fun0.TAG) { case /* Cty_constr */0 : case /* Cty_signature */1 : break; @@ -78719,7 +79768,7 @@ function approx_declaration(_cl) { while(true) { const cl = _cl; const match = cl.pcl_desc; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Pcl_fun */2 : const l = match._0; const arg = is_optional(l) ? instance_def(var_option) : newvar(undefined, undefined); @@ -78858,11 +79907,13 @@ function type_classes(define_class, approx, kind, env, cls) { } }; const match$2 = cl.pci_virt; + let tmp; + tmp = match$2 === /* Virtual */0 ? undefined : constr_type; const dummy_class = { cty_params: /* [] */0, cty_type: dummy_cty, cty_path: unbound_class, - cty_new: match$2 ? constr_type : undefined, + cty_new: tmp, cty_variance: /* [] */0, cty_loc: none, cty_attributes: /* [] */0 @@ -79127,6 +80178,8 @@ function type_classes(define_class, approx, kind, env, cls) { clty_attributes: cltydef_clty_attributes }; const match$4 = cl.pci_virt; + let tmp; + tmp = match$4 === /* Virtual */0 ? undefined : constr_type; const clty = { cty_params: params, cty_type: typ, @@ -79134,7 +80187,7 @@ function type_classes(define_class, approx, kind, env, cls) { TAG: /* Pident */0, _0: obj_id }, - cty_new: match$4 ? constr_type : undefined, + cty_new: tmp, cty_variance: cty_variance, cty_loc: cl.pci_loc, cty_attributes: cl.pci_attributes @@ -79194,6 +80247,8 @@ function type_classes(define_class, approx, kind, env, cls) { clty_attributes: cltydef_clty_attributes$1 }; const match$7 = cl.pci_virt; + let tmp$1; + tmp$1 = match$7 === /* Virtual */0 ? undefined : instance(undefined, env$1, constr_type); const clty$1 = { cty_params: params$p, cty_type: typ$p, @@ -79201,7 +80256,7 @@ function type_classes(define_class, approx, kind, env, cls) { TAG: /* Pident */0, _0: obj_id }, - cty_new: match$7 ? instance(undefined, env$1, constr_type) : undefined, + cty_new: tmp$1, cty_variance: cty_variance, cty_loc: cl.pci_loc, cty_attributes: cl.pci_attributes @@ -79528,7 +80583,7 @@ function unify_parents_struct(env, ty, st) { while(true) { const cl = _cl; const st = cl.cl_desc; - switch (st.TAG | 0) { + switch (st.TAG) { case /* Tcl_ident */0 : try { const decl = find_class(st._0, env); @@ -79619,8 +80674,9 @@ register_error_of_exn(function (err) { const env = err._2; return error_of_printer(err._1, (function (param, param$1) { return wrap_printing_env(env, (function (param$2) { - if (typeof param$1 === "number") { - return Stdlib__Format.fprintf(param)(/* Format */{ + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "A type parameter occurs several times", @@ -79629,9 +80685,10 @@ register_error_of_exn(function (err) { _1: "A type parameter occurs several times" }); } - switch (param$1.TAG | 0) { + switch (param$1.TAG) { case /* Unconsistent_constraint */0 : - Stdlib__Format.fprintf(param)(/* Format */{ + Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The class constraints are not consistent.", @@ -79644,7 +80701,8 @@ register_error_of_exn(function (err) { _1: "The class constraints are not consistent.@." }); return report_unification_error(param, env, undefined, param$1._0, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Type", @@ -79653,7 +80711,8 @@ register_error_of_exn(function (err) { _1: "Type" }); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "is not compatible with type", @@ -79666,7 +80725,8 @@ register_error_of_exn(function (err) { const m = param$1._1; const k = param$1._0; return report_unification_error(param, env, undefined, param$1._2, (function (ppf) { - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The ", @@ -79700,7 +80760,8 @@ register_error_of_exn(function (err) { _1: "The %s %s@ has type" }), k, m); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "but is expected to have type", @@ -79710,12 +80771,14 @@ register_error_of_exn(function (err) { }); })); case /* Structure_expected */2 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -79745,7 +80808,8 @@ register_error_of_exn(function (err) { _1: "@[This class expression is not a class structure; it has type@ %a@]" }), class_type$2, param$1._0); case /* Cannot_apply */3 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This class expression is not a class function, it cannot be applied", @@ -79758,7 +80822,8 @@ register_error_of_exn(function (err) { if (l === "") { return "out label"; } else { - return Curry._1(Stdlib__Format.sprintf(/* Format */{ + return Curry._1(Stdlib__Format.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " label ~", @@ -79772,7 +80837,8 @@ register_error_of_exn(function (err) { }), l); } }; - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This argument cannot be applied with", @@ -79788,12 +80854,14 @@ register_error_of_exn(function (err) { const ty = param$1._0; reset(undefined); mark_loops(ty); - return Curry._3(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -79823,12 +80891,14 @@ register_error_of_exn(function (err) { _1: "@[%s@ %a@]" }), "This pattern cannot match self: it only matches values of type", type_expr$1, ty); case /* Unbound_class_2 */6 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -79871,12 +80941,14 @@ register_error_of_exn(function (err) { _1: "@[The class@ %a@ is not yet completely defined@]" }), longident, param$1._0); case /* Unbound_class_type_2 */7 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -79932,12 +81004,14 @@ register_error_of_exn(function (err) { } } }); - return Curry._6(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._6(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -80019,7 +81093,8 @@ register_error_of_exn(function (err) { case /* Constructor_type_mismatch */9 : const c = param$1._0; return report_unification_error(param, env, undefined, param$1._1, (function (ppf) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The expression \"new ", @@ -80036,7 +81111,8 @@ register_error_of_exn(function (err) { _1: "The expression \"new %s\" has type" }), c); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "but is used with type", @@ -80052,7 +81128,8 @@ register_error_of_exn(function (err) { const cl = param$1._0; const print_mets = function (ppf, mets) { Stdlib__List.iter((function (met) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -80076,7 +81153,8 @@ register_error_of_exn(function (err) { ) : "variables"; const print_msg = function (ppf) { if (imm) { - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This object has virtual ", @@ -80089,7 +81167,8 @@ register_error_of_exn(function (err) { _1: "This object has virtual %s" }), missings); } else if (cl) { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This class should be virtual", @@ -80098,7 +81177,8 @@ register_error_of_exn(function (err) { _1: "This class should be virtual" }); } else { - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This class type should be virtual", @@ -80108,12 +81188,14 @@ register_error_of_exn(function (err) { }); } }; - return Curry._4(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -80135,7 +81217,8 @@ register_error_of_exn(function (err) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -80176,12 +81259,14 @@ register_error_of_exn(function (err) { _1: "@[%t.@ @[<2>The following %s are undefined :%a@]@]" }), print_msg, missings, print_mets, Stdlib.$at(mets, vals)); case /* Parameter_arity_mismatch */11 : - return Curry._4(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -80249,7 +81334,8 @@ register_error_of_exn(function (err) { }), longident, param$1._0, param$1._1, param$1._2); case /* Parameter_mismatch */12 : return report_unification_error(param, env, undefined, param$1._0, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The type parameter", @@ -80258,7 +81344,8 @@ register_error_of_exn(function (err) { _1: "The type parameter" }); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "does not meet its constraint: it should be", @@ -80277,12 +81364,14 @@ register_error_of_exn(function (err) { tl: /* [] */0 } }); - return Curry._6(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._6(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -80355,7 +81444,8 @@ register_error_of_exn(function (err) { case /* Class_match_failure */14 : return report_error$3(param, param$1._0); case /* Unbound_val */15 : - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unbound instance variable ", @@ -80377,7 +81467,8 @@ register_error_of_exn(function (err) { } }); mark_loops(ty1); - Curry._6(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._6(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The ", @@ -80469,12 +81560,14 @@ register_error_of_exn(function (err) { } }; reset(undefined); - return Curry._3(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -80487,7 +81580,8 @@ register_error_of_exn(function (err) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -80520,7 +81614,8 @@ register_error_of_exn(function (err) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -80548,12 +81643,14 @@ register_error_of_exn(function (err) { _1: "@[@[Some type variables are unbound in this type:@;<1 2>%t@]@ @[%a@]@]" }), param$1._0, print_reason, param$1._1); case /* Make_nongen_seltype */17 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -80566,7 +81663,8 @@ register_error_of_exn(function (err) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -80615,12 +81713,14 @@ register_error_of_exn(function (err) { }), type_scheme, param$1._0); case /* Non_generalizable_class */18 : const id = param$1._0; - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -80669,12 +81769,14 @@ register_error_of_exn(function (err) { return class_declaration$1(id, param, param$1); }), param$1._1); case /* Cannot_coerce_self */19 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -80730,12 +81832,14 @@ register_error_of_exn(function (err) { }), type_scheme, param$1._0); case /* Non_collapsable_conjunction */20 : const id$1 = param$1._0; - Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -80784,7 +81888,8 @@ register_error_of_exn(function (err) { return class_declaration$1(id$1, param, param$1); }), param$1._1); return report_unification_error(param, env, undefined, param$1._2, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Type", @@ -80793,7 +81898,8 @@ register_error_of_exn(function (err) { _1: "Type" }); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "is not compatible with type", @@ -80804,7 +81910,8 @@ register_error_of_exn(function (err) { })); case /* Final_self_clash */21 : return report_unification_error(param, env, undefined, param$1._0, (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This object is expected to have type", @@ -80813,7 +81920,8 @@ register_error_of_exn(function (err) { _1: "This object is expected to have type" }); }), (function (ppf) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "but actually has type", @@ -80830,12 +81938,14 @@ register_error_of_exn(function (err) { "immutable", "mutable" ]; - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -80879,12 +81989,14 @@ register_error_of_exn(function (err) { }), match[0], match[1]); case /* No_overriding */23 : if (param$1._1 === "") { - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -80915,12 +82027,14 @@ register_error_of_exn(function (err) { _1: "@[This inheritance does not override any method@ %s@]" }), "instance variable"); } else { - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -80968,12 +82082,14 @@ register_error_of_exn(function (err) { }), param$1._0, param$1._1); } case /* Duplicate */24 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -81034,7 +82150,7 @@ function fst3(param) { } function path_concat(head, p) { - switch (p.TAG | 0) { + switch (p.TAG) { case /* Pident */0 : return { TAG: /* Pdot */1, @@ -81149,12 +82265,16 @@ function add_rec_types(_env, _param) { if (match.TAG !== /* Sig_type */1) { return env; } - if (match._2 < 2) { - return env; + switch (match._2) { + case /* Trec_not */0 : + case /* Trec_first */1 : + return env; + case /* Trec_next */2 : + _param = param.tl; + _env = add_type$1(true, match._0, match._1, env); + continue ; + } - _param = param.tl; - _env = add_type$1(true, match._0, match._1, env); - continue ; }; } @@ -81167,41 +82287,52 @@ function check_type_decl(env, loc, id, row_id, newdecl, decl, rs, rem) { } function update_rec_next(rs, rem) { - if (rs >= 2) { - return rem; + switch (rs) { + case /* Trec_not */0 : + case /* Trec_first */1 : + break; + case /* Trec_next */2 : + return rem; + } if (!rem) { return rem; } const match = rem.hd; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Sig_type */1 : - if (match._2 >= 2) { - return { - hd: { - TAG: /* Sig_type */1, - _0: match._0, - _1: match._1, - _2: rs - }, - tl: rem.tl - }; - } else { - return rem; + switch (match._2) { + case /* Trec_not */0 : + case /* Trec_first */1 : + return rem; + case /* Trec_next */2 : + return { + hd: { + TAG: /* Sig_type */1, + _0: match._0, + _1: match._1, + _2: rs + }, + tl: rem.tl + }; + } case /* Sig_module */3 : - if (match._2 >= 2) { - return { - hd: { - TAG: /* Sig_module */3, - _0: match._0, - _1: match._1, - _2: rs - }, - tl: rem.tl - }; - } else { - return rem; + switch (match._2) { + case /* Trec_not */0 : + case /* Trec_first */1 : + return rem; + case /* Trec_next */2 : + return { + hd: { + TAG: /* Sig_module */3, + _0: match._0, + _1: match._1, + _2: rs + }, + tl: rem.tl + }; + } default: return rem; @@ -81210,7 +82341,7 @@ function update_rec_next(rs, rem) { function merge_constraint(initial_env, loc, sg, constr) { let lid; - switch (constr.TAG | 0) { + switch (constr.TAG) { case /* Pwith_type */0 : case /* Pwith_module */1 : lid = constr._0; @@ -81246,7 +82377,7 @@ function merge_constraint(initial_env, loc, sg, constr) { const sg = _sg; if (sg) { const item = sg.hd; - switch (item.TAG | 0) { + switch (item.TAG) { case /* Sig_type */1 : if (namelist && !namelist.tl) { const s = namelist.hd; @@ -81255,12 +82386,12 @@ function merge_constraint(initial_env, loc, sg, constr) { const decl = item._1; const id = item._0; let exit = 0; - switch (constr.TAG | 0) { + switch (constr.TAG) { case /* Pwith_type */0 : const sdecl = constr._1; let exit$1 = 0; - const match = sdecl.ptype_kind; - if (typeof match === "number" && !match) { + let tmp = sdecl.ptype_kind; + if (/* tag */(typeof tmp === "number" || typeof tmp === "string") && tmp === /* Ptype_abstract */0) { if (id.name === s && is_fixed_type(sdecl)) { const decl_row_type_params = Stdlib__List.map((function (param) { return newty2(100000000, { @@ -81453,13 +82584,13 @@ function merge_constraint(initial_env, loc, sg, constr) { if (namelist.tl) { exit$2 = 2; } else { - switch (constr.TAG | 0) { + switch (constr.TAG) { case /* Pwith_module */1 : const lid$p = constr._1; if (id$1.name === s$1) { - const match$1 = find_module$1(initial_env, loc, lid$p.txt); - const md$p = match$1[1]; - const path = match$1[0]; + const match = find_module$1(initial_env, loc, lid$p.txt); + const md$p = match[1]; + const path = match[0]; const md$p$p_md_type = remove_aliases$1(env, md$p.md_type); const md$p$p_md_attributes = md$p.md_attributes; const md$p$p_md_loc = md$p.md_loc; @@ -81503,9 +82634,9 @@ function merge_constraint(initial_env, loc, sg, constr) { case /* Pwith_modsubst */3 : const lid$p$1 = constr._1; if (id$1.name === s$1) { - const match$2 = find_module$1(initial_env, loc, lid$p$1.txt); - const path$1 = match$2[0]; - const newmd$1 = strengthen_decl(env, match$2[1], path$1); + const match$1 = find_module$1(initial_env, loc, lid$p$1.txt); + const path$1 = match$1[0]; + const newmd$1 = strengthen_decl(env, match$1[1], path$1); modtypes$1(env, newmd$1.md_type, md.md_type); real_id.contents = id$1; return [ @@ -81530,13 +82661,13 @@ function merge_constraint(initial_env, loc, sg, constr) { } } if (exit$2 === 2 && id$1.name === s$1) { - const match$3 = merge(env, extract_sig(env, loc, md.md_type), namelist.tl, undefined); - const match$4 = match$3[0]; + const match$2 = merge(env, extract_sig(env, loc, md.md_type), namelist.tl, undefined); + const match$3 = match$2[0]; return [ [ - path_concat(id$1, match$4[0]), + path_concat(id$1, match$3[0]), lid, - match$4[2] + match$3[2] ], { hd: { @@ -81545,7 +82676,7 @@ function merge_constraint(initial_env, loc, sg, constr) { _1: { md_type: { TAG: /* Mty_signature */1, - _0: match$3[1] + _0: match$2[1] }, md_attributes: md.md_attributes, md_loc: md.md_loc @@ -81562,12 +82693,12 @@ function merge_constraint(initial_env, loc, sg, constr) { default: } - const match$5 = merge(add_item(item, env), sg.tl, namelist, row_id); + const match$4 = merge(add_item(item, env), sg.tl, namelist, row_id); return [ - match$5[0], + match$4[0], { hd: item, - tl: match$5[1] + tl: match$4[1] } ]; } @@ -81588,7 +82719,7 @@ function merge_constraint(initial_env, loc, sg, constr) { const sg$1 = match[1]; let sg$2; if (names && !names.tl) { - switch (constr.TAG | 0) { + switch (constr.TAG) { case /* Pwith_type */0 : case /* Pwith_module */1 : sg$2 = sg$1; @@ -81614,7 +82745,7 @@ function merge_constraint(initial_env, loc, sg, constr) { const match$1 = sdecl.ptype_manifest; if (match$1 !== undefined) { const match$2 = match$1.ptyp_desc; - if (typeof match$2 === "number") { + if (/* tag */typeof match$2 === "number" || typeof match$2 === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { MEL_EXN_ID: Stdlib.Exit }); @@ -81624,14 +82755,14 @@ function merge_constraint(initial_env, loc, sg, constr) { if (Stdlib__List.length(stl) === Stdlib__List.length(sdecl.ptype_params)) { Stdlib__List.iter2((function (x, param) { const sx = x.ptyp_desc; - if (typeof sx === "number") { + if (/* tag */typeof sx === "number" || typeof sx === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { MEL_EXN_ID: Stdlib.Exit }); } if (sx.TAG === /* Ptyp_var */0) { const sy = param[0].ptyp_desc; - if (typeof sy === "number") { + if (/* tag */typeof sy === "number" || typeof sy === "string") { throw new Caml_js_exceptions.MelangeError(Stdlib.Exit, { MEL_EXN_ID: Stdlib.Exit }); @@ -81765,7 +82896,8 @@ function map_rec_type(rec_flag, fn, decls, rem) { if (!decls) { return rem; } - const first = rec_flag ? /* Trec_first */1 : /* Trec_not */0; + let first; + first = rec_flag === /* Nonrecursive */0 ? /* Trec_not */0 : /* Trec_first */1; return { hd: Curry._2(fn, first, decls.hd), tl: map_end(Curry._1(fn, /* Trec_next */2), decls.tl, rem) @@ -81815,7 +82947,7 @@ function approx_modtype(env, _smty) { while(true) { const smty = _smty; const lid = smty.pmty_desc; - switch (lid.TAG | 0) { + switch (lid.TAG) { case /* Pmty_ident */0 : const match = find_modtype$1(env, smty.pmty_loc, lid._0.txt); return { @@ -81880,7 +83012,7 @@ function approx_sig(_env, _ssg) { } const srem = ssg.tl; const sdecls = ssg.hd.psig_desc; - switch (sdecls.TAG | 0) { + switch (sdecls.TAG) { case /* Psig_type */1 : const sdecls$1 = sdecls._0; const rec_flag = rec_flag_of_ptype_declarations(sdecls$1); @@ -82028,17 +83160,20 @@ const funarg$7 = { }; function height$12(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$13(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; - return /* Node */{ + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; + return { + TAG: /* Node */0, l: l, v: v, r: r, @@ -82047,52 +83182,55 @@ function create$13(l, v, r) { } function bal$12(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const lv = l.v; - const ll = l.l; - if (height$12(ll) >= height$12(lr)) { - return create$13(ll, lv, create$13(lr, v, r)); - } - if (lr) { - return create$13(create$13(ll, lv, lr.l), lr.v, create$13(lr.r, v, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const lr = l.r; + const lv = l.v; + const ll = l.l; + if (height$12(ll) >= height$12(lr)) { + return create$13(ll, lv, create$13(lr, v, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$13(create$13(ll, lv, lr.l), lr.v, create$13(lr.r, v, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: v, r: r, h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rv = r.v; - const rl = r.l; - if (height$12(rr) >= height$12(rl)) { - return create$13(create$13(l, v, rl), rv, rr); - } - if (rl) { - return create$13(create$13(l, v, rl.l), rl.v, create$13(rl.r, rv, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const rr = r.r; + const rv = r.v; + const rl = r.l; + if (height$12(rr) >= height$12(rl)) { + return create$13(create$13(l, v, rl), rv, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$13(create$13(l, v, rl.l), rl.v, create$13(rl.r, rv, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" @@ -82100,8 +83238,9 @@ function bal$12(l, v, r) { } function add$14(x, t) { - if (!t) { - return /* Node */{ + if (/* tag */typeof t === "number" || typeof t === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -82134,7 +83273,7 @@ function add$14(x, t) { function mem$7(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(funarg$7.compare, x, param.v); @@ -82167,7 +83306,7 @@ function check_name(cl, set_ref, name) { } function check_sig_item(type_names, module_names, modtype_names, loc, param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Sig_type */1 : return check("type", loc, type_names, param._0.name); case /* Sig_module */3 : @@ -82186,7 +83325,7 @@ function remove_duplicates(val_ids, ext_ids, _param) { return /* [] */0; } const f = param.hd; - switch (f.TAG | 0) { + switch (f.TAG) { case /* Sig_value */0 : const id = f._0; if (Stdlib__List.exists((function (param) { @@ -82199,34 +83338,48 @@ function remove_duplicates(val_ids, ext_ids, _param) { case /* Sig_typext */2 : const id$1 = f._0; let exit = 0; - if (f._2) { - exit = 2; - } else { - const match = param.tl; - if (match) { - const match$1 = match.hd; - if (match$1.TAG === /* Sig_typext */2 && match$1._2 === 1) { - if (Stdlib__List.exists((function (param) { - return equal(id$1, param); - }), ext_ids)) { - _param = { - hd: { - TAG: /* Sig_typext */2, - _0: match$1._0, - _1: match$1._1, - _2: /* Text_first */0 - }, - tl: match.tl - }; - continue ; + switch (f._2) { + case /* Text_first */0 : + const match = param.tl; + if (match) { + const match$1 = match.hd; + if (match$1.TAG === /* Sig_typext */2) { + switch (match$1._2) { + case /* Text_next */1 : + if (Stdlib__List.exists((function (param) { + return equal(id$1, param); + }), ext_ids)) { + _param = { + hd: { + TAG: /* Sig_typext */2, + _0: match$1._0, + _1: match$1._1, + _2: /* Text_first */0 + }, + tl: match.tl + }; + continue ; + } + exit = 2; + break; + case /* Text_first */0 : + case /* Text_exception */2 : + exit = 2; + break; + + } + } else { + exit = 2; + } + } else { + exit = 2; } + break; + case /* Text_next */1 : + case /* Text_exception */2 : exit = 2; - } else { - exit = 2; - } - } else { - exit = 2; - } + break; + } if (exit === 2 && Stdlib__List.exists((function (param) { return equal(id$1, param); @@ -82320,7 +83473,7 @@ function mksig$1(desc, env, loc) { function transl_modtype$1(env, smty) { const loc = smty.pmty_loc; const lid = smty.pmty_desc; - switch (lid.TAG | 0) { + switch (lid.TAG) { case /* Pmty_ident */0 : const lid$1 = lid._0; const path = transl_modtype_longident$1(loc, env, lid$1.txt); @@ -82442,7 +83595,7 @@ function transl_signature(env, sg) { const item = sg.hd; const loc = item.psig_loc; const sdesc = item.psig_desc; - switch (sdesc.TAG | 0) { + switch (sdesc.TAG) { case /* Psig_value */0 : const match = transl_value_decl(env, item.psig_loc, sdesc._0); const tdesc = match[0]; @@ -82954,7 +84107,7 @@ function simplify_signature(sg) { ]; } const component = param.hd; - switch (component.TAG | 0) { + switch (component.TAG) { case /* Sig_value */0 : const k = aux(param.tl); const val_names = k[1]; @@ -82987,29 +84140,39 @@ function simplify_signature(sg) { Curry._2(add$14, name$1, ext_names) ]; } - if (component._2) { - return k$1; - } - if (!sg) { - return k$1; - } - const match = sg.hd; - if (match.TAG === /* Sig_typext */2 && match._2 === 1) { - return [ - { - hd: { - TAG: /* Sig_typext */2, - _0: match._0, - _1: match._1, - _2: /* Text_first */0 - }, - tl: sg.tl - }, - val_names$1, - ext_names - ]; - } else { - return k$1; + switch (component._2) { + case /* Text_first */0 : + if (!sg) { + return k$1; + } + const match = sg.hd; + if (match.TAG !== /* Sig_typext */2) { + return k$1; + } + switch (match._2) { + case /* Text_next */1 : + return [ + { + hd: { + TAG: /* Sig_typext */2, + _0: match._0, + _1: match._1, + _2: /* Text_first */0 + }, + tl: sg.tl + }, + val_names$1, + ext_names + ]; + case /* Text_first */0 : + case /* Text_exception */2 : + return k$1; + + } + case /* Text_next */1 : + case /* Text_exception */2 : + return k$1; + } default: const match$1 = aux(param.tl); @@ -83032,7 +84195,7 @@ function path_of_module(_mexp) { while(true) { const mexp = _mexp; const match = mexp.mod_desc; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tmod_ident */0 : return match._0; case /* Tmod_apply */3 : @@ -83073,7 +84236,7 @@ function path_of_module$1(mexp) { function closed_modtype(_p) { while(true) { const p = _p; - switch (p.TAG | 0) { + switch (p.TAG) { case /* Mty_signature */1 : return Stdlib__List.for_all(closed_signature_item, p._0); case /* Mty_functor */2 : @@ -83088,7 +84251,7 @@ function closed_modtype(_p) { } function closed_signature_item(param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Sig_value */0 : return closed_schema(param._1.val_type); case /* Sig_module */3 : @@ -83211,7 +84374,8 @@ function check_recmodule_inclusion(env, bindings) { TAG: /* Tmod_constraint */4, _0: modl, _1: mty_decl.mty_type, - _2: /* Tmodtype_explicit */{ + _2: { + TAG: /* Tmodtype_explicit */0, _0: mty_decl }, _3: coercion @@ -83243,7 +84407,7 @@ function package_constraints(env, loc, mty, constrs) { } const sg = extract_sig(env, loc, mty); const sg$p = Stdlib__List.map((function (item) { - switch (item.TAG | 0) { + switch (item.TAG) { case /* Sig_type */1 : const td = item._1; if (td.type_params) { @@ -83441,7 +84605,7 @@ function wrap_constraint(env, arg, mty, explicit) { function type_module$1(aliasOpt, sttn, funct_body, anchor, env, smod) { const alias = aliasOpt !== undefined ? aliasOpt : false; const lid = smod.pmod_desc; - switch (lid.TAG | 0) { + switch (lid.TAG) { case /* Pmod_ident */0 : const lid$1 = lid._0; const path = lookup_module$1(!alias, env, smod.pmod_loc, lid$1.txt); @@ -83706,7 +84870,8 @@ function type_module$1(aliasOpt, sttn, funct_body, anchor, env, smod) { case /* Pmod_constraint */4 : const arg$1 = type_module$1(alias, true, funct_body, anchor, env, lid._0); const mty$3 = transl_modtype$1(env, lid._1); - const init = wrap_constraint(env, arg$1, mty$3.mty_type, /* Tmodtype_explicit */{ + const init = wrap_constraint(env, arg$1, mty$3.mty_type, { + TAG: /* Tmodtype_explicit */0, _0: mty$3 }); const node_mod_desc$3 = init.mod_desc; @@ -83739,10 +84904,10 @@ function type_module$1(aliasOpt, sttn, funct_body, anchor, env, smod) { let mty$4; let exit$1 = 0; const match$4 = match$3.desc; - if (typeof match$4 === "number") { + if (/* tag */typeof match$4 === "number" || typeof match$4 === "string") { exit$1 = 1; } else { - switch (match$4.TAG | 0) { + switch (match$4.TAG) { case /* Tvar */0 : throw new Caml_js_exceptions.MelangeError($$Error$7, { MEL_EXN_ID: $$Error$7, @@ -83838,7 +85003,7 @@ function type_structure(toplevelOpt, funct_body, anchor, env, sstr, scope) { const type_str_item = function (env, srem, param) { const loc = param.pstr_loc; const desc = param.pstr_desc; - switch (desc.TAG | 0) { + switch (desc.TAG) { case /* Pstr_eval */0 : const expr = type_expression(env, desc._0); return [ @@ -83853,21 +85018,21 @@ function type_structure(toplevelOpt, funct_body, anchor, env, sstr, scope) { case /* Pstr_value */1 : const rec_flag = desc._0; let scope$1; - if (rec_flag) { + if (rec_flag === /* Nonrecursive */0) { + const start = srem ? srem.hd.pstr_loc.loc_start : loc.loc_end; scope$1 = { TAG: /* Idef */1, _0: { - loc_start: loc.loc_start, + loc_start: start, loc_end: scope.loc_end, loc_ghost: scope.loc_ghost } }; } else { - const start = srem ? srem.hd.pstr_loc.loc_start : loc.loc_end; scope$1 = { TAG: /* Idef */1, _0: { - loc_start: start, + loc_start: loc.loc_start, loc_end: scope.loc_end, loc_ghost: scope.loc_ghost } @@ -84236,15 +85401,17 @@ function type_structure(toplevelOpt, funct_body, anchor, env, sstr, scope) { contents: 0 }; sg$1 = Stdlib__List.map((function (it) { - switch (it.TAG | 0) { + switch (it.TAG) { case /* Sig_value */0 : - const match = it._1.val_kind; - if (typeof match === "number" && !match) { - pos.contents = pos.contents + 1 | 0; + let tmp = it._1.val_kind; + if (!/* tag */(typeof tmp === "number" || typeof tmp === "string")) { return it; - } else { + } + if (tmp !== /* Val_reg */0) { return it; } + pos.contents = pos.contents + 1 | 0; + return it; case /* Sig_module */3 : const md = it._1; const id = it._0; @@ -84409,14 +85576,14 @@ function type_structure$1(param, param$1, param$2) { function normalize_signature(env) { return function (param) { return Stdlib__List.iter((function (param) { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Sig_value */0 : return normalize_type(env, param._1.val_type); case /* Sig_module */3 : let _p = param._1.md_type; while(true) { const p = _p; - switch (p.TAG | 0) { + switch (p.TAG) { case /* Mty_signature */1 : return normalize_signature(env)(p._0); case /* Mty_functor */2 : @@ -84511,7 +85678,7 @@ function type_package$1(env, m, p, nl, tl) { const env$1 = match$1[1]; const mp = match$1[0]; const mkpath = function (mp, name) { - switch (name.TAG | 0) { + switch (name.TAG) { case /* Lident */0 : return { TAG: /* Pdot */1, @@ -84613,7 +85780,8 @@ function type_implementation_more(sourcefile, outputprefix, modulename, initial_ const simple_sg = simplify_signature(sg); if (print_types.contents) { wrap_printing_env(initial_env, (function (param) { - Curry._2(Stdlib__Format.fprintf(Stdlib__Format.std_formatter)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(Stdlib__Format.std_formatter)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -84670,7 +85838,7 @@ function type_implementation_more(sourcefile, outputprefix, modulename, initial_ } Stdlib__List.iter((function (param) { const match = param.str_desc; - switch (match.TAG | 0) { + switch (match.TAG) { case /* Tstr_value */1 : return Stdlib__List.iter((function (param) { const exp = param.vb_expr; @@ -84750,10 +85918,11 @@ register_error_of_exn(function (err) { const env = err._2; return error_of_printer(err._1, (function (param, param$1) { return wrap_printing_env(env, (function (param$2) { - if (typeof param$1 === "number") { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { switch (param$1) { case /* Signature_expected */0 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This module type is not a signature", @@ -84762,12 +85931,14 @@ register_error_of_exn(function (err) { _1: "This module type is not a signature" }); case /* Not_allowed_in_functor_body */1 : - return Curry._1(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -84798,7 +85969,8 @@ register_error_of_exn(function (err) { _1: "@[This expression creates fresh types.@ %s@]" }), "It is not allowed inside applicative functors."); case /* With_need_typeconstr */2 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Only type constructors with identical parameters can be substituted.", @@ -84807,7 +85979,8 @@ register_error_of_exn(function (err) { _1: "Only type constructors with identical parameters can be substituted." }); case /* Recursive_module_require_explicit_type */3 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Recursive modules require an explicit module type.", @@ -84816,7 +85989,8 @@ register_error_of_exn(function (err) { _1: "Recursive modules require an explicit module type." }); case /* Apply_generative */4 : - return Stdlib__Format.fprintf(param)(/* Format */{ + return Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This is a generative functor. It can only be applied to ()", @@ -84827,14 +86001,16 @@ register_error_of_exn(function (err) { } } else { - switch (param$1.TAG | 0) { + switch (param$1.TAG) { case /* Cannot_apply */0 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -84864,12 +86040,14 @@ register_error_of_exn(function (err) { _1: "@[This module is not a functor; it has type@ %a@]" }), modtype$1, param$1._0); case /* Not_included */1 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -84903,12 +86081,14 @@ register_error_of_exn(function (err) { _1: "@[Signature mismatch:@ %a@]" }), report_error$4, param$1._0); case /* Cannot_eliminate_dependency */2 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -84964,12 +86144,14 @@ register_error_of_exn(function (err) { _1: "@[This functor has type@ %a@ The parameter cannot be eliminated in the result type.@ Please bind the argument to a module identifier.@]" }), modtype$1, param$1._0); case /* Structure_expected */3 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -84995,12 +86177,14 @@ register_error_of_exn(function (err) { _1: "@[This module is not a structure; it has type@ %a" }), modtype$1, param$1._0); case /* With_no_component */4 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -85021,12 +86205,14 @@ register_error_of_exn(function (err) { _1: "@[The signature constrained by `with' has no component named %a@]" }), longident, param$1._0); case /* With_mismatch */5 : - return Curry._4(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._4(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -85039,7 +86225,8 @@ register_error_of_exn(function (err) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -85103,12 +86290,14 @@ register_error_of_exn(function (err) { _1: "@[@[In this `with' constraint, the new definition of %a@ does not match its original definition@ in the constrained signature:@]@ %a@]" }), longident, param$1._0, report_error$4, param$1._1); case /* Repeated_name */6 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -85155,12 +86344,14 @@ register_error_of_exn(function (err) { _1: "@[Multiple definition of the %s name %s.@ Names must be unique in a given structure or signature.@]" }), param$1._0, param$1._1); case /* Non_generalizable */7 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -85208,12 +86399,14 @@ register_error_of_exn(function (err) { }), type_scheme, param$1._0); case /* Non_generalizable_class */8 : const id = param$1._0; - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -85262,12 +86455,14 @@ register_error_of_exn(function (err) { return class_declaration$1(id, param, param$1); }), param$1._1); case /* Non_generalizable_module */9 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -85314,12 +86509,14 @@ register_error_of_exn(function (err) { _1: "@[The type of this module,@ %a,@ contains type variables that cannot be generalized@]" }), modtype$1, param$1._0); case /* Implementation_is_required */10 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -85366,12 +86563,14 @@ register_error_of_exn(function (err) { _1: "@[The interface %a@ declares values, not just types.@ An implementation must be provided.@]" }), print_filename, param$1._0); case /* Interface_not_compiled */11 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -85405,7 +86604,8 @@ register_error_of_exn(function (err) { _1: "@[Could not find the .cmi file for interface@ %a.@]" }), print_filename, param$1._0); case /* Not_a_packed_module */12 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This expression is not a packed module. It has type", @@ -85426,7 +86626,8 @@ register_error_of_exn(function (err) { _1: "This expression is not a packed module. It has type@ %a" }), type_expr$1, param$1._0); case /* Incomplete_packed_module */13 : - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The type of this packed module contains variables:", @@ -85447,7 +86648,8 @@ register_error_of_exn(function (err) { _1: "The type of this packed module contains variables:@ %a" }), type_expr$1, param$1._0); case /* Scoping_pack */14 : - Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "The type ", @@ -85471,7 +86673,8 @@ register_error_of_exn(function (err) { }, _1: "The type %a in this module cannot be exported.@ " }), longident, param$1._0); - return Curry._2(Stdlib__Format.fprintf(param)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(param)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Its type contains local dependencies:", @@ -85567,228 +86770,228 @@ if (match$1) { if (match$12.type_params || match$12.type_arity !== 0) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$13 = match$12.type_kind; - if (typeof match$13 === "number" && !(match$13 || !(match$12.type_private && !(match$12.type_manifest !== undefined || match$12.type_variance || match$12.type_newtype_level !== undefined)))) { - const match$14 = match$12.type_loc; - const match$15 = match$14.loc_start; - if (match$15.pos_fname === "" && !(match$15.pos_lnum !== 2 || match$15.pos_bol !== 1 || match$15.pos_cnum !== 1)) { - const match$16 = match$14.loc_end; - if (match$16.pos_fname === "" && !(match$16.pos_lnum !== 2 || match$16.pos_bol !== 1 || match$16.pos_cnum !== 9 || match$14.loc_ghost || match$12.type_attributes || match$5.typ_cstrs)) { - const match$17 = match$5.typ_kind; - if (typeof match$17 === "number" && !(match$17 || !(match$5.typ_private && match$5.typ_manifest === undefined))) { - const match$18 = match$5.typ_loc; - const match$19 = match$18.loc_start; - if (match$19.pos_fname === "" && !(match$19.pos_lnum !== 2 || match$19.pos_bol !== 1 || match$19.pos_cnum !== 1)) { - const match$20 = match$18.loc_end; - if (match$20.pos_fname === "" && !(match$20.pos_lnum !== 2 || match$20.pos_bol !== 1 || match$20.pos_cnum !== 9 || match$18.loc_ghost || match$5.typ_attributes || match$4.tl)) { - const match$21 = match$2.str_loc; - const match$22 = match$21.loc_start; - if (match$22.pos_fname === "" && !(match$22.pos_lnum !== 2 || match$22.pos_bol !== 1 || match$22.pos_cnum !== 1)) { - const match$23 = match$21.loc_end; - if (match$23.pos_fname === "" && !(match$23.pos_lnum !== 2 || match$23.pos_bol !== 1 || match$23.pos_cnum !== 9 || match$21.loc_ghost)) { - const match$24 = match$1.tl; - if (match$24) { - const match$25 = match$24.hd.str_desc; - if (match$25.TAG === /* Tstr_primitive */2) { - const match$26 = match$25._0; - const match$27 = match$26.val_id; - if (match$27.name === "~-") { - const match$28 = match$27.flags; - if (match$28 !== 0) { + let tmp$1 = match$12.type_kind; + if (/* tag */(typeof tmp$1 === "number" || typeof tmp$1 === "string") && tmp$1 === /* Type_abstract */0 && !(match$12.type_private === /* Private */0 || match$12.type_manifest !== undefined || match$12.type_variance || match$12.type_newtype_level !== undefined)) { + const match$13 = match$12.type_loc; + const match$14 = match$13.loc_start; + if (match$14.pos_fname === "" && !(match$14.pos_lnum !== 2 || match$14.pos_bol !== 1 || match$14.pos_cnum !== 1)) { + const match$15 = match$13.loc_end; + if (match$15.pos_fname === "" && !(match$15.pos_lnum !== 2 || match$15.pos_bol !== 1 || match$15.pos_cnum !== 9 || match$13.loc_ghost || match$12.type_attributes || match$5.typ_cstrs)) { + let tmp$2 = match$5.typ_kind; + if (/* tag */(typeof tmp$2 === "number" || typeof tmp$2 === "string") && tmp$2 === /* Ttype_abstract */0 && !(match$5.typ_private === /* Private */0 || match$5.typ_manifest !== undefined)) { + const match$16 = match$5.typ_loc; + const match$17 = match$16.loc_start; + if (match$17.pos_fname === "" && !(match$17.pos_lnum !== 2 || match$17.pos_bol !== 1 || match$17.pos_cnum !== 1)) { + const match$18 = match$16.loc_end; + if (match$18.pos_fname === "" && !(match$18.pos_lnum !== 2 || match$18.pos_bol !== 1 || match$18.pos_cnum !== 9 || match$16.loc_ghost || match$5.typ_attributes || match$4.tl)) { + const match$19 = match$2.str_loc; + const match$20 = match$19.loc_start; + if (match$20.pos_fname === "" && !(match$20.pos_lnum !== 2 || match$20.pos_bol !== 1 || match$20.pos_cnum !== 1)) { + const match$21 = match$19.loc_end; + if (match$21.pos_fname === "" && !(match$21.pos_lnum !== 2 || match$21.pos_bol !== 1 || match$21.pos_cnum !== 9 || match$19.loc_ghost)) { + const match$22 = match$1.tl; + if (match$22) { + const match$23 = match$22.hd.str_desc; + if (match$23.TAG === /* Tstr_primitive */2) { + const match$24 = match$23._0; + const match$25 = match$24.val_id; + if (match$25.name === "~-") { + const match$26 = match$25.flags; + if (match$26 !== 0) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$29 = match$26.val_name; - if (match$29.txt === "~-") { - const match$30 = match$29.loc; - const match$31 = match$30.loc_start; - if (match$31.pos_fname === "" && !(match$31.pos_lnum !== 3 || match$31.pos_bol !== 10 || match$31.pos_cnum !== 19)) { - const match$32 = match$30.loc_end; - if (match$32.pos_fname === "" && !(match$32.pos_lnum !== 3 || match$32.pos_bol !== 10 || match$32.pos_cnum !== 25 || match$30.loc_ghost)) { - const match$33 = match$26.val_desc; - const match$34 = match$33.ctyp_desc; - if (typeof match$34 === "number" || !(match$34.TAG === /* Ttyp_arrow */1 && match$34._0 === "")) { + const match$27 = match$24.val_name; + if (match$27.txt === "~-") { + const match$28 = match$27.loc; + const match$29 = match$28.loc_start; + if (match$29.pos_fname === "" && !(match$29.pos_lnum !== 3 || match$29.pos_bol !== 10 || match$29.pos_cnum !== 19)) { + const match$30 = match$28.loc_end; + if (match$30.pos_fname === "" && !(match$30.pos_lnum !== 3 || match$30.pos_bol !== 10 || match$30.pos_cnum !== 25 || match$28.loc_ghost)) { + const match$31 = match$24.val_desc; + const match$32 = match$31.ctyp_desc; + if (/* tag */typeof match$32 === "number" || typeof match$32 === "string" || !(match$32.TAG === /* Ttyp_arrow */1 && match$32._0 === "")) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$35 = match$34._1; - const match$36 = match$35.ctyp_desc; - if (typeof match$36 === "number" || match$36.TAG !== /* Ttyp_constr */3) { + const match$33 = match$32._1; + const match$34 = match$33.ctyp_desc; + if (/* tag */typeof match$34 === "number" || typeof match$34 === "string" || match$34.TAG !== /* Ttyp_constr */3) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$37 = match$36._0; - switch (match$37.TAG | 0) { + const match$35 = match$34._0; + switch (match$35.TAG) { case /* Pident */0 : - const match$38 = match$37._0; - if (match$38.name === "int") { - const match$39 = match$38.flags; - if (match$39 !== 0) { + const match$36 = match$35._0; + if (match$36.name === "int") { + const match$37 = match$36.flags; + if (match$37 !== 0) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$40 = match$36._1; - const match$41 = match$40.txt; - switch (match$41.TAG | 0) { + const match$38 = match$34._1; + const match$39 = match$38.txt; + switch (match$39.TAG) { case /* Lident */0 : - if (match$41._0 === "int") { - const match$42 = match$40.loc; - const match$43 = match$42.loc_start; - if (match$43.pos_fname === "" && !(match$43.pos_lnum !== 3 || match$43.pos_bol !== 10 || match$43.pos_cnum !== 28)) { - const match$44 = match$42.loc_end; - if (match$44.pos_fname === "" && !(match$44.pos_lnum !== 3 || match$44.pos_bol !== 10 || match$44.pos_cnum !== 31 || match$42.loc_ghost || match$36._2)) { - const match$45 = match$35.ctyp_type; - const match$46 = match$45.desc; - if (typeof match$46 === "number" || match$46.TAG !== /* Tconstr */3) { + if (match$39._0 === "int") { + const match$40 = match$38.loc; + const match$41 = match$40.loc_start; + if (match$41.pos_fname === "" && !(match$41.pos_lnum !== 3 || match$41.pos_bol !== 10 || match$41.pos_cnum !== 28)) { + const match$42 = match$40.loc_end; + if (match$42.pos_fname === "" && !(match$42.pos_lnum !== 3 || match$42.pos_bol !== 10 || match$42.pos_cnum !== 31 || match$40.loc_ghost || match$34._2)) { + const match$43 = match$33.ctyp_type; + const match$44 = match$43.desc; + if (/* tag */typeof match$44 === "number" || typeof match$44 === "string" || match$44.TAG !== /* Tconstr */3) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$47 = match$46._0; - switch (match$47.TAG | 0) { + const match$45 = match$44._0; + switch (match$45.TAG) { case /* Pident */0 : - const match$48 = match$47._0; - if (match$48.name === "int") { - const match$49 = match$48.flags; - if (match$49 !== 0 || match$46._1) { + const match$46 = match$45._0; + if (match$46.name === "int") { + const match$47 = match$46.flags; + if (match$47 !== 0 || match$44._1) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$50 = match$46._2.contents; - if (typeof match$50 === "number") { - const match$51 = match$35.ctyp_loc; - const match$52 = match$51.loc_start; - if (match$52.pos_fname === "" && !(match$52.pos_lnum !== 3 || match$52.pos_bol !== 10 || match$52.pos_cnum !== 28)) { - const match$53 = match$51.loc_end; - if (match$53.pos_fname === "" && !(match$53.pos_lnum !== 3 || match$53.pos_bol !== 10 || match$53.pos_cnum !== 31 || match$51.loc_ghost || match$35.ctyp_attributes)) { - const match$54 = match$34._2; - const match$55 = match$54.ctyp_desc; - if (typeof match$55 === "number" || match$55.TAG !== /* Ttyp_constr */3) { + const match$48 = match$44._2.contents; + if (/* tag */typeof match$48 === "number" || typeof match$48 === "string") { + const match$49 = match$33.ctyp_loc; + const match$50 = match$49.loc_start; + if (match$50.pos_fname === "" && !(match$50.pos_lnum !== 3 || match$50.pos_bol !== 10 || match$50.pos_cnum !== 28)) { + const match$51 = match$49.loc_end; + if (match$51.pos_fname === "" && !(match$51.pos_lnum !== 3 || match$51.pos_bol !== 10 || match$51.pos_cnum !== 31 || match$49.loc_ghost || match$33.ctyp_attributes)) { + const match$52 = match$32._2; + const match$53 = match$52.ctyp_desc; + if (/* tag */typeof match$53 === "number" || typeof match$53 === "string" || match$53.TAG !== /* Ttyp_constr */3) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$56 = match$55._0; - switch (match$56.TAG | 0) { + const match$54 = match$53._0; + switch (match$54.TAG) { case /* Pident */0 : - const match$57 = match$56._0; - if (match$57.name === "int") { - const match$58 = match$57.flags; - if (match$58 !== 0) { + const match$55 = match$54._0; + if (match$55.name === "int") { + const match$56 = match$55.flags; + if (match$56 !== 0) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$59 = match$55._1; - const match$60 = match$59.txt; - switch (match$60.TAG | 0) { + const match$57 = match$53._1; + const match$58 = match$57.txt; + switch (match$58.TAG) { case /* Lident */0 : - if (match$60._0 === "int") { - const match$61 = match$59.loc; - const match$62 = match$61.loc_start; - if (match$62.pos_fname === "" && !(match$62.pos_lnum !== 3 || match$62.pos_bol !== 10 || match$62.pos_cnum !== 35)) { - const match$63 = match$61.loc_end; - if (match$63.pos_fname === "" && !(match$63.pos_lnum !== 3 || match$63.pos_bol !== 10 || match$63.pos_cnum !== 38 || match$61.loc_ghost || match$55._2)) { - const match$64 = match$54.ctyp_type; - const match$65 = match$64.desc; - if (typeof match$65 === "number" || match$65.TAG !== /* Tconstr */3) { + if (match$58._0 === "int") { + const match$59 = match$57.loc; + const match$60 = match$59.loc_start; + if (match$60.pos_fname === "" && !(match$60.pos_lnum !== 3 || match$60.pos_bol !== 10 || match$60.pos_cnum !== 35)) { + const match$61 = match$59.loc_end; + if (match$61.pos_fname === "" && !(match$61.pos_lnum !== 3 || match$61.pos_bol !== 10 || match$61.pos_cnum !== 38 || match$59.loc_ghost || match$53._2)) { + const match$62 = match$52.ctyp_type; + const match$63 = match$62.desc; + if (/* tag */typeof match$63 === "number" || typeof match$63 === "string" || match$63.TAG !== /* Tconstr */3) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$66 = match$65._0; - switch (match$66.TAG | 0) { + const match$64 = match$63._0; + switch (match$64.TAG) { case /* Pident */0 : - const match$67 = match$66._0; - if (match$67.name === "int") { - const match$68 = match$67.flags; - if (match$68 !== 0 || match$65._1) { + const match$65 = match$64._0; + if (match$65.name === "int") { + const match$66 = match$65.flags; + if (match$66 !== 0 || match$63._1) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$69 = match$65._2.contents; - if (typeof match$69 === "number") { - const match$70 = match$54.ctyp_loc; - const match$71 = match$70.loc_start; - if (match$71.pos_fname === "" && !(match$71.pos_lnum !== 3 || match$71.pos_bol !== 10 || match$71.pos_cnum !== 35)) { - const match$72 = match$70.loc_end; - if (match$72.pos_fname === "" && !(match$72.pos_lnum !== 3 || match$72.pos_bol !== 10 || match$72.pos_cnum !== 38 || match$70.loc_ghost || match$54.ctyp_attributes)) { - const match$73 = match$33.ctyp_type; - const match$74 = match$73.desc; - if (typeof match$74 === "number" || !(match$74.TAG === /* Tarrow */1 && match$74._0 === "")) { + const match$67 = match$63._2.contents; + if (/* tag */typeof match$67 === "number" || typeof match$67 === "string") { + const match$68 = match$52.ctyp_loc; + const match$69 = match$68.loc_start; + if (match$69.pos_fname === "" && !(match$69.pos_lnum !== 3 || match$69.pos_bol !== 10 || match$69.pos_cnum !== 35)) { + const match$70 = match$68.loc_end; + if (match$70.pos_fname === "" && !(match$70.pos_lnum !== 3 || match$70.pos_bol !== 10 || match$70.pos_cnum !== 38 || match$68.loc_ghost || match$52.ctyp_attributes)) { + const match$71 = match$31.ctyp_type; + const match$72 = match$71.desc; + if (/* tag */typeof match$72 === "number" || typeof match$72 === "string" || !(match$72.TAG === /* Tarrow */1 && match$72._0 === "")) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$75 = match$74._1.desc; - if (typeof match$75 === "number" || match$75.TAG !== /* Tconstr */3) { + const match$73 = match$72._1.desc; + if (/* tag */typeof match$73 === "number" || typeof match$73 === "string" || match$73.TAG !== /* Tconstr */3) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$76 = match$75._0; - switch (match$76.TAG | 0) { + const match$74 = match$73._0; + switch (match$74.TAG) { case /* Pident */0 : - const match$77 = match$76._0; - if (match$77.name === "int") { - const match$78 = match$77.flags; - if (match$78 !== 0 || match$75._1) { + const match$75 = match$74._0; + if (match$75.name === "int") { + const match$76 = match$75.flags; + if (match$76 !== 0 || match$73._1) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$79 = match$75._2.contents; - if (typeof match$79 === "number") { - const match$80 = match$74._2.desc; - if (typeof match$80 === "number" || match$80.TAG !== /* Tconstr */3) { + const match$77 = match$73._2.contents; + if (/* tag */typeof match$77 === "number" || typeof match$77 === "string") { + const match$78 = match$72._2.desc; + if (/* tag */typeof match$78 === "number" || typeof match$78 === "string" || match$78.TAG !== /* Tconstr */3) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$81 = match$80._0; - switch (match$81.TAG | 0) { + const match$79 = match$78._0; + switch (match$79.TAG) { case /* Pident */0 : - const match$82 = match$81._0; - if (match$82.name === "int") { - const match$83 = match$82.flags; - if (match$83 !== 0 || match$80._1) { + const match$80 = match$79._0; + if (match$80.name === "int") { + const match$81 = match$80.flags; + if (match$81 !== 0 || match$78._1) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$84 = match$80._2.contents; - if (typeof match$84 === "number") { - const match$85 = match$74._3; - if (typeof match$85 === "number" && !match$85) { - const match$86 = match$33.ctyp_loc; - const match$87 = match$86.loc_start; - if (match$87.pos_fname === "" && !(match$87.pos_lnum !== 3 || match$87.pos_bol !== 10 || match$87.pos_cnum !== 28)) { - const match$88 = match$86.loc_end; - if (match$88.pos_fname === "" && !(match$88.pos_lnum !== 3 || match$88.pos_bol !== 10 || match$88.pos_cnum !== 38 || match$86.loc_ghost || match$33.ctyp_attributes)) { - const match$89 = match$26.val_val; - const match$90 = match$89.val_type.desc; - if (typeof match$90 === "number" || !(match$90.TAG === /* Tarrow */1 && match$90._0 === "")) { + const match$82 = match$78._2.contents; + if (/* tag */typeof match$82 === "number" || typeof match$82 === "string") { + let tmp$3 = match$72._3; + if (/* tag */(typeof tmp$3 === "number" || typeof tmp$3 === "string") && tmp$3 === /* Cok */0) { + const match$83 = match$31.ctyp_loc; + const match$84 = match$83.loc_start; + if (match$84.pos_fname === "" && !(match$84.pos_lnum !== 3 || match$84.pos_bol !== 10 || match$84.pos_cnum !== 28)) { + const match$85 = match$83.loc_end; + if (match$85.pos_fname === "" && !(match$85.pos_lnum !== 3 || match$85.pos_bol !== 10 || match$85.pos_cnum !== 38 || match$83.loc_ghost || match$31.ctyp_attributes)) { + const match$86 = match$24.val_val; + const match$87 = match$86.val_type.desc; + if (/* tag */typeof match$87 === "number" || typeof match$87 === "string" || !(match$87.TAG === /* Tarrow */1 && match$87._0 === "")) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$91 = match$90._1.desc; - if (typeof match$91 === "number" || match$91.TAG !== /* Tconstr */3) { + const match$88 = match$87._1.desc; + if (/* tag */typeof match$88 === "number" || typeof match$88 === "string" || match$88.TAG !== /* Tconstr */3) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$92 = match$91._0; - switch (match$92.TAG | 0) { + const match$89 = match$88._0; + switch (match$89.TAG) { case /* Pident */0 : - const match$93 = match$92._0; - if (match$93.name === "int") { - const match$94 = match$93.flags; - if (match$94 !== 0 || match$91._1) { + const match$90 = match$89._0; + if (match$90.name === "int") { + const match$91 = match$90.flags; + if (match$91 !== 0 || match$88._1) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$95 = match$91._2.contents; - if (typeof match$95 === "number") { - const match$96 = match$90._2.desc; - if (typeof match$96 === "number" || match$96.TAG !== /* Tconstr */3) { + const match$92 = match$88._2.contents; + if (/* tag */typeof match$92 === "number" || typeof match$92 === "string") { + const match$93 = match$87._2.desc; + if (/* tag */typeof match$93 === "number" || typeof match$93 === "string" || match$93.TAG !== /* Tconstr */3) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$97 = match$96._0; - switch (match$97.TAG | 0) { + const match$94 = match$93._0; + switch (match$94.TAG) { case /* Pident */0 : - const match$98 = match$97._0; - if (match$98.name === "int") { - const match$99 = match$98.flags; - if (match$99 !== 0 || match$96._1) { + const match$95 = match$94._0; + if (match$95.name === "int") { + const match$96 = match$95.flags; + if (match$96 !== 0 || match$93._1) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$100 = match$96._2.contents; - if (typeof match$100 === "number") { - const match$101 = match$90._3; - if (typeof match$101 === "number" && !match$101) { - const match$102 = match$89.val_kind; - if (typeof match$102 === "number" || match$102.TAG !== /* Val_prim */0) { + const match$97 = match$93._2.contents; + if (/* tag */typeof match$97 === "number" || typeof match$97 === "string") { + let tmp$4 = match$87._3; + if (/* tag */(typeof tmp$4 === "number" || typeof tmp$4 === "string") && tmp$4 === /* Cok */0) { + const match$98 = match$86.val_kind; + if (/* tag */typeof match$98 === "number" || typeof match$98 === "string" || match$98.TAG !== /* Val_prim */0) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); } else { - const match$103 = match$102._0; - if (match$103.prim_name === "%negint" && !(match$103.prim_arity !== 1 || !(match$103.prim_alloc && match$103.prim_native_name === "" && !match$103.prim_native_float))) { - const match$104 = match$89.val_loc; - const match$105 = match$104.loc_start; - if (match$105.pos_fname === "" && !(match$105.pos_lnum !== 3 || match$105.pos_bol !== 10 || match$105.pos_cnum !== 10)) { - const match$106 = match$104.loc_end; - if (match$106.pos_fname === "" && !(match$106.pos_lnum !== 3 || match$106.pos_bol !== 10 || match$106.pos_cnum !== 50 || match$104.loc_ghost || match$89.val_attributes)) { + const match$99 = match$98._0; + if (match$99.prim_name === "%negint" && !(match$99.prim_arity !== 1 || !(match$99.prim_alloc && match$99.prim_native_name === "" && !match$99.prim_native_float))) { + const match$100 = match$86.val_loc; + const match$101 = match$100.loc_start; + if (match$101.pos_fname === "" && !(match$101.pos_lnum !== 3 || match$101.pos_bol !== 10 || match$101.pos_cnum !== 10)) { + const match$102 = match$100.loc_end; + if (match$102.pos_fname === "" && !(match$102.pos_lnum !== 3 || match$102.pos_bol !== 10 || match$102.pos_cnum !== 50 || match$100.loc_ghost || match$86.val_attributes)) { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52028, characters 14-21", true, true); } else { eq("File \"jscomp/test/ocaml_typedtree_test.ml\", line 52029, characters 12-19", true, false); diff --git a/jscomp/test/dist/jscomp/test/offset.js b/jscomp/test/dist/jscomp/test/offset.js index 118996257b..9a389e2579 100644 --- a/jscomp/test/dist/jscomp/test/offset.js +++ b/jscomp/test/dist/jscomp/test/offset.js @@ -15,17 +15,20 @@ const funarg = { }; function height(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; - return /* Node */{ + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; + return { + TAG: /* Node */0, l: l, v: v, r: r, @@ -34,52 +37,55 @@ function create(l, v, r) { } function bal(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const lv = l.v; - const ll = l.l; - if (height(ll) >= height(lr)) { - return create(ll, lv, create(lr, v, r)); - } - if (lr) { - return create(create(ll, lv, lr.l), lr.v, create(lr.r, v, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const lr = l.r; + const lv = l.v; + const ll = l.l; + if (height(ll) >= height(lr)) { + return create(ll, lv, create(lr, v, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, lr.l), lr.v, create(lr.r, v, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: v, r: r, h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rv = r.v; - const rl = r.l; - if (height(rr) >= height(rl)) { - return create(create(l, v, rl), rv, rr); - } - if (rl) { - return create(create(l, v, rl.l), rl.v, create(rl.r, rv, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const rr = r.r; + const rv = r.v; + const rl = r.l; + if (height(rr) >= height(rl)) { + return create(create(l, v, rl), rv, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, v, rl.l), rl.v, create(rl.r, rv, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" @@ -87,8 +93,9 @@ function bal(l, v, r) { } function add(x, t) { - if (!t) { - return /* Node */{ + if (/* tag */typeof t === "number" || typeof t === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -119,7 +126,8 @@ function add(x, t) { } function singleton(x) { - return /* Node */{ + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -128,30 +136,30 @@ function singleton(x) { } function add_min_element(x, param) { - if (param) { - return bal(add_min_element(x, param.l), param.v, param.r); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(x); + } else { + return bal(add_min_element(x, param.l), param.v, param.r); } } function add_max_element(x, param) { - if (param) { - return bal(param.l, param.v, add_max_element(x, param.r)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(x); + } else { + return bal(param.l, param.v, add_max_element(x, param.r)); } } function join(l, v, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_element(v, r); } - if (!r) { + const lh = l.h; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_element(v, l); } const rh = r.h; - const lh = l.h; if (lh > (rh + 2 | 0)) { return bal(l.l, l.v, join(l.r, v, r)); } else if (rh > (lh + 2 | 0)) { @@ -164,28 +172,28 @@ function join(l, v, r) { function min_elt(_param) { while(true) { const param = _param; - if (param) { - const l = param.l; - if (!l) { - return param.v; - } - _param = l; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param.v; + } + _param = l; + continue ; }; } function min_elt_opt(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const l = param.l; - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return Caml_option.some(param.v); } _param = l; @@ -196,26 +204,28 @@ function min_elt_opt(_param) { function max_elt(_param) { while(true) { const param = _param; - if (param) { - if (!param.r) { - return param.v; - } - _param = param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return param.v; + } + _param = param.r; + continue ; }; } function max_elt_opt(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } - if (!param.r) { + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { return Caml_option.some(param.v); } _param = param.r; @@ -224,34 +234,32 @@ function max_elt_opt(_param) { } function remove_min_elt(param) { - if (param) { - const l = param.l; - if (l) { - return bal(remove_min_elt(l), param.v, param.r); - } else { - return param.r; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Invalid_argument", { + MEL_EXN_ID: "Invalid_argument", + _1: "Set.remove_min_elt" + }); + } + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param.r; + } else { + return bal(remove_min_elt(l), param.v, param.r); } - throw new Caml_js_exceptions.MelangeError("Invalid_argument", { - MEL_EXN_ID: "Invalid_argument", - _1: "Set.remove_min_elt" - }); } function concat(t1, t2) { - if (t1) { - if (t2) { - return join(t1, min_elt(t2), remove_min_elt(t2)); - } else { - return t1; - } - } else { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; + } else if (/* tag */typeof t2 === "number" || typeof t2 === "string") { + return t1; + } else { + return join(t1, min_elt(t2), remove_min_elt(t2)); } } function split(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, false, @@ -286,17 +294,17 @@ function split(x, param) { } function is_empty(param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } } function mem(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(funarg.compare, x, param.v); @@ -309,7 +317,7 @@ function mem(x, _param) { } function remove(x, t) { - if (!t) { + if (/* tag */typeof t === "number" || typeof t === "string") { return /* Empty */0; } const r = t.r; @@ -317,14 +325,12 @@ function remove(x, t) { const l = t.l; const c = Curry._2(funarg.compare, x, v); if (c === 0) { - if (l) { - if (r) { - return bal(l, min_elt(r), remove_min_elt(r)); - } else { - return l; - } - } else { + if (/* tag */typeof l === "number" || typeof l === "string") { return r; + } else if (/* tag */typeof r === "number" || typeof r === "string") { + return l; + } else { + return bal(l, min_elt(r), remove_min_elt(r)); } } if (c < 0) { @@ -344,16 +350,16 @@ function remove(x, t) { } function union(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return s2; } - if (!s2) { + const h1 = s1.h; + const v1 = s1.v; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const h2 = s2.h; const v2 = s2.v; - const h1 = s1.h; - const v1 = s1.v; if (h1 >= h2) { if (h2 === 1) { return add(v2, s1); @@ -369,10 +375,10 @@ function union(s1, s2) { } function inter(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return /* Empty */0; } - if (!s2) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return /* Empty */0; } const r1 = s1.r; @@ -388,8 +394,9 @@ function inter(s1, s2) { } function split_bis(x, param) { - if (!param) { - return /* NotFound */{ + if (/* tag */typeof param === "number" || typeof param === "string") { + return { + TAG: /* NotFound */0, _0: /* Empty */0, _1: (function (param) { return /* Empty */0; @@ -405,11 +412,12 @@ function split_bis(x, param) { } if (c < 0) { const match = split_bis(x, l); - if (!match) { + if (/* tag */typeof match === "number" || typeof match === "string") { return /* Found */0; } const rl = match._1; - return /* NotFound */{ + return { + TAG: /* NotFound */0, _0: match._0, _1: (function (param) { return join(Curry._1(rl, undefined), v, r); @@ -417,13 +425,14 @@ function split_bis(x, param) { }; } const match$1 = split_bis(x, r); - if (match$1) { - return /* NotFound */{ + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { + return /* Found */0; + } else { + return { + TAG: /* NotFound */0, _0: join(l, v, match$1._0), _1: match$1._1 }; - } else { - return /* Found */0; } } @@ -431,17 +440,17 @@ function disjoint(_s1, _s2) { while(true) { const s2 = _s2; const s1 = _s1; - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return true; } - if (!s2) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return true; } if (s1 === s2) { return false; } const match = split_bis(s1.v, s2); - if (!match) { + if (/* tag */typeof match === "number" || typeof match === "string") { return false; } if (!disjoint(s1.l, match._0)) { @@ -454,10 +463,10 @@ function disjoint(_s1, _s2) { } function diff(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return /* Empty */0; } - if (!s2) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const r1 = s1.r; @@ -476,10 +485,11 @@ function cons_enum(_s, _e) { while(true) { const e = _e; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: s.v, _1: s.r, _2: e @@ -495,14 +505,14 @@ function compare(s1, s2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return -1; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 0; + } else { + return -1; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 1; } const c = Curry._2(funarg.compare, e1._0, e2._0); @@ -523,17 +533,17 @@ function subset(_s1, _s2) { while(true) { const s2 = _s2; const s1 = _s1; - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return true; } - if (!s2) { + const r1 = s1.r; + const v1 = s1.v; + const l1 = s1.l; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return false; } const r2 = s2.r; const l2 = s2.l; - const r1 = s1.r; - const v1 = s1.v; - const l1 = s1.l; const c = Curry._2(funarg.compare, v1, s2.v); if (c === 0) { if (!subset(l1, l2)) { @@ -544,7 +554,8 @@ function subset(_s1, _s2) { continue ; } if (c < 0) { - if (!subset(/* Node */{ + if (!subset({ + TAG: /* Node */0, l: l1, v: v1, r: /* Empty */0, @@ -555,7 +566,8 @@ function subset(_s1, _s2) { _s1 = r1; continue ; } - if (!subset(/* Node */{ + if (!subset({ + TAG: /* Node */0, l: /* Empty */0, v: v1, r: r1, @@ -571,7 +583,7 @@ function subset(_s1, _s2) { function iter(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } iter(f, param.l); @@ -585,7 +597,7 @@ function fold(f, _s, _accu) { while(true) { const accu = _accu; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return accu; } _accu = Curry._2(f, s.v, fold(f, s.l, accu)); @@ -597,7 +609,7 @@ function fold(f, _s, _accu) { function for_all(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; } if (!Curry._1(p, param.v)) { @@ -614,7 +626,7 @@ function for_all(p, _param) { function exists(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } if (Curry._1(p, param.v)) { @@ -629,7 +641,7 @@ function exists(p, _param) { } function filter(p, t) { - if (!t) { + if (/* tag */typeof t === "number" || typeof t === "string") { return /* Empty */0; } const r = t.r; @@ -650,7 +662,7 @@ function filter(p, t) { } function partition(p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, /* Empty */0 @@ -678,10 +690,10 @@ function partition(p, param) { } function cardinal(param) { - if (param) { - return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; } } @@ -689,7 +701,7 @@ function elements_aux(_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param.l; @@ -708,58 +720,58 @@ function elements(s) { function find(x, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - const c = Curry._2(funarg.compare, x, v); - if (c === 0) { - return v; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const v = param.v; + const c = Curry._2(funarg.compare, x, v); + if (c === 0) { + return v; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } function find_first(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _param$1 = param.l; - while(true) { - const param$1 = _param$1; - const v0 = _v0; - if (!param$1) { - return v0; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.l; - _v0 = v$1; - continue ; - } - _param$1 = param$1.r; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _param$1 = param.l; + while(true) { + const param$1 = _param$1; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return v0; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.l; + _v0 = v$1; continue ; - }; - } - _param = param.r; - continue ; + } + _param$1 = param$1.r; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.r; + continue ; }; } function find_first_opt(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -769,7 +781,7 @@ function find_first_opt(f, _param) { while(true) { const param$1 = _param$1; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return Caml_option.some(v0); } const v$1 = param$1.v; @@ -790,40 +802,40 @@ function find_first_opt(f, _param) { function find_last(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _param$1 = param.r; - while(true) { - const param$1 = _param$1; - const v0 = _v0; - if (!param$1) { - return v0; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.r; - _v0 = v$1; - continue ; - } - _param$1 = param$1.l; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _param$1 = param.r; + while(true) { + const param$1 = _param$1; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return v0; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.r; + _v0 = v$1; continue ; - }; - } - _param = param.l; - continue ; + } + _param$1 = param$1.l; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.l; + continue ; }; } function find_last_opt(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -833,7 +845,7 @@ function find_last_opt(f, _param) { while(true) { const param$1 = _param$1; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return Caml_option.some(v0); } const v$1 = param$1.v; @@ -854,7 +866,7 @@ function find_last_opt(f, _param) { function find_opt(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -876,7 +888,7 @@ function try_join(l, v, r) { } function map(f, t) { - if (!t) { + if (/* tag */typeof t === "number" || typeof t === "string") { return /* Empty */0; } const r = t.r; @@ -893,7 +905,7 @@ function map(f, t) { } function filter_map(f, t) { - if (!t) { + if (/* tag */typeof t === "number" || typeof t === "string") { return /* Empty */0; } const r = t.r; @@ -903,14 +915,12 @@ function filter_map(f, t) { const v$p = Curry._1(f, v); const r$p = filter_map(f, r); if (v$p === undefined) { - if (l$p) { - if (r$p) { - return try_join(l$p, min_elt(r$p), remove_min_elt(r$p)); - } else { - return l$p; - } - } else { + if (/* tag */typeof l$p === "number" || typeof l$p === "string") { return r$p; + } else if (/* tag */typeof r$p === "number" || typeof r$p === "string") { + return l$p; + } else { + return try_join(l$p, min_elt(r$p), remove_min_elt(r$p)); } } const v$p$1 = Caml_option.valFromOption(v$p); @@ -955,7 +965,8 @@ function of_list(l) { case 1 : if (l) { return [ - /* Node */{ + { + TAG: /* Node */0, l: /* Empty */0, v: l.hd, r: /* Empty */0, @@ -970,8 +981,10 @@ function of_list(l) { const match = l.tl; if (match) { return [ - /* Node */{ - l: /* Node */{ + { + TAG: /* Node */0, + l: { + TAG: /* Node */0, l: /* Empty */0, v: l.hd, r: /* Empty */0, @@ -994,15 +1007,18 @@ function of_list(l) { const match$2 = match$1.tl; if (match$2) { return [ - /* Node */{ - l: /* Node */{ + { + TAG: /* Node */0, + l: { + TAG: /* Node */0, l: /* Empty */0, v: l.hd, r: /* Empty */0, h: 1 }, v: match$1.hd, - r: /* Node */{ + r: { + TAG: /* Node */0, l: /* Empty */0, v: match$2.hd, r: /* Empty */0, @@ -1060,11 +1076,12 @@ function of_seq(i) { } function seq_of_enum_(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = cons_enum(c._1, c._2); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: c._0, _1: (function (param) { return seq_of_enum_(partial_arg, param); @@ -1083,10 +1100,11 @@ function snoc_enum(_s, _e) { while(true) { const e = _e; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: s.v, _1: s.l, _2: e @@ -1097,11 +1115,12 @@ function snoc_enum(_s, _e) { } function rev_seq_of_enum_(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = snoc_enum(c._1, c._2); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: c._0, _1: (function (param) { return rev_seq_of_enum_(partial_arg, param); @@ -1121,14 +1140,15 @@ function to_seq_from(low, s) { while(true) { const c = _c; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return c; } const r = s.r; const v = s.v; const n = Curry._2(funarg.compare, v, low); if (n === 0) { - return /* More */{ + return { + TAG: /* More */0, _0: v, _1: r, _2: c @@ -1138,7 +1158,8 @@ function to_seq_from(low, s) { _s = r; continue ; } - _c = /* More */{ + _c = { + TAG: /* More */0, _0: v, _1: r, _2: c diff --git a/jscomp/test/dist/jscomp/test/opr_3576_test.js b/jscomp/test/dist/jscomp/test/opr_3576_test.js index 35052bc58a..886b65d329 100644 --- a/jscomp/test/dist/jscomp/test/opr_3576_test.js +++ b/jscomp/test/dist/jscomp/test/opr_3576_test.js @@ -23,13 +23,15 @@ function eq(loc, x, y) { Mt.eq_suites(test_id, suites, loc, x, y); } -const object_tables = /* Cons */{ +const object_tables = { + TAG: /* Cons */0, key: undefined, data: undefined, next: undefined }; -const object_tables$1 = /* Cons */{ +const object_tables$1 = { + TAG: /* Cons */0, key: undefined, data: undefined, next: undefined diff --git a/jscomp/test/dist/jscomp/test/opr_4560_test.js b/jscomp/test/dist/jscomp/test/opr_4560_test.js index 3068b8724e..83e414eabc 100644 --- a/jscomp/test/dist/jscomp/test/opr_4560_test.js +++ b/jscomp/test/dist/jscomp/test/opr_4560_test.js @@ -20,13 +20,15 @@ function eq(loc, x, y) { Mt.eq_suites(test_id, suites, loc, x, y); } -const object_tables = /* Cons */{ +const object_tables = { + TAG: /* Cons */0, key: undefined, data: undefined, next: undefined }; -const object_tables$1 = /* Cons */{ +const object_tables$1 = { + TAG: /* Cons */0, key: undefined, data: undefined, next: undefined diff --git a/jscomp/test/dist/jscomp/test/option_repr_test.js b/jscomp/test/dist/jscomp/test/option_repr_test.js index 6ac0cd1a42..010faf4cd5 100644 --- a/jscomp/test/dist/jscomp/test/option_repr_test.js +++ b/jscomp/test/dist/jscomp/test/option_repr_test.js @@ -32,10 +32,10 @@ function f0(x) { } function f1(u) { - if (u) { - return 0; - } else { + if (/* tag */typeof u === "number" || typeof u === "string") { return 1; + } else { + return 0; } } diff --git a/jscomp/test/dist/jscomp/test/parser_api.js b/jscomp/test/dist/jscomp/test/parser_api.js index c0c36c8fc6..fa3a0225a8 100644 --- a/jscomp/test/dist/jscomp/test/parser_api.js +++ b/jscomp/test/dist/jscomp/test/parser_api.js @@ -131,7 +131,8 @@ switch (Stdlib__Sys.os_type) { function print_config(oc) { const p = function (name, valu) { - Curry._2(Stdlib__Printf.fprintf(oc, /* Format */{ + Curry._2(Stdlib__Printf.fprintf(oc, { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -153,7 +154,8 @@ function print_config(oc) { }), name, valu); }; const p_bool = function (name, valu) { - Curry._2(Stdlib__Printf.fprintf(oc, /* Format */{ + Curry._2(Stdlib__Printf.fprintf(oc, { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1470,7 +1472,7 @@ function ansi_of_color(param) { } function code_of_style(c) { - if (typeof c !== "number") { + if (!/* tag */(typeof c === "number" || typeof c === "string")) { if (c.TAG === /* FG */0) { return "3" + ansi_of_color(c._0); } else { @@ -1742,7 +1744,7 @@ const Misc = { const Terminfo = {}; function number(param) { - if (typeof param === "number") { + if (/* tag */typeof param === "number" || typeof param === "string") { switch (param) { case /* Comment_start */0 : return 1; @@ -1781,7 +1783,7 @@ function number(param) { } } else { - switch (param.TAG | 0) { + switch (param.TAG) { case /* Deprecated */0 : return 3; case /* Fragile_match */1 : @@ -2241,7 +2243,7 @@ parse_options(false, defaults_w); parse_options(true, defaults_warn_error); function message(s) { - if (typeof s === "number") { + if (/* tag */typeof s === "number" || typeof s === "string") { switch (s) { case /* Comment_start */0 : return "this is the start of a comment."; @@ -2280,7 +2282,7 @@ function message(s) { } } else { - switch (s.TAG | 0) { + switch (s.TAG) { case /* Deprecated */0 : return "deprecated: " + s._0; case /* Fragile_match */1 : @@ -2369,7 +2371,8 @@ function message(s) { case /* Unused_var_strict */13 : return "unused variable " + (s._0 + "."); case /* Duplicate_definitions */14 : - return Curry._4(Stdlib__Printf.sprintf(/* Format */{ + return Curry._4(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "the ", @@ -2410,7 +2413,8 @@ function message(s) { _1: "the %s %s is defined in both types %s and %s." }), s._0, s._1, s._2, s._3); case /* Multiple_definition */15 : - return Curry._3(Stdlib__Printf.sprintf(/* Format */{ + return Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "files ", @@ -2506,7 +2510,8 @@ function message(s) { case /* Nonoptional_label */26 : return "the label " + (s._0 + " is not optional."); case /* Open_shadow_identifier */27 : - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "this open statement shadows the ", @@ -2531,7 +2536,8 @@ function message(s) { _1: "this open statement shadows the %s identifier %s (which is later used)" }), s._0, s._1); case /* Open_shadow_label_constructor */28 : - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "this open statement shadows the ", @@ -2556,7 +2562,8 @@ function message(s) { _1: "this open statement shadows the %s %s (which is later used)" }), s._0, s._1); case /* Bad_env_variable */29 : - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "illegal environment variable ", @@ -2577,7 +2584,8 @@ function message(s) { _1: "illegal environment variable %s : %s" }), s._0, s._1); case /* Attribute_payload */30 : - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "illegal payload for attribute '", @@ -2599,7 +2607,8 @@ function message(s) { }), s._0, s._1); case /* Eliminated_optional_arguments */31 : const sl = s._0; - return Curry._2(Stdlib__Printf.sprintf(/* Format */{ + return Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "implicit elimination of optional argument", @@ -2645,7 +2654,8 @@ const nerrors = { function print(ppf, w) { const msg = message(w); const num = number(w); - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -2674,7 +2684,8 @@ function print(ppf, w) { function super_print(message, ppf, w) { const msg = Curry._1(message, w); const num = number(w); - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -2707,7 +2718,8 @@ function check_fatal(param) { function help_warnings(param) { Stdlib__List.iter((function (param) { - Curry._2(Stdlib__Printf.printf(/* Format */{ + Curry._2(Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -3046,7 +3058,8 @@ function help_warnings(param) { const l = letter(c); if (l) { if (l.tl) { - Curry._2(Stdlib__Printf.printf(/* Format */{ + Curry._2(Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " ", @@ -3072,7 +3085,8 @@ function help_warnings(param) { return String(prim); }), l))); } else { - Curry._2(Stdlib__Printf.printf(/* Format */{ + Curry._2(Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " ", @@ -3302,7 +3316,8 @@ function highlight_dumb(ppf, lb, loc) { } } - Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Characters ", @@ -3363,7 +3378,8 @@ function highlight_dumb(ppf, lb, loc) { } else { if (line === line_start && line === line_end) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: /* Flush_newline */4, @@ -3383,7 +3399,8 @@ function highlight_dumb(ppf, lb, loc) { } } if (line >= line_start && line <= line_end) { - Stdlib__Format.fprintf(ppf)(/* Format */{ + Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: /* Flush_newline */4, @@ -3405,42 +3422,41 @@ function highlight_dumb(ppf, lb, loc) { function highlight_locations(ppf, locs) { while(true) { const num_lines = status.contents; - if (typeof num_lines === "number") { - if (num_lines) { - const lb = input_lexbuf.contents; - if (lb === undefined) { - return false; - } - let norepeat; - try { - norepeat = Caml_sys.caml_sys_getenv("TERM") === "norepeat"; - } - catch (raw_exn){ - const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); - if (exn.MEL_EXN_ID === Stdlib.Not_found) { - norepeat = false; - } else { - throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); - } + if (/* tag */typeof num_lines === "number" || typeof num_lines === "string") { + if (num_lines === /* Uninitialised */0) { + status.contents = Caml_external_polyfill.resolve("caml_terminfo_setup")(Stdlib.stdout); + continue ; + } + const lb = input_lexbuf.contents; + if (lb === undefined) { + return false; + } + let norepeat; + try { + norepeat = Caml_sys.caml_sys_getenv("TERM") === "norepeat"; + } + catch (raw_exn){ + const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); + if (exn.MEL_EXN_ID === Stdlib.Not_found) { + norepeat = false; + } else { + throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } - if (norepeat) { + } + if (norepeat) { + return false; + } + const loc1 = Stdlib__List.hd(locs); + try { + highlight_dumb(ppf, lb, loc1); + return true; + } + catch (raw_exn$1){ + const exn$1 = Caml_js_exceptions.internalToOCamlException(raw_exn$1); + if (exn$1.MEL_EXN_ID === Stdlib.Exit) { return false; } - const loc1 = Stdlib__List.hd(locs); - try { - highlight_dumb(ppf, lb, loc1); - return true; - } - catch (raw_exn$1){ - const exn$1 = Caml_js_exceptions.internalToOCamlException(raw_exn$1); - if (exn$1.MEL_EXN_ID === Stdlib.Exit) { - return false; - } - throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); - } - } else { - status.contents = Caml_external_polyfill.resolve("caml_terminfo_setup")(Stdlib.stdout); - continue ; + throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); } } else { const lb$1 = input_lexbuf.contents; @@ -3495,7 +3511,8 @@ function show_filename(file) { } function print_filename(ppf, file) { - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -3531,7 +3548,8 @@ function print_loc(ppf, loc) { })) { return ; } else { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Characters ", @@ -3557,7 +3575,8 @@ function print_loc(ppf, loc) { }), loc.loc_start.pos_cnum, loc.loc_end.pos_cnum); } } else { - Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -3565,7 +3584,8 @@ function print_loc(ppf, loc) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_tag */0, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -3593,7 +3613,8 @@ function print_loc(ppf, loc) { _1: "%s@{%a%s%i" }), "File \"", print_filename, file, "\", line ", match[1]); if (startchar$1 >= 0) { - Curry._4(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._4(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -3618,7 +3639,8 @@ function print_loc(ppf, loc) { _1: "%s%i%s%i" }), ", characters ", startchar$1, "-", endchar); } - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: /* Close_tag */1, @@ -3637,12 +3659,14 @@ function print$1(ppf, loc) { })) { return ; } else { - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_tag */0, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -3677,12 +3701,14 @@ const error_prefix = "Error"; function print_error_prefix(ppf, param) { Curry._1(Misc_Color.setup, color.contents); - Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_tag */0, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -3722,12 +3748,14 @@ function default_warning_printer(loc, ppf, w) { if (is_active(w)) { Curry._1(Misc_Color.setup, color.contents); print$1(ppf, loc); - return Curry._3(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._3(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_tag */0, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -3886,7 +3914,8 @@ function default_error_reporter(ppf, err) { if (highlighted) { return Stdlib__Format.pp_print_string(ppf, if_highlight); } else { - Curry._5(Stdlib__Format.fprintf(ppf)(/* Format */{ + Curry._5(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -3904,7 +3933,8 @@ function default_error_reporter(ppf, err) { }, _1: "%a%a %s" }), print$1, err.loc, print_error_prefix, undefined, err.msg); - return Stdlib__List.iter(Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__List.iter(Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: /* Force_newline */3, @@ -3912,7 +3942,8 @@ function default_error_reporter(ppf, err) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "<2>", @@ -3945,7 +3976,8 @@ function report_error(ppf, err) { } function error_of_printer(loc, print, x) { - return Curry._2(errorf(loc, undefined, undefined, /* Format */{ + return Curry._2(errorf(loc, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: { @@ -3964,7 +3996,8 @@ function error_of_printer_file(print, x) { register_error_of_exn(function (msg) { if (msg.MEL_EXN_ID === Stdlib.Sys_error) { - return Curry._1(errorf(in_file(input_name.contents), undefined, undefined, /* Format */{ + return Curry._1(errorf(in_file(input_name.contents), undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "I/O error: ", @@ -3977,7 +4010,8 @@ register_error_of_exn(function (msg) { _1: "I/O error: %s" }), msg._1); } else if (msg.MEL_EXN_ID === Errors) { - return Curry._1(errorf(in_file(input_name.contents), undefined, undefined, /* Format */{ + return Curry._1(errorf(in_file(input_name.contents), undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Some fatal warnings were triggered (", @@ -4009,12 +4043,14 @@ function report_exception(ppf, exn) { try { const err = error_of_exn$1(exn$1); if (err !== undefined) { - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -4131,7 +4167,7 @@ function flatten(lid) { while(true) { const s = _s; const accu = _accu; - switch (s.TAG | 0) { + switch (s.TAG) { case /* Lident */0 : return { hd: s._0, @@ -4152,7 +4188,7 @@ function flatten(lid) { } function last(s) { - switch (s.TAG | 0) { + switch (s.TAG) { case /* Lident */0 : return s._0; case /* Ldot */1 : @@ -4233,13 +4269,16 @@ function warn_bad_docstrings(param) { return ; case /* Docs */2 : const match$1 = ds.ds_associated; - if (match$1 >= 2) { - return prerr_warning(ds.ds_loc, { - TAG: /* Bad_docstring */33, - _0: false - }); - } else { - return ; + switch (match$1) { + case /* Zero */0 : + case /* One */1 : + return ; + case /* Many */2 : + return prerr_warning(ds.ds_loc, { + TAG: /* Bad_docstring */33, + _0: false + }); + } } @@ -4400,12 +4439,17 @@ function get_docstring(info, dsl) { } const ds = param.hd; const match = ds.ds_attached; - if (match !== 1) { - ds.ds_attached = info ? /* Info */1 : /* Docs */2; - return ds; + switch (match) { + case /* Info */1 : + _param = param.tl; + continue ; + case /* Unattached */0 : + case /* Docs */2 : + break; + } - _param = param.tl; - continue ; + ds.ds_attached = info ? /* Info */1 : /* Docs */2; + return ds; }; } @@ -4420,16 +4464,21 @@ function get_docstrings(dsl) { } const ds = param.hd; const match = ds.ds_attached; - if (match !== 1) { - ds.ds_attached = /* Docs */2; - _param = param.tl; - _acc = { - hd: ds, - tl: acc - }; - continue ; + switch (match) { + case /* Info */1 : + _param = param.tl; + continue ; + case /* Unattached */0 : + case /* Docs */2 : + break; + } + ds.ds_attached = /* Docs */2; _param = param.tl; + _acc = { + hd: ds, + tl: acc + }; continue ; }; } @@ -4437,10 +4486,15 @@ function get_docstrings(dsl) { function associate_docstrings(dsl) { Stdlib__List.iter((function (ds) { const match = ds.ds_associated; - if (match) { - ds.ds_associated = /* Many */2; - } else { - ds.ds_associated = /* One */1; + switch (match) { + case /* Zero */0 : + ds.ds_associated = /* One */1; + return ; + case /* One */1 : + case /* Many */2 : + ds.ds_associated = /* Many */2; + return ; + } }), dsl); } @@ -4884,7 +4938,7 @@ function extension(loc, attrs, a) { function force_poly(t) { const match = t.ptyp_desc; - if (typeof match !== "number" && match.TAG === /* Ptyp_poly */8) { + if (!/* tag */(typeof match === "number" || typeof match === "string") && match.TAG === /* Ptyp_poly */8) { return t; } return poly(t.ptyp_loc, undefined, /* [] */0, t); @@ -6547,12 +6601,13 @@ const $$Error$1 = /* @__PURE__ */Caml_exceptions.create("Parser_api.Syntaxerr.Er const Escape_error = /* @__PURE__ */Caml_exceptions.create("Parser_api.Syntaxerr.Escape_error"); function prepare_error(loc) { - switch (loc.TAG | 0) { + switch (loc.TAG) { case /* Unclosed */0 : const closing = loc._3; const opening = loc._1; return Curry._1(errorf(loc._2, { - hd: Curry._1(errorf(loc._0, undefined, undefined, /* Format */{ + hd: Curry._1(errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This '", @@ -6569,7 +6624,8 @@ function prepare_error(loc) { _1: "This '%s' might be unmatched" }), opening), tl: /* [] */0 - }, Curry._2(Stdlib__Printf.sprintf(/* Format */{ + }, Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error: '", @@ -6592,7 +6648,8 @@ function prepare_error(loc) { } }, _1: "Syntax error: '%s' expected, the highlighted '%s' might be unmatched" - }), closing, opening), /* Format */{ + }), closing, opening), { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error: '", @@ -6609,7 +6666,8 @@ function prepare_error(loc) { _1: "Syntax error: '%s' expected" }), closing); case /* Expecting */1 : - return Curry._1(errorf(loc._0, undefined, undefined, /* Format */{ + return Curry._1(errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error: ", @@ -6626,7 +6684,8 @@ function prepare_error(loc) { _1: "Syntax error: %s expected." }), loc._1); case /* Not_expecting */2 : - return Curry._1(errorf(loc._0, undefined, undefined, /* Format */{ + return Curry._1(errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error: ", @@ -6643,7 +6702,8 @@ function prepare_error(loc) { _1: "Syntax error: %s not expected." }), loc._1); case /* Applicative_path */3 : - return errorf(loc._0, undefined, undefined, /* Format */{ + return errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error: applicative paths of the form F(X).t are not supported when the option -no-app-func is set.", @@ -6653,7 +6713,8 @@ function prepare_error(loc) { }); case /* Variable_in_scope */4 : const $$var = loc._1; - return Curry._2(errorf(loc._0, undefined, undefined, /* Format */{ + return Curry._2(errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "In this scoped type, variable '", @@ -6678,7 +6739,8 @@ function prepare_error(loc) { _1: "In this scoped type, variable '%s is reserved for the local type %s." }), $$var, $$var); case /* Other */5 : - return errorf(loc._0, undefined, undefined, /* Format */{ + return errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Syntax error", @@ -6687,7 +6749,8 @@ function prepare_error(loc) { _1: "Syntax error" }); case /* Ill_formed_ast */6 : - return Curry._1(errorf(loc._0, undefined, undefined, /* Format */{ + return Curry._1(errorf(loc._0, undefined, undefined, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "broken invariant in parsetree: ", @@ -7186,10 +7249,10 @@ function varify_constructors(var_names, t) { const loop = function (t) { const x = t.ptyp_desc; let desc; - if (typeof x === "number") { + if (/* tag */typeof x === "number" || typeof x === "string") { desc = /* Ptyp_any */0; } else { - switch (x.TAG | 0) { + switch (x.TAG) { case /* Ptyp_var */0 : const x$1 = x._0; check_variable(var_names, t.ptyp_loc, x$1); @@ -7216,7 +7279,7 @@ function varify_constructors(var_names, t) { const longident = x._0; let exit = 0; const s = longident.txt; - switch (s.TAG | 0) { + switch (s.TAG) { case /* Lident */0 : if (x._1) { exit = 1; @@ -7425,7 +7488,7 @@ function extra_csig(pos, items) { } function add_nonrec(rf, attrs, pos) { - if (rf) { + if (rf !== /* Nonrecursive */0) { return attrs; } const name_loc = rhs_loc(pos); @@ -7982,7 +8045,8 @@ const yyact = [ let exit = 0; if (bindings) { const lb = bindings.hd; - if (typeof lb.lb_pattern.ppat_desc === "number" && !bindings.tl) { + let tmp = lb.lb_pattern.ppat_desc; + if (/* tag */(typeof tmp === "number" || typeof tmp === "string") && !bindings.tl) { const exp = wrap_exp_attrs(lb.lb_expression, [ undefined, lbs.lbs_attributes @@ -9803,7 +9867,7 @@ const yyact = [ case "-" : if (match.TAG === /* Pexp_constant */1) { const n = match._0; - switch (n.TAG | 0) { + switch (n.TAG) { case /* Const_int */0 : return mkexp({ TAG: /* Pexp_constant */1, @@ -9882,7 +9946,7 @@ const yyact = [ switch (_1) { case "+" : if (desc.TAG === /* Pexp_constant */1) { - switch (desc._0.TAG | 0) { + switch (desc._0.TAG) { case /* Const_char */1 : case /* Const_string */2 : case /* Const_float */3 : @@ -13713,10 +13777,10 @@ const Parser = { }; function type_of_directive(x) { - if (typeof x === "number") { + if (/* tag */typeof x === "number" || typeof x === "string") { return /* Dir_type_null */4; } - switch (x.TAG | 0) { + switch (x.TAG) { case /* Dir_bool */0 : return /* Dir_type_bool */0; case /* Dir_float */1 : @@ -14000,10 +14064,10 @@ function semver(loc, lhs, str) { } function pp_directive_value(fmt, x) { - if (typeof x === "number") { + if (/* tag */typeof x === "number" || typeof x === "string") { return Stdlib__Format.pp_print_string(fmt, "null"); } - switch (x.TAG | 0) { + switch (x.TAG) { case /* Dir_bool */0 : return Stdlib__Format.pp_print_bool(fmt, x._0); case /* Dir_float */1 : @@ -14011,7 +14075,8 @@ function pp_directive_value(fmt, x) { case /* Dir_int */2 : return Stdlib__Format.pp_print_int(fmt, x._0); case /* Dir_string */3 : - return Curry._1(Stdlib__Format.fprintf(fmt)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(fmt)({ + TAG: /* Format */0, _0: { TAG: /* Caml_string */3, _0: /* No_padding */0, @@ -14025,12 +14090,14 @@ function pp_directive_value(fmt, x) { function list_variables(fmt) { Stdlib__Hashtbl.iter((function (s, dir_value) { - Curry._3(Stdlib__Format.fprintf(fmt)(/* Format */{ + Curry._3(Stdlib__Format.fprintf(fmt)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -14080,7 +14147,7 @@ function defined(str) { return false; } } - if (typeof val === "number") { + if (/* tag */typeof val === "number" || typeof val === "string") { return false; } else { return true; @@ -14146,7 +14213,7 @@ function query(loc, str) { throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } } - if (typeof v === "number") { + if (/* tag */typeof v === "number" || typeof v === "string") { return { TAG: /* Dir_bool */0, _0: false @@ -14194,7 +14261,7 @@ function define_key_value(key, v) { } function value_of_token(loc, t) { - if (typeof t === "number") { + if (/* tag */typeof t === "number" || typeof t === "string") { switch (t) { case /* FALSE */29 : return { @@ -14214,7 +14281,7 @@ function value_of_token(loc, t) { }); } } else { - switch (t.TAG | 0) { + switch (t.TAG) { case /* FLOAT */1 : return { TAG: /* Dir_float */1, @@ -14255,7 +14322,7 @@ function directive_parse(token_with_comments, lexbuf) { let _param; while(true) { const t = Curry._1(token_with_comments, lexbuf); - if (typeof t === "number") { + if (/* tag */typeof t === "number" || typeof t === "string") { switch (t) { case /* EOF */25 : throw new Caml_js_exceptions.MelangeError($$Error$2, { @@ -14270,7 +14337,7 @@ function directive_parse(token_with_comments, lexbuf) { return t; } } else { - switch (t.TAG | 0) { + switch (t.TAG) { case /* COMMENT */18 : case /* DOCSTRING */19 : _param = undefined; @@ -14297,7 +14364,7 @@ function directive_parse(token_with_comments, lexbuf) { const token_op = function (calc, no, lhs) { const op = token(undefined); let exit = 0; - if (typeof op === "number") { + if (/* tag */typeof op === "number" || typeof op === "string") { switch (op) { case /* EQUAL */26 : case /* GREATER */34 : @@ -14317,13 +14384,13 @@ function directive_parse(token_with_comments, lexbuf) { return true; } let exit$1 = 0; - if (typeof lhs === "number" || lhs.TAG !== /* Dir_string */3) { + if (/* tag */typeof lhs === "number" || typeof lhs === "string" || lhs.TAG !== /* Dir_string */3) { exit$1 = 2; } else { const curr_loc = curr(lexbuf); const rhs = value_of_token(curr_loc, token(undefined)); let exit$2 = 0; - if (typeof rhs === "number") { + if (/* tag */typeof rhs === "number" || typeof rhs === "string") { exit$2 = 3; } else { if (rhs.TAG === /* Dir_string */3) { @@ -14368,7 +14435,7 @@ function directive_parse(token_with_comments, lexbuf) { if (exit === 1) { let f; let exit$3 = 0; - if (typeof op === "number") { + if (/* tag */typeof op === "number" || typeof op === "string") { switch (op) { case /* EQUAL */26 : f = Caml_obj.caml_equal; @@ -14418,36 +14485,49 @@ function directive_parse(token_with_comments, lexbuf) { }; const parse_or_aux = function (calc, v) { const e = token(undefined); - if (e === 8) { - const calc$1 = calc && !v; - const b = parse_or_aux(calc$1, parse_and_aux(calc$1, parse_relation(calc$1))); - if (v) { - return true; - } else { - return b; + if (/* tag */typeof e === "number" || typeof e === "string") { + if (e === /* BARBAR */8) { + const calc$1 = calc && !v; + const b = parse_or_aux(calc$1, parse_and_aux(calc$1, parse_relation(calc$1))); + if (v) { + return true; + } else { + return b; + } } + push(e); + return v; + } else { + push(e); + return v; } - push(e); - return v; }; const parse_relation = function (calc) { const curr_token = token(undefined); const curr_loc = curr(lexbuf); - if (typeof curr_token === "number") { + if (/* tag */typeof curr_token === "number" || typeof curr_token === "string") { switch (curr_token) { case /* FALSE */29 : return false; case /* LPAREN */54 : const v = parse_or_aux(calc, parse_and_aux(calc, parse_relation(calc))); const match = token(undefined); - if (match === 81) { - return v; + if (/* tag */typeof match === "number" || typeof match === "string") { + if (match === /* RPAREN */81) { + return v; + } + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unterminated_paren_in_conditional */1, + _2: curr(lexbuf) + }); + } else { + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unterminated_paren_in_conditional */1, + _2: curr(lexbuf) + }); } - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unterminated_paren_in_conditional */1, - _2: curr(lexbuf) - }); case /* TRUE */91 : return true; default: @@ -14458,7 +14538,7 @@ function directive_parse(token_with_comments, lexbuf) { }); } } else { - switch (curr_token.TAG | 0) { + switch (curr_token.TAG) { case /* FLOAT */1 : return token_op(calc, (function (e) { throw new Caml_js_exceptions.MelangeError($$Error$2, { @@ -14498,7 +14578,7 @@ function directive_parse(token_with_comments, lexbuf) { } const t = token(undefined); const loc = curr(lexbuf); - if (typeof t === "number") { + if (/* tag */typeof t === "number" || typeof t === "string") { throw new Caml_js_exceptions.MelangeError($$Error$2, { MEL_EXN_ID: $$Error$2, _1: /* Unexpected_token_in_conditional */4, @@ -14542,7 +14622,7 @@ function directive_parse(token_with_comments, lexbuf) { const value_v = query(curr_loc, curr_token._0); return token_op(calc, (function (e) { push(e); - if (typeof value_v !== "number" && value_v.TAG === /* Dir_bool */0) { + if (!/* tag */(typeof value_v === "number" || typeof value_v === "string") && value_v.TAG === /* Dir_bool */0) { return value_v._0; } const ty = type_of_directive(value_v); @@ -14567,36 +14647,45 @@ function directive_parse(token_with_comments, lexbuf) { }; const parse_and_aux = function (calc, v) { const e = token(undefined); - if (typeof e === "number") { - if (e) { - push(e); - return v; - } - const calc$1 = calc && v; - const b = parse_and_aux(calc$1, parse_relation(calc$1)); - if (v) { - return b; - } else { - return false; + if (/* tag */typeof e === "number" || typeof e === "string") { + if (e === /* AMPERAMPER */0) { + const calc$1 = calc && v; + const b = parse_and_aux(calc$1, parse_relation(calc$1)); + if (v) { + return b; + } else { + return false; + } } + push(e); + return v; + } else { + push(e); + return v; } - push(e); - return v; }; const v = parse_or_aux(true, parse_and_aux(true, parse_relation(true))); const match = token(undefined); - if (match === 88) { - return v; + if (/* tag */typeof match === "number" || typeof match === "string") { + if (match === /* THEN */88) { + return v; + } + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Expect_hash_then_in_conditional */5, + _2: curr(lexbuf) + }); + } else { + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Expect_hash_then_in_conditional */5, + _2: curr(lexbuf) + }); } - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Expect_hash_then_in_conditional */5, - _2: curr(lexbuf) - }); } function is_elif(i) { - if (typeof i === "number" || !(i.TAG === /* LIDENT */11 && i._0 === "elif")) { + if (/* tag */typeof i === "number" || typeof i === "string" || !(i.TAG === /* LIDENT */11 && i._0 === "elif")) { return false; } else { return true; @@ -15220,10 +15309,11 @@ function comments(param) { } function report_error$2(ppf, c) { - if (typeof c === "number") { + if (/* tag */typeof c === "number" || typeof c === "string") { switch (c) { case /* Unterminated_string */0 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "String literal not terminated", @@ -15232,7 +15322,8 @@ function report_error$2(ppf, c) { _1: "String literal not terminated" }); case /* Unterminated_paren_in_conditional */1 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unterminated parens in conditional predicate", @@ -15241,7 +15332,8 @@ function report_error$2(ppf, c) { _1: "Unterminated parens in conditional predicate" }); case /* Unterminated_if */2 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "#if not terminated", @@ -15250,7 +15342,8 @@ function report_error$2(ppf, c) { _1: "#if not terminated" }); case /* Unterminated_else */3 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "#else not terminated", @@ -15259,7 +15352,8 @@ function report_error$2(ppf, c) { _1: "#else not terminated" }); case /* Unexpected_token_in_conditional */4 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unexpected token in conditional predicate", @@ -15268,7 +15362,8 @@ function report_error$2(ppf, c) { _1: "Unexpected token in conditional predicate" }); case /* Expect_hash_then_in_conditional */5 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Expect `then` after conditional predicate", @@ -15277,7 +15372,8 @@ function report_error$2(ppf, c) { _1: "Expect `then` after conditional predicate" }); case /* Unexpected_directive */6 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Unexpected directive", @@ -15288,9 +15384,10 @@ function report_error$2(ppf, c) { } } else { - switch (c.TAG | 0) { + switch (c.TAG) { case /* Illegal_character */0 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Illegal character (", @@ -15307,7 +15404,8 @@ function report_error$2(ppf, c) { _1: "Illegal character (%s)" }), Stdlib__Char.escaped(c._0)); case /* Illegal_escape */1 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Illegal backslash escape in string or character (", @@ -15324,7 +15422,8 @@ function report_error$2(ppf, c) { _1: "Illegal backslash escape in string or character (%s)" }), c._0); case /* Unterminated_comment */2 : - return Stdlib__Format.fprintf(ppf)(/* Format */{ + return Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Comment not terminated", @@ -15333,7 +15432,8 @@ function report_error$2(ppf, c) { _1: "Comment not terminated" }); case /* Unterminated_string_in_comment */3 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "This comment contains an unterminated string literal", @@ -15353,7 +15453,8 @@ function report_error$2(ppf, c) { _1: "This comment contains an unterminated string literal@.%aString literal begins here" }), print_error, c._1); case /* Keyword_as_label */4 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '`' */96, @@ -15370,7 +15471,8 @@ function report_error$2(ppf, c) { _1: "`%s' is a keyword, it cannot be used as label name" }), c._0); case /* Literal_overflow */5 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Integer literal exceeds the range of representable integers of type ", @@ -15383,7 +15485,8 @@ function report_error$2(ppf, c) { _1: "Integer literal exceeds the range of representable integers of type %s" }), c._0); case /* Illegal_semver */6 : - return Curry._1(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Illegal semantic version string ", @@ -15396,7 +15499,8 @@ function report_error$2(ppf, c) { _1: "Illegal semantic version string %s" }), c._0); case /* Conditional_expr_expected_type */7 : - return Curry._2(Stdlib__Format.fprintf(ppf)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(ppf)({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Conditional expression type mismatch (", @@ -15978,37 +16082,39 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { catch (raw_exn){ const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); if (exn.MEL_EXN_ID === $$Error$2) { - const match$1 = exn._1; - if (typeof match$1 === "number") { - if (match$1) { - throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); - } - const match$2 = comment_start_loc.contents; - if (match$2) { - const start = Stdlib__List.hd(Stdlib__List.rev(comment_start_loc.contents)); - comment_start_loc.contents = /* [] */0; - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: { - TAG: /* Unterminated_string_in_comment */3, - _0: start, - _1: exn._2 - }, - _2: match$2.hd + let tmp = exn._1; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + if (tmp === /* Unterminated_string */0) { + const match$1 = comment_start_loc.contents; + if (match$1) { + const start = Stdlib__List.hd(Stdlib__List.rev(comment_start_loc.contents)); + comment_start_loc.contents = /* [] */0; + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: { + TAG: /* Unterminated_string_in_comment */3, + _0: start, + _1: exn._2 + }, + _2: match$1.hd + }); + } + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "parsing/lexer.mll", + 1006, + 18 + ] }); } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "parsing/lexer.mll", - 1006, - 18 - ] - }); + throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); + } else { + throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } + } else { throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } - throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } is_in_string.contents = false; store_string_char(/* '"' */34); @@ -16026,37 +16132,39 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { catch (raw_exn$1){ const exn$1 = Caml_js_exceptions.internalToOCamlException(raw_exn$1); if (exn$1.MEL_EXN_ID === $$Error$2) { - const match$3 = exn$1._1; - if (typeof match$3 === "number") { - if (match$3) { - throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); - } - const match$4 = comment_start_loc.contents; - if (match$4) { - const start$1 = Stdlib__List.hd(Stdlib__List.rev(comment_start_loc.contents)); - comment_start_loc.contents = /* [] */0; - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: { - TAG: /* Unterminated_string_in_comment */3, - _0: start$1, - _1: exn$1._2 - }, - _2: match$4.hd + let tmp$1 = exn$1._1; + if (/* tag */typeof tmp$1 === "number" || typeof tmp$1 === "string") { + if (tmp$1 === /* Unterminated_string */0) { + const match$2 = comment_start_loc.contents; + if (match$2) { + const start$1 = Stdlib__List.hd(Stdlib__List.rev(comment_start_loc.contents)); + comment_start_loc.contents = /* [] */0; + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: { + TAG: /* Unterminated_string_in_comment */3, + _0: start$1, + _1: exn$1._2 + }, + _2: match$2.hd + }); + } + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "parsing/lexer.mll", + 1026, + 18 + ] }); } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "parsing/lexer.mll", - 1026, - 18 - ] - }); + throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); + } else { + throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); } + } else { throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); } - throw new Caml_js_exceptions.MelangeError(exn$1.MEL_EXN_ID, exn$1); } is_in_string.contents = false; store_string_char(/* '|' */124); @@ -16070,8 +16178,8 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { ___ocaml_lex_state = 132; continue ; case 10 : - const match$5 = comment_start_loc.contents; - if (match$5) { + const match$3 = comment_start_loc.contents; + if (match$3) { const start$2 = Stdlib__List.hd(Stdlib__List.rev(comment_start_loc.contents)); comment_start_loc.contents = /* [] */0; throw new Caml_js_exceptions.MelangeError($$Error$2, { @@ -16080,7 +16188,7 @@ function __ocaml_lex_comment_rec(lexbuf, ___ocaml_lex_state) { TAG: /* Unterminated_comment */2, _0: start$2 }, - _2: match$5.hd + _2: match$3.hd }); } throw new Caml_js_exceptions.MelangeError("Assert_failure", { @@ -16248,81 +16356,93 @@ function token_with_comments(lexbuf) { function interpret_directive(lexbuf, cont, look_ahead) { const if_then_else$1 = if_then_else.contents; const match = token_with_comments(lexbuf); - if (typeof match === "number") { + if (/* tag */typeof match === "number" || typeof match === "string") { switch (match) { case /* ELSE */23 : - if (if_then_else$1) { - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); + switch (if_then_else$1) { + case /* Dir_if_true */0 : + break; + case /* Dir_if_false */1 : + case /* Dir_out */2 : + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + } break; case /* END */24 : - if (if_then_else$1 >= 2) { - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); + switch (if_then_else$1) { + case /* Dir_if_true */0 : + case /* Dir_if_false */1 : + if_then_else.contents = /* Dir_out */2; + return Curry._1(cont, lexbuf); + case /* Dir_out */2 : + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + } - if_then_else.contents = /* Dir_out */2; - return Curry._1(cont, lexbuf); case /* IF */37 : - if (if_then_else$1 >= 2) { - if (directive_parse(token_with_comments, lexbuf)) { - if_then_else.contents = /* Dir_if_true */0; - return Curry._1(cont, lexbuf); - } else { - let _param; - while(true) { - const token = token_with_comments(lexbuf); - if (Caml_obj.caml_equal(token, /* EOF */25)) { - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unterminated_if */2, - _2: curr(lexbuf) - }); - } - if (Caml_obj.caml_equal(token, /* SHARP */84) && at_bol(lexbuf)) { - const token$1 = token_with_comments(lexbuf); - if (typeof token$1 === "number") { - if (token$1 === 24 || token$1 === 23) { - if (token$1 >= 24) { - if_then_else.contents = /* Dir_out */2; - return Curry._1(cont, lexbuf); - } else { - if_then_else.contents = /* Dir_if_false */1; - return Curry._1(cont, lexbuf); - } - } - if (token$1 === 37) { + switch (if_then_else$1) { + case /* Dir_if_true */0 : + case /* Dir_if_false */1 : + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + case /* Dir_out */2 : + if (directive_parse(token_with_comments, lexbuf)) { + if_then_else.contents = /* Dir_if_true */0; + return Curry._1(cont, lexbuf); + } else { + let _param; + while(true) { + const token = token_with_comments(lexbuf); + if (Caml_obj.caml_equal(token, /* EOF */25)) { throw new Caml_js_exceptions.MelangeError($$Error$2, { MEL_EXN_ID: $$Error$2, - _1: /* Unexpected_directive */6, + _1: /* Unterminated_if */2, _2: curr(lexbuf) }); } - - } - if (is_elif(token$1) && directive_parse(token_with_comments, lexbuf)) { - if_then_else.contents = /* Dir_if_true */0; - return Curry._1(cont, lexbuf); - } - _param = undefined; - continue ; + if (Caml_obj.caml_equal(token, /* SHARP */84) && at_bol(lexbuf)) { + const token$1 = token_with_comments(lexbuf); + if (/* tag */typeof token$1 === "number" || typeof token$1 === "string") { + switch (token$1) { + case /* ELSE */23 : + if_then_else.contents = /* Dir_if_false */1; + return Curry._1(cont, lexbuf); + case /* END */24 : + if_then_else.contents = /* Dir_out */2; + return Curry._1(cont, lexbuf); + case /* IF */37 : + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + default: + + } + } + if (is_elif(token$1) && directive_parse(token_with_comments, lexbuf)) { + if_then_else.contents = /* Dir_if_true */0; + return Curry._1(cont, lexbuf); + } + _param = undefined; + continue ; + } + _param = undefined; + continue ; + }; } - _param = undefined; - continue ; - }; - } + } - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); default: return Curry._1(look_ahead, match); } @@ -16333,107 +16453,123 @@ function interpret_directive(lexbuf, cont, look_ahead) { if (match._0 !== "elif") { return Curry._1(look_ahead, match); } - if (if_then_else$1) { - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); + switch (if_then_else$1) { + case /* Dir_if_true */0 : + break; + case /* Dir_if_false */1 : + case /* Dir_out */2 : + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + } - } - if (if_then_else$1) { - return Curry._1(look_ahead, match); - } - let _else_seen = Caml_obj.caml_equal(match, /* ELSE */23); - while(true) { - const else_seen = _else_seen; - const token$2 = token_with_comments(lexbuf); - if (Caml_obj.caml_equal(token$2, /* EOF */25)) { - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unterminated_else */3, - _2: curr(lexbuf) - }); - } - if (Caml_obj.caml_equal(token$2, /* SHARP */84) && at_bol(lexbuf)) { - const token$3 = token_with_comments(lexbuf); - if (typeof token$3 === "number") { - if (token$3 === 24 || token$3 === 23) { - if (token$3 >= 24) { - if_then_else.contents = /* Dir_out */2; - return Curry._1(cont, lexbuf); - } - if (else_seen) { + switch (if_then_else$1) { + case /* Dir_if_true */0 : + let _else_seen = Caml_obj.caml_equal(match, /* ELSE */23); + while(true) { + const else_seen = _else_seen; + const token$2 = token_with_comments(lexbuf); + if (Caml_obj.caml_equal(token$2, /* EOF */25)) { throw new Caml_js_exceptions.MelangeError($$Error$2, { MEL_EXN_ID: $$Error$2, - _1: /* Unexpected_directive */6, + _1: /* Unterminated_else */3, _2: curr(lexbuf) }); } - _else_seen = true; + if (Caml_obj.caml_equal(token$2, /* SHARP */84) && at_bol(lexbuf)) { + const token$3 = token_with_comments(lexbuf); + if (/* tag */typeof token$3 === "number" || typeof token$3 === "string") { + switch (token$3) { + case /* ELSE */23 : + if (else_seen) { + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + } + _else_seen = true; + continue ; + case /* END */24 : + if_then_else.contents = /* Dir_out */2; + return Curry._1(cont, lexbuf); + case /* IF */37 : + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + default: + + } + } + if (else_seen && is_elif(token$3)) { + throw new Caml_js_exceptions.MelangeError($$Error$2, { + MEL_EXN_ID: $$Error$2, + _1: /* Unexpected_directive */6, + _2: curr(lexbuf) + }); + } + continue ; + } continue ; - } - if (token$3 === 37) { - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); - } - - } - if (else_seen && is_elif(token$3)) { - throw new Caml_js_exceptions.MelangeError($$Error$2, { - MEL_EXN_ID: $$Error$2, - _1: /* Unexpected_directive */6, - _2: curr(lexbuf) - }); - } - continue ; - } - continue ; - }; + }; + case /* Dir_if_false */1 : + case /* Dir_out */2 : + return Curry._1(look_ahead, match); + + } } function token$1(lexbuf) { const post_pos = lexbuf.lex_curr_p; const attach = function (lines, docs, pre_pos) { - if (typeof docs === "number") { + if (/* tag */typeof docs === "number" || typeof docs === "string") { return ; } if (docs.TAG === /* After */0) { const a = docs._0; - if (lines >= 2) { - set_post_docstrings(post_pos, Stdlib__List.rev(a)); - return set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a)); - } else { - set_post_docstrings(post_pos, Stdlib__List.rev(a)); - return set_pre_docstrings(pre_pos, a); + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + break; + case /* BlankLine */2 : + set_post_docstrings(post_pos, Stdlib__List.rev(a)); + return set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a)); + } + set_post_docstrings(post_pos, Stdlib__List.rev(a)); + return set_pre_docstrings(pre_pos, a); } const b = docs._2; const f = docs._1; const a$1 = docs._0; - if (lines >= 2) { - set_post_docstrings(post_pos, Stdlib__List.rev(a$1)); - set_post_extra_docstrings(post_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); - set_floating_docstrings(pre_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); - return set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a$1)); - } else { - set_post_docstrings(post_pos, Stdlib__List.rev(a$1)); - set_post_extra_docstrings(post_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); - set_floating_docstrings(pre_pos, Stdlib__List.rev(f)); - set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a$1)); - return set_pre_docstrings(pre_pos, b); + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + break; + case /* BlankLine */2 : + set_post_docstrings(post_pos, Stdlib__List.rev(a$1)); + set_post_extra_docstrings(post_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); + set_floating_docstrings(pre_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); + return set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a$1)); + } + set_post_docstrings(post_pos, Stdlib__List.rev(a$1)); + set_post_extra_docstrings(post_pos, Stdlib__List.rev_append(f, Stdlib__List.rev(b))); + set_floating_docstrings(pre_pos, Stdlib__List.rev(f)); + set_pre_extra_docstrings(pre_pos, Stdlib__List.rev(a$1)); + set_pre_docstrings(pre_pos, b); }; const loop = function (_lines, _docs, lexbuf) { while(true) { const docs = _docs; const lines = _lines; const doc = token_with_comments(lexbuf); - if (typeof doc === "number") { + if (/* tag */typeof doc === "number" || typeof doc === "string") { switch (doc) { case /* SHARP */84 : if (at_bol(lexbuf)) { @@ -16446,81 +16582,128 @@ function token$1(lexbuf) { } break; case /* EOL */100 : - const lines$p = lines ? /* BlankLine */2 : /* NewLine */1; + let lines$p; + switch (lines) { + case /* NoLine */0 : + lines$p = /* NewLine */1; + break; + case /* NewLine */1 : + case /* BlankLine */2 : + lines$p = /* BlankLine */2; + break; + + } _lines = lines$p; continue ; default: } } else { - switch (doc.TAG | 0) { + switch (doc.TAG) { case /* COMMENT */18 : const match = doc._0; add_comment([ match[0], match[1] ]); - const lines$p$1 = lines >= 2 ? /* BlankLine */2 : /* NoLine */0; + let lines$p$1; + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + lines$p$1 = /* NoLine */0; + break; + case /* BlankLine */2 : + lines$p$1 = /* BlankLine */2; + break; + + } _lines = lines$p$1; continue ; case /* DOCSTRING */19 : const doc$1 = doc._0; add_docstring_comment(doc$1); let docs$p; - if (typeof docs === "number") { - docs$p = lines >= 2 ? ({ - TAG: /* Before */1, - _0: /* [] */0, - _1: /* [] */0, - _2: { - hd: doc$1, - tl: /* [] */0 - } - }) : ({ - TAG: /* After */0, - _0: { - hd: doc$1, - tl: /* [] */0 - } - }); + if (/* tag */typeof docs === "number" || typeof docs === "string") { + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + docs$p = { + TAG: /* After */0, + _0: { + hd: doc$1, + tl: /* [] */0 + } + }; + break; + case /* BlankLine */2 : + docs$p = { + TAG: /* Before */1, + _0: /* [] */0, + _1: /* [] */0, + _2: { + hd: doc$1, + tl: /* [] */0 + } + }; + break; + + } } else if (docs.TAG === /* After */0) { const a = docs._0; - docs$p = lines >= 2 ? ({ - TAG: /* Before */1, - _0: a, - _1: /* [] */0, - _2: { - hd: doc$1, - tl: /* [] */0 - } - }) : ({ - TAG: /* After */0, - _0: { - hd: doc$1, - tl: a - } - }); + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + docs$p = { + TAG: /* After */0, + _0: { + hd: doc$1, + tl: a + } + }; + break; + case /* BlankLine */2 : + docs$p = { + TAG: /* Before */1, + _0: a, + _1: /* [] */0, + _2: { + hd: doc$1, + tl: /* [] */0 + } + }; + break; + + } } else { const b = docs._2; const f = docs._1; const a$1 = docs._0; - docs$p = lines >= 2 ? ({ - TAG: /* Before */1, - _0: a$1, - _1: Stdlib.$at(b, f), - _2: { - hd: doc$1, - tl: /* [] */0 - } - }) : ({ - TAG: /* Before */1, - _0: a$1, - _1: f, - _2: { - hd: doc$1, - tl: b - } - }); + switch (lines) { + case /* NoLine */0 : + case /* NewLine */1 : + docs$p = { + TAG: /* Before */1, + _0: a$1, + _1: f, + _2: { + hd: doc$1, + tl: b + } + }; + break; + case /* BlankLine */2 : + docs$p = { + TAG: /* Before */1, + _0: a$1, + _1: Stdlib.$at(b, f), + _2: { + hd: doc$1, + tl: /* [] */0 + } + }; + break; + + } } _docs = docs$p; _lines = /* NoLine */0; @@ -16558,36 +16741,38 @@ function init$2(param) { function filter_directive(pos, acc, lexbuf) { while(true) { const match = token_with_comments(lexbuf); - if (typeof match === "number") { - if (match === 25) { - return { - hd: [ - pos, - lexbuf.lex_curr_p.pos_cnum - ], - tl: acc - }; - } - if (match !== 84) { - continue ; - } - if (at_bol(lexbuf)) { - const start_pos = lexbuf.lex_start_p.pos_cnum; - return interpret_directive(lexbuf, (function (lexbuf) { - return filter_directive(lexbuf.lex_curr_p.pos_cnum, { - hd: [ - pos, - start_pos - ], - tl: acc - }, lexbuf); - }), (function (_token) { - return filter_directive(pos, acc, lexbuf); - })); + if (/* tag */typeof match === "number" || typeof match === "string") { + switch (match) { + case /* EOF */25 : + return { + hd: [ + pos, + lexbuf.lex_curr_p.pos_cnum + ], + tl: acc + }; + case /* SHARP */84 : + if (at_bol(lexbuf)) { + const start_pos = lexbuf.lex_start_p.pos_cnum; + return interpret_directive(lexbuf, (function (lexbuf) { + return filter_directive(lexbuf.lex_curr_p.pos_cnum, { + hd: [ + pos, + start_pos + ], + tl: acc + }, lexbuf); + }), (function (_token) { + return filter_directive(pos, acc, lexbuf); + })); + } + continue ; + default: + continue ; } + } else { continue ; } - continue ; }; } @@ -16629,23 +16814,28 @@ function skip_phrase(lexbuf) { while(true) { try { const match = token$1(lexbuf); - if (typeof match === "number" && !(match !== 25 && match !== 83)) { - return ; - } else { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { return skip_phrase(lexbuf); } + switch (match) { + case /* EOF */25 : + case /* SEMISEMI */83 : + return ; + default: + return skip_phrase(lexbuf); + } } catch (raw_exn){ const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); if (exn.MEL_EXN_ID === $$Error$2) { let tmp = exn._1; - if (typeof tmp === "number") { + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { if (tmp === /* Unterminated_string */0) { continue ; } throw new Caml_js_exceptions.MelangeError(exn.MEL_EXN_ID, exn); } else { - switch (tmp.TAG | 0) { + switch (tmp.TAG) { case /* Illegal_character */0 : case /* Unterminated_comment */2 : case /* Unterminated_string_in_comment */3 : @@ -16682,7 +16872,7 @@ function wrap(parsing_fun, lexbuf) { const err = Caml_js_exceptions.internalToOCamlException(raw_err); if (err.MEL_EXN_ID === $$Error$2) { let tmp = err._1; - if (typeof tmp === "number") { + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { throw new Caml_js_exceptions.MelangeError(err.MEL_EXN_ID, err); } if (tmp.TAG === /* Illegal_character */0) { diff --git a/jscomp/test/dist/jscomp/test/parser_api_test.js b/jscomp/test/dist/jscomp/test/parser_api_test.js index 18c06a614b..9792ddab0f 100644 --- a/jscomp/test/dist/jscomp/test/parser_api_test.js +++ b/jscomp/test/dist/jscomp/test/parser_api_test.js @@ -21,13 +21,13 @@ const match = Parser_api.implementation(Stdlib__Lexing.from_string(undefined, "l if (match) { const match$1 = match.hd.pstr_desc; - if (match$1.TAG === /* Pstr_value */1 && !match$1._0) { + if (match$1.TAG === /* Pstr_value */1 && match$1._0 === /* Nonrecursive */0) { const match$2 = match$1._1; if (match$2) { const match$3 = match$2.hd; const match$4 = match$3.pvb_pat; const match$5 = match$4.ppat_desc; - if (typeof match$5 === "number" || match$5.TAG !== /* Ppat_var */0) { + if (/* tag */typeof match$5 === "number" || typeof match$5 === "string" || match$5.TAG !== /* Ppat_var */0) { eq("File \"jscomp/test/parser_api_test.ml\", line 211, characters 12-19", true, false); } else { const match$6 = match$5._0; @@ -47,7 +47,7 @@ if (match) { if (match$14.TAG === /* Pexp_fun */4 && match$14._0 === "" && match$14._1 === undefined) { const match$15 = match$14._2; const match$16 = match$15.ppat_desc; - if (typeof match$16 === "number" || match$16.TAG !== /* Ppat_var */0) { + if (/* tag */typeof match$16 === "number" || typeof match$16 === "string" || match$16.TAG !== /* Ppat_var */0) { eq("File \"jscomp/test/parser_api_test.ml\", line 211, characters 12-19", true, false); } else { const match$17 = match$16._0; @@ -70,7 +70,7 @@ if (match) { if (match$27.TAG === /* Pexp_ident */0) { const match$28 = match$27._0; const match$29 = match$28.txt; - switch (match$29.TAG | 0) { + switch (match$29.TAG) { case /* Lident */0 : if (match$29._0 === "|>") { const match$30 = match$28.loc; @@ -95,7 +95,7 @@ if (match) { if (match$41.TAG === /* Pexp_ident */0) { const match$42 = match$41._0; const match$43 = match$42.txt; - switch (match$43.TAG | 0) { + switch (match$43.TAG) { case /* Lident */0 : if (match$43._0 === "|>") { const match$44 = match$42.loc; @@ -117,7 +117,7 @@ if (match) { if (match$53.TAG === /* Pexp_ident */0) { const match$54 = match$53._0; const match$55 = match$54.txt; - switch (match$55.TAG | 0) { + switch (match$55.TAG) { case /* Lident */0 : if (match$55._0 === "str") { const match$56 = match$54.loc; @@ -139,10 +139,10 @@ if (match) { if (match$65.TAG === /* Pexp_ident */0) { const match$66 = match$65._0; const match$67 = match$66.txt; - switch (match$67.TAG | 0) { + switch (match$67.TAG) { case /* Ldot */1 : const match$68 = match$67._0; - switch (match$68.TAG | 0) { + switch (match$68.TAG) { case /* Lident */0 : if (match$68._0 === "Lexing" && match$67._1 === "from_string") { const match$69 = match$66.loc; @@ -169,10 +169,10 @@ if (match) { if (match$81.TAG === /* Pexp_ident */0) { const match$82 = match$81._0; const match$83 = match$82.txt; - switch (match$83.TAG | 0) { + switch (match$83.TAG) { case /* Ldot */1 : const match$84 = match$83._0; - switch (match$84.TAG | 0) { + switch (match$84.TAG) { case /* Lident */0 : if (match$84._0 === "Parse" && match$83._1 === "implementation") { const match$85 = match$82.loc; diff --git a/jscomp/test/dist/jscomp/test/pq_test.js b/jscomp/test/dist/jscomp/test/pq_test.js index 020b5c685a..220bb305e0 100644 --- a/jscomp/test/dist/jscomp/test/pq_test.js +++ b/jscomp/test/dist/jscomp/test/pq_test.js @@ -5,8 +5,9 @@ const Caml_exceptions = require("melange.js/caml_exceptions.js"); const Caml_js_exceptions = require("melange.js/caml_js_exceptions.js"); function insert(queue, prio, elt) { - if (!queue) { - return /* Node */{ + if (/* tag */typeof queue === "number" || typeof queue === "string") { + return { + TAG: /* Node */0, _0: prio, _1: elt, _2: /* Empty */0, @@ -18,14 +19,16 @@ function insert(queue, prio, elt) { const e = queue._1; const p = queue._0; if (prio <= p) { - return /* Node */{ + return { + TAG: /* Node */0, _0: prio, _1: elt, _2: insert(right, p, e), _3: left }; } else { - return /* Node */{ + return { + TAG: /* Node */0, _0: p, _1: e, _2: insert(right, prio, elt), @@ -37,40 +40,43 @@ function insert(queue, prio, elt) { const Queue_is_empty = /* @__PURE__ */Caml_exceptions.create("Pq_test.PrioQueue.Queue_is_empty"); function remove_top(param) { - if (param) { - const left = param._2; - if (!param._3) { - return left; - } - if (!left) { - return param._3; - } - const right = param._3; - const rprio = right._0; - const lprio = left._0; - if (lprio <= rprio) { - return /* Node */{ - _0: lprio, - _1: left._1, - _2: remove_top(left), - _3: right - }; - } else { - return /* Node */{ - _0: rprio, - _1: right._1, - _2: left, - _3: remove_top(right) - }; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Queue_is_empty, { + MEL_EXN_ID: Queue_is_empty + }); + } + const left = param._2; + let tmp = param._3; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return left; + } + if (/* tag */typeof left === "number" || typeof left === "string") { + return param._3; + } + const right = param._3; + const rprio = right._0; + const lprio = left._0; + if (lprio <= rprio) { + return { + TAG: /* Node */0, + _0: lprio, + _1: left._1, + _2: remove_top(left), + _3: right + }; + } else { + return { + TAG: /* Node */0, + _0: rprio, + _1: right._1, + _2: left, + _3: remove_top(right) + }; } - throw new Caml_js_exceptions.MelangeError(Queue_is_empty, { - MEL_EXN_ID: Queue_is_empty - }); } function extract(queue) { - if (queue) { + if (!/* tag */(typeof queue === "number" || typeof queue === "string")) { return [ queue._0, queue._1, diff --git a/jscomp/test/dist/jscomp/test/printf_sim.js b/jscomp/test/dist/jscomp/test/printf_sim.js index 9bf738d336..fa1dc7607b 100644 --- a/jscomp/test/dist/jscomp/test/printf_sim.js +++ b/jscomp/test/dist/jscomp/test/printf_sim.js @@ -4,7 +4,8 @@ const Curry = require("melange.js/curry.js"); const Stdlib__Printf = require("melange/printf.js"); -Curry._1(Stdlib__Printf.printf(/* Format */{ +Curry._1(Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_d */0, @@ -22,7 +23,8 @@ Curry._1(Stdlib__Printf.printf(/* Format */{ 32 ]); -Stdlib__Printf.printf(/* Format */{ +Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "heloo!\nhelloxx\n", @@ -31,7 +33,8 @@ Stdlib__Printf.printf(/* Format */{ _1: "heloo!\nhelloxx\n" }); -Stdlib__Printf.printf(/* Format */{ +Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "hello\nhi\n", @@ -40,7 +43,8 @@ Stdlib__Printf.printf(/* Format */{ _1: "hello\nhi\n" }); -Curry._2(Stdlib__Printf.printf(/* Format */{ +Curry._2(Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -58,14 +62,16 @@ Curry._2(Stdlib__Printf.printf(/* Format */{ _1: "%*d\n\n" }), 32, 3); -Curry._1(Stdlib__Printf.printf(/* Format */{ +Curry._1(Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, _1: /* End_of_format */0 }, _1: "%s" - }), Curry._2(Stdlib__Printf.sprintf(/* Format */{ + }), Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, diff --git a/jscomp/test/dist/jscomp/test/printf_test.js b/jscomp/test/dist/jscomp/test/printf_test.js index 740bb55d8d..e2e7595b4e 100644 --- a/jscomp/test/dist/jscomp/test/printf_test.js +++ b/jscomp/test/dist/jscomp/test/printf_test.js @@ -7,7 +7,8 @@ const Stdlib__Format = require("melange/format.js"); const Stdlib__Printf = require("melange/printf.js"); function print_pair(fmt, param) { - Curry._2(Stdlib__Format.fprintf(fmt)(/* Format */{ + Curry._2(Stdlib__Format.fprintf(fmt)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '(' */40, @@ -43,7 +44,8 @@ const suites_0 = [ return { TAG: /* Eq */0, _0: "3232", - _1: Curry._2(Stdlib__Printf.sprintf(/* Format */{ + _1: Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -68,7 +70,8 @@ const suites_1 = { return { TAG: /* Eq */0, _0: "xx", - _1: Stdlib__Format.asprintf(/* Format */{ + _1: Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "xx", @@ -86,7 +89,8 @@ const suites_1 = { return { TAG: /* Eq */0, _0: "(1,2)", - _1: Curry._2(Stdlib__Format.asprintf(/* Format */{ + _1: Curry._2(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: /* End_of_format */0 @@ -108,7 +112,8 @@ const suites = { tl: suites_1 }; -const v = Stdlib__Format.asprintf(/* Format */{ +const v = Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "xx", diff --git a/jscomp/test/dist/jscomp/test/qcc.js b/jscomp/test/dist/jscomp/test/qcc.js index da2dfde454..988177e414 100644 --- a/jscomp/test/dist/jscomp/test/qcc.js +++ b/jscomp/test/dist/jscomp/test/qcc.js @@ -383,7 +383,8 @@ function patch(rel, loc, n) { const loc$p = get32(loc); const x = rel ? n - (loc + 4 | 0) | 0 : n; if (dbg.contents) { - Curry._3(Stdlib__Printf.eprintf(/* Format */{ + Curry._3(Stdlib__Printf.eprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "patching at ", @@ -489,17 +490,7 @@ function patchlval(param) { } function read(param) { - if (param) { - out(4722614); - le(8, 0); - lval.contents = [ - { - TAG: /* Del */1, - _0: 4 - }, - /* Chr */1 - ]; - } else { + if (param === /* Int */0) { out(18571); le(8, 0); lval.contents = [ @@ -509,7 +500,17 @@ function read(param) { }, /* Int */0 ]; + return ; } + out(4722614); + le(8, 0); + lval.contents = [ + { + TAG: /* Del */1, + _0: 4 + }, + /* Chr */1 + ]; } const globs = Caml_array.make(100, { @@ -928,7 +929,7 @@ function binary(stk, lvl) { function unary(stk) { const i = Curry._1(next$1, undefined); - switch (i.TAG | 0) { + switch (i.TAG) { case /* Op */0 : const o = i._0; switch (o) { @@ -998,7 +999,8 @@ function unary(stk) { }; unary(stk); if (!Stdlib__List.mem_assoc(o, unops)) { - const s = Curry._1(Stdlib__Printf.sprintf(/* Format */{ + const s = Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unknown operator ", @@ -1287,7 +1289,8 @@ function decl(g, _n, _stk) { const match = vars(0, stk); Curry._1(next$1, undefined); if (dbg.contents) { - Curry._1(Stdlib__Printf.eprintf(/* Format */{ + Curry._1(Stdlib__Printf.eprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "end of decl (", @@ -1527,7 +1530,7 @@ function top(_param) { const n = _n; const regs = _regs; const i = Curry._1(next$1, undefined); - switch (i.TAG | 0) { + switch (i.TAG) { case /* Op */0 : if (i._0 === ")") { return stk; @@ -1606,7 +1609,8 @@ function top(_param) { patch(true, retl.contents, opos.contents); out(51651); if (dbg.contents) { - Curry._1(Stdlib__Printf.eprintf(/* Format */{ + Curry._1(Stdlib__Printf.eprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "done with function ", @@ -1867,9 +1871,10 @@ function elfgen(outf) { function main(param) { const ppsym = function (s) { - switch (s.TAG | 0) { + switch (s.TAG) { case /* Op */0 : - return Curry._1(Stdlib__Printf.printf(/* Format */{ + return Curry._1(Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Operator '", @@ -1886,7 +1891,8 @@ function main(param) { _1: "Operator '%s'\n" }), s._0); case /* ILit */1 : - return Curry._1(Stdlib__Printf.printf(/* Format */{ + return Curry._1(Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Int literal ", @@ -1905,7 +1911,8 @@ function main(param) { _1: "Int literal %d\n" }), s._0); case /* SLit */2 : - return Curry._1(Stdlib__Printf.printf(/* Format */{ + return Curry._1(Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Str literal ", @@ -1923,7 +1930,8 @@ function main(param) { }), s._1); case /* Sym */3 : const i = s._0; - return Curry._2(Stdlib__Printf.printf(/* Format */{ + return Curry._2(Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Symbol '", @@ -1975,7 +1983,8 @@ function main(param) { const tok = Curry._1(next$1, undefined); if (tok.TAG === /* Op */0) { if (tok._0 === "EOF!") { - return Stdlib__Printf.printf(/* Format */{ + return Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "End of input stream\n", diff --git a/jscomp/test/dist/jscomp/test/random_test.js b/jscomp/test/dist/jscomp/test/random_test.js index 2b40b2c2e8..c448698d9b 100644 --- a/jscomp/test/dist/jscomp/test/random_test.js +++ b/jscomp/test/dist/jscomp/test/random_test.js @@ -71,7 +71,8 @@ const xx = Stdlib__Random.$$float(3.0); const xxx = Stdlib__Random.int32(103); -Curry._5(Stdlib__Printf.printf(/* Format */{ +Curry._5(Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_d */0, diff --git a/jscomp/test/dist/jscomp/test/rbset.js b/jscomp/test/dist/jscomp/test/rbset.js index 3d9411652d..e106c01594 100644 --- a/jscomp/test/dist/jscomp/test/rbset.js +++ b/jscomp/test/dist/jscomp/test/rbset.js @@ -4,9 +4,15 @@ const Caml_js_exceptions = require("melange.js/caml_js_exceptions.js"); function blackify(s) { - if (s && s._0) { + if (/* tag */typeof s === "number" || typeof s === "string" || s._0 === /* Black */0) { return [ - /* Node */{ + s, + true + ]; + } else { + return [ + { + TAG: /* Node */0, _0: /* Black */0, _1: s._1, _2: s._2, @@ -14,26 +20,21 @@ function blackify(s) { }, false ]; - } else { - return [ - s, - true - ]; } } function is_empty(param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } } function mem(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const y = param._2; @@ -58,10 +59,14 @@ function balance_left(l, x, r) { let c; let z; let d; - if (l && l._0) { + if (/* tag */typeof l === "number" || typeof l === "string" || l._0 === /* Black */0) { + exit = 1; + } else { const a$1 = l._1; let exit$1 = 0; - if (a$1 && a$1._0) { + if (/* tag */typeof a$1 === "number" || typeof a$1 === "string" || a$1._0 === /* Black */0) { + exit$1 = 3; + } else { a = a$1._1; x$1 = a$1._2; b = a$1._3; @@ -70,12 +75,12 @@ function balance_left(l, x, r) { z = x; d = r; exit = 2; - } else { - exit$1 = 3; } if (exit$1 === 3) { const match = l._3; - if (match && match._0) { + if (/* tag */typeof match === "number" || typeof match === "string" || match._0 === /* Black */0) { + exit = 1; + } else { a = a$1; x$1 = l._2; b = match._1; @@ -84,33 +89,33 @@ function balance_left(l, x, r) { z = x; d = r; exit = 2; - } else { - exit = 1; } } - } else { - exit = 1; } switch (exit) { case 1 : - return /* Node */{ + return { + TAG: /* Node */0, _0: /* Black */0, _1: l, _2: x, _3: r }; case 2 : - return /* Node */{ + return { + TAG: /* Node */0, _0: /* Red */1, - _1: /* Node */{ + _1: { + TAG: /* Node */0, _0: /* Black */0, _1: a, _2: x$1, _3: b }, _2: y, - _3: /* Node */{ + _3: { + TAG: /* Node */0, _0: /* Black */0, _1: c, _2: z, @@ -130,10 +135,14 @@ function balance_right(l, x, r) { let c; let z; let d; - if (r && r._0) { + if (/* tag */typeof r === "number" || typeof r === "string" || r._0 === /* Black */0) { + exit = 1; + } else { const b$1 = r._1; let exit$1 = 0; - if (b$1 && b$1._0) { + if (/* tag */typeof b$1 === "number" || typeof b$1 === "string" || b$1._0 === /* Black */0) { + exit$1 = 3; + } else { a = l; x$1 = x; b = b$1._1; @@ -142,12 +151,12 @@ function balance_right(l, x, r) { z = r._2; d = r._3; exit = 2; - } else { - exit$1 = 3; } if (exit$1 === 3) { const match = r._3; - if (match && match._0) { + if (/* tag */typeof match === "number" || typeof match === "string" || match._0 === /* Black */0) { + exit = 1; + } else { a = l; x$1 = x; b = b$1; @@ -156,33 +165,33 @@ function balance_right(l, x, r) { z = match._2; d = match._3; exit = 2; - } else { - exit = 1; } } - } else { - exit = 1; } switch (exit) { case 1 : - return /* Node */{ + return { + TAG: /* Node */0, _0: /* Black */0, _1: l, _2: x, _3: r }; case 2 : - return /* Node */{ + return { + TAG: /* Node */0, _0: /* Red */1, - _1: /* Node */{ + _1: { + TAG: /* Node */0, _0: /* Black */0, _1: a, _2: x$1, _3: b }, _2: y, - _3: /* Node */{ + _3: { + TAG: /* Node */0, _0: /* Black */0, _1: c, _2: z, @@ -194,7 +203,8 @@ function balance_right(l, x, r) { } function singleton(x) { - return /* Node */{ + return { + TAG: /* Node */0, _0: /* Black */0, _1: /* Empty */0, _2: x, @@ -203,47 +213,36 @@ function singleton(x) { } function unbalanced_left(param) { - if (param) { - if (param._0) { + if (!/* tag */(typeof param === "number" || typeof param === "string")) { + if (param._0 === /* Black */0) { const match = param._1; - if (match && !match._0) { - return [ - balance_left(/* Node */{ - _0: /* Red */1, - _1: match._1, - _2: match._2, - _3: match._3 - }, param._2, param._3), - false - ]; - } - - } else { - const match$1 = param._1; - if (match$1) { - if (!match$1._0) { + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + if (match._0 === /* Black */0) { return [ - balance_left(/* Node */{ + balance_left({ + TAG: /* Node */0, _0: /* Red */1, - _1: match$1._1, - _2: match$1._2, - _3: match$1._3 + _1: match._1, + _2: match._2, + _3: match._3 }, param._2, param._3), true ]; } - const match$2 = match$1._3; - if (match$2 && !match$2._0) { + const match$1 = match._3; + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string") && match$1._0 === /* Black */0) { return [ - /* Node */{ + { + TAG: /* Node */0, _0: /* Black */0, - _1: match$1._1, - _2: match$1._2, - _3: balance_left(/* Node */{ + _1: match._1, + _2: match._2, + _3: balance_left({ + TAG: /* Node */0, _0: /* Red */1, - _1: match$2._1, - _2: match$2._2, - _3: match$2._3 + _1: match$1._1, + _2: match$1._2, + _3: match$1._3 }, param._2, param._3) }, false @@ -252,6 +251,21 @@ function unbalanced_left(param) { } + } else { + const match$2 = param._1; + if (!/* tag */(typeof match$2 === "number" || typeof match$2 === "string") && match$2._0 === /* Black */0) { + return [ + balance_left({ + TAG: /* Node */0, + _0: /* Red */1, + _1: match$2._1, + _2: match$2._2, + _3: match$2._3 + }, param._2, param._3), + false + ]; + } + } } throw new Caml_js_exceptions.MelangeError("Assert_failure", { @@ -265,50 +279,39 @@ function unbalanced_left(param) { } function unbalanced_right(param) { - if (param) { - if (param._0) { + if (!/* tag */(typeof param === "number" || typeof param === "string")) { + if (param._0 === /* Black */0) { const match = param._3; - if (match && !match._0) { - return [ - balance_right(param._1, param._2, /* Node */{ - _0: /* Red */1, - _1: match._1, - _2: match._2, - _3: match._3 - }), - false - ]; - } - - } else { - const match$1 = param._3; - if (match$1) { - const x = param._2; - const a = param._1; - if (!match$1._0) { + const x = param._2; + const a = param._1; + if (!/* tag */(typeof match === "number" || typeof match === "string")) { + if (match._0 === /* Black */0) { return [ - balance_right(a, x, /* Node */{ + balance_right(a, x, { + TAG: /* Node */0, _0: /* Red */1, - _1: match$1._1, - _2: match$1._2, - _3: match$1._3 + _1: match._1, + _2: match._2, + _3: match._3 }), true ]; } - const match$2 = match$1._1; - if (match$2 && !match$2._0) { + const match$1 = match._1; + if (!/* tag */(typeof match$1 === "number" || typeof match$1 === "string") && match$1._0 === /* Black */0) { return [ - /* Node */{ + { + TAG: /* Node */0, _0: /* Black */0, - _1: balance_right(a, x, /* Node */{ + _1: balance_right(a, x, { + TAG: /* Node */0, _0: /* Red */1, - _1: match$2._1, - _2: match$2._2, - _3: match$2._3 + _1: match$1._1, + _2: match$1._2, + _3: match$1._3 }), - _2: match$1._2, - _3: match$1._3 + _2: match._2, + _3: match._3 }, false ]; @@ -316,6 +319,21 @@ function unbalanced_right(param) { } + } else { + const match$2 = param._3; + if (!/* tag */(typeof match$2 === "number" || typeof match$2 === "string") && match$2._0 === /* Black */0) { + return [ + balance_right(param._1, param._2, { + TAG: /* Node */0, + _0: /* Red */1, + _1: match$2._1, + _2: match$2._2, + _3: match$2._3 + }), + false + ]; + } + } } throw new Caml_js_exceptions.MelangeError("Assert_failure", { @@ -329,16 +347,18 @@ function unbalanced_right(param) { } function lbalance(x1, x2, x3) { - if (!x1) { - return /* Node */{ + if (/* tag */typeof x1 === "number" || typeof x1 === "string") { + return { + TAG: /* Node */0, _0: /* Black */0, _1: x1, _2: x2, _3: x3 }; } - if (!x1._0) { - return /* Node */{ + if (x1._0 === /* Black */0) { + return { + TAG: /* Node */0, _0: /* Black */0, _1: x1, _2: x2, @@ -347,17 +367,20 @@ function lbalance(x1, x2, x3) { } const r = x1._3; const l = x1._1; - if (l && l._0) { - return /* Node */{ + if (!/* tag */(typeof l === "number" || typeof l === "string") && l._0 !== /* Black */0) { + return { + TAG: /* Node */0, _0: /* Red */1, - _1: /* Node */{ + _1: { + TAG: /* Node */0, _0: /* Black */0, _1: l._1, _2: l._2, _3: l._3 }, _2: x1._2, - _3: /* Node */{ + _3: { + TAG: /* Node */0, _0: /* Black */0, _1: r, _2: x2, @@ -365,16 +388,18 @@ function lbalance(x1, x2, x3) { } }; } - if (!r) { - return /* Node */{ + if (/* tag */typeof r === "number" || typeof r === "string") { + return { + TAG: /* Node */0, _0: /* Black */0, _1: x1, _2: x2, _3: x3 }; } - if (!r._0) { - return /* Node */{ + if (r._0 === /* Black */0) { + return { + TAG: /* Node */0, _0: /* Black */0, _1: x1, _2: x2, @@ -382,16 +407,19 @@ function lbalance(x1, x2, x3) { }; } const y = r._2; - return /* Node */{ + return { + TAG: /* Node */0, _0: /* Red */1, - _1: /* Node */{ + _1: { + TAG: /* Node */0, _0: /* Black */0, _1: l, _2: y, _3: r._1 }, _2: y, - _3: /* Node */{ + _3: { + TAG: /* Node */0, _0: /* Black */0, _1: r._3, _2: x2, @@ -401,21 +429,26 @@ function lbalance(x1, x2, x3) { } function rbalance(x1, x2, x3) { - if (x3 && x3._0) { + if (!/* tag */(typeof x3 === "number" || typeof x3 === "string") && x3._0 !== /* Black */0) { const b = x3._1; let exit = 0; - if (b) { - if (b._0) { - return /* Node */{ + if (/* tag */typeof b === "number" || typeof b === "string") { + exit = 2; + } else { + if (b._0 !== /* Black */0) { + return { + TAG: /* Node */0, _0: /* Red */1, - _1: /* Node */{ + _1: { + TAG: /* Node */0, _0: /* Black */0, _1: x1, _2: x2, _3: b._1 }, _2: b._2, - _3: /* Node */{ + _3: { + TAG: /* Node */0, _0: /* Black */0, _1: b._3, _2: x3._2, @@ -424,22 +457,23 @@ function rbalance(x1, x2, x3) { }; } exit = 2; - } else { - exit = 2; } if (exit === 2) { const match = x3._3; - if (match && match._0) { - return /* Node */{ + if (!/* tag */(typeof match === "number" || typeof match === "string") && match._0 !== /* Black */0) { + return { + TAG: /* Node */0, _0: /* Red */1, - _1: /* Node */{ + _1: { + TAG: /* Node */0, _0: /* Black */0, _1: x1, _2: x2, _3: b }, _2: x3._2, - _3: /* Node */{ + _3: { + TAG: /* Node */0, _0: /* Black */0, _1: match._1, _2: match._2, @@ -451,7 +485,8 @@ function rbalance(x1, x2, x3) { } } - return /* Node */{ + return { + TAG: /* Node */0, _0: /* Black */0, _1: x1, _2: x2, @@ -460,15 +495,16 @@ function rbalance(x1, x2, x3) { } function ins(x, s) { - if (!s) { - return /* Node */{ + if (/* tag */typeof s === "number" || typeof s === "string") { + return { + TAG: /* Node */0, _0: /* Red */1, _1: /* Empty */0, _2: x, _3: /* Empty */0 }; } - if (s._0) { + if (s._0 === /* Black */0) { const y = s._2; if (x === y) { return s; @@ -476,19 +512,9 @@ function ins(x, s) { const b = s._3; const a = s._1; if (x < y) { - return /* Node */{ - _0: /* Red */1, - _1: ins(x, a), - _2: y, - _3: b - }; + return lbalance(ins(x, a), y, b); } else { - return /* Node */{ - _0: /* Red */1, - _1: a, - _2: y, - _3: ins(x, b) - }; + return rbalance(a, y, ins(x, b)); } } const y$1 = s._2; @@ -498,51 +524,67 @@ function ins(x, s) { const b$1 = s._3; const a$1 = s._1; if (x < y$1) { - return lbalance(ins(x, a$1), y$1, b$1); + return { + TAG: /* Node */0, + _0: /* Red */1, + _1: ins(x, a$1), + _2: y$1, + _3: b$1 + }; } else { - return rbalance(a$1, y$1, ins(x, b$1)); + return { + TAG: /* Node */0, + _0: /* Red */1, + _1: a$1, + _2: y$1, + _3: ins(x, b$1) + }; } } function add(x, s) { const s$1 = ins(x, s); - if (s$1 && s$1._0) { - return /* Node */{ + if (/* tag */typeof s$1 === "number" || typeof s$1 === "string" || s$1._0 === /* Black */0) { + return s$1; + } else { + return { + TAG: /* Node */0, _0: /* Black */0, _1: s$1._1, _2: s$1._2, _3: s$1._3 }; - } else { - return s$1; } } function remove_min(param) { - if (param) { - const c = param._0; - if (c) { - if (!param._1) { - return [ - param._3, - param._2, - false - ]; - } - - } else if (!param._1) { + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/test/rbset.ml", + 115, + 4 + ] + }); + } + const c = param._0; + if (c === /* Black */0) { + let tmp = param._1; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { const match = param._3; const x = param._2; - if (!match) { + if (/* tag */typeof match === "number" || typeof match === "string") { return [ /* Empty */0, x, true ]; } - if (match._0) { + if (match._0 !== /* Black */0) { return [ - /* Node */{ + { + TAG: /* Node */0, _0: /* Black */0, _1: match._1, _2: match._2, @@ -561,43 +603,47 @@ function remove_min(param) { ] }); } - const match$1 = remove_min(param._1); - const y = match$1[1]; - const s_1 = match$1[0]; - const s_2 = param._2; - const s_3 = param._3; - const s = /* Node */{ - _0: c, - _1: s_1, - _2: s_2, - _3: s_3 - }; - if (!match$1[2]) { + + } else { + let tmp$1 = param._1; + if (/* tag */typeof tmp$1 === "number" || typeof tmp$1 === "string") { return [ - s, - y, + param._3, + param._2, false ]; } - const match$2 = unbalanced_right(s); + + } + const match$1 = remove_min(param._1); + const y = match$1[1]; + const s_1 = match$1[0]; + const s_2 = param._2; + const s_3 = param._3; + const s = { + TAG: /* Node */0, + _0: c, + _1: s_1, + _2: s_2, + _3: s_3 + }; + if (!match$1[2]) { return [ - match$2[0], + s, y, - match$2[1] + false ]; } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/test/rbset.ml", - 115, - 4 - ] - }); + const match$2 = unbalanced_right(s); + return [ + match$2[0], + y, + match$2[1] + ]; } function remove_aux(x, n) { - if (!n) { + if (/* tag */typeof n === "number" || typeof n === "string") { return [ /* Empty */0, false @@ -608,7 +654,7 @@ function remove_aux(x, n) { const l = n._1; const c = n._0; if (x === y) { - if (!r) { + if (/* tag */typeof r === "number" || typeof r === "string") { if (c === /* Red */1) { return [ l, @@ -621,7 +667,8 @@ function remove_aux(x, n) { const match = remove_min(r); const n_2 = match[1]; const n_3 = match[0]; - const n$1 = /* Node */{ + const n$1 = { + TAG: /* Node */0, _0: c, _1: l, _2: n_2, @@ -639,7 +686,8 @@ function remove_aux(x, n) { if (x < y) { const match$1 = remove_aux(x, l); const n_1 = match$1[0]; - const n$2 = /* Node */{ + const n$2 = { + TAG: /* Node */0, _0: c, _1: n_1, _2: y, @@ -656,7 +704,8 @@ function remove_aux(x, n) { } const match$2 = remove_aux(x, r); const n_3$1 = match$2[0]; - const n$3 = /* Node */{ + const n$3 = { + TAG: /* Node */0, _0: c, _1: l, _2: y, @@ -677,10 +726,10 @@ function remove(x, s) { } function cardinal(param) { - if (param) { - return (1 + cardinal(param._1) | 0) + cardinal(param._3) | 0; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return (1 + cardinal(param._1) | 0) + cardinal(param._3) | 0; } } diff --git a/jscomp/test/dist/jscomp/test/re_or_res/reasonReact.js b/jscomp/test/dist/jscomp/test/re_or_res/reasonReact.js index 291759b654..2ace173f88 100644 --- a/jscomp/test/dist/jscomp/test/re_or_res/reasonReact.js +++ b/jscomp/test/dist/jscomp/test/re_or_res/reasonReact.js @@ -46,7 +46,8 @@ function convertPropsIfTheyreFromJs(props, jsPropsToReason, debugName) { return match; } if (jsPropsToReason !== undefined) { - return /* Element */{ + return { + TAG: /* Element */0, _0: jsPropsToReason(props) }; } @@ -263,10 +264,10 @@ function createClass(debugName) { return null; } let nextTotalState; - if (typeof reasonStateUpdate === "number") { + if (/* tag */typeof reasonStateUpdate === "number" || typeof reasonStateUpdate === "string") { nextTotalState = curTotalState; } else { - switch (reasonStateUpdate.TAG | 0) { + switch (reasonStateUpdate.TAG) { case /* Update */0 : nextTotalState = { reasonState: reasonStateUpdate._0 @@ -338,7 +339,8 @@ const reducerComponentWithRetainedProps = basicComponent; function element(keyOpt, refOpt, component) { const key = keyOpt !== undefined ? keyOpt : undefined; const ref = refOpt !== undefined ? refOpt : undefined; - const element$1 = /* Element */{ + const element$1 = { + TAG: /* Element */0, _0: component }; const jsElementWrapped = component.jsElementWrapped; diff --git a/jscomp/test/dist/jscomp/test/rec_module_test.js b/jscomp/test/dist/jscomp/test/rec_module_test.js index 24e21f085c..c57297a30c 100644 --- a/jscomp/test/dist/jscomp/test/rec_module_test.js +++ b/jscomp/test/dist/jscomp/test/rec_module_test.js @@ -100,17 +100,20 @@ const AAA = { }; function height(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; - return /* Node */{ + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; + return { + TAG: /* Node */0, l: l, v: v, r: r, @@ -119,52 +122,55 @@ function create(l, v, r) { } function bal(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const lv = l.v; - const ll = l.l; - if (height(ll) >= height(lr)) { - return create(ll, lv, create(lr, v, r)); - } - if (lr) { - return create(create(ll, lv, lr.l), lr.v, create(lr.r, v, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const lr = l.r; + const lv = l.v; + const ll = l.l; + if (height(ll) >= height(lr)) { + return create(ll, lv, create(lr, v, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, lr.l), lr.v, create(lr.r, v, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: v, r: r, h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rv = r.v; - const rl = r.l; - if (height(rr) >= height(rl)) { - return create(create(l, v, rl), rv, rr); - } - if (rl) { - return create(create(l, v, rl.l), rl.v, create(rl.r, rv, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const rr = r.r; + const rv = r.v; + const rl = r.l; + if (height(rr) >= height(rl)) { + return create(create(l, v, rl), rv, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, v, rl.l), rl.v, create(rl.r, rv, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" @@ -172,8 +178,9 @@ function bal(l, v, r) { } function add(x, t) { - if (!t) { - return /* Node */{ + if (/* tag */typeof t === "number" || typeof t === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -204,7 +211,8 @@ function add(x, t) { } function singleton(x) { - return /* Node */{ + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -213,30 +221,30 @@ function singleton(x) { } function add_min_element(x, param) { - if (param) { - return bal(add_min_element(x, param.l), param.v, param.r); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(x); + } else { + return bal(add_min_element(x, param.l), param.v, param.r); } } function add_max_element(x, param) { - if (param) { - return bal(param.l, param.v, add_max_element(x, param.r)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(x); + } else { + return bal(param.l, param.v, add_max_element(x, param.r)); } } function join(l, v, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_element(v, r); } - if (!r) { + const lh = l.h; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_element(v, l); } const rh = r.h; - const lh = l.h; if (lh > (rh + 2 | 0)) { return bal(l.l, l.v, join(l.r, v, r)); } else if (rh > (lh + 2 | 0)) { @@ -249,28 +257,28 @@ function join(l, v, r) { function min_elt(_param) { while(true) { const param = _param; - if (param) { - const l = param.l; - if (!l) { - return param.v; - } - _param = l; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param.v; + } + _param = l; + continue ; }; } function min_elt_opt(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const l = param.l; - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return Caml_option.some(param.v); } _param = l; @@ -281,26 +289,28 @@ function min_elt_opt(_param) { function max_elt(_param) { while(true) { const param = _param; - if (param) { - if (!param.r) { - return param.v; - } - _param = param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return param.v; + } + _param = param.r; + continue ; }; } function max_elt_opt(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } - if (!param.r) { + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { return Caml_option.some(param.v); } _param = param.r; @@ -309,34 +319,32 @@ function max_elt_opt(_param) { } function remove_min_elt(param) { - if (param) { - const l = param.l; - if (l) { - return bal(remove_min_elt(l), param.v, param.r); - } else { - return param.r; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Invalid_argument", { + MEL_EXN_ID: "Invalid_argument", + _1: "Set.remove_min_elt" + }); + } + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param.r; + } else { + return bal(remove_min_elt(l), param.v, param.r); } - throw new Caml_js_exceptions.MelangeError("Invalid_argument", { - MEL_EXN_ID: "Invalid_argument", - _1: "Set.remove_min_elt" - }); } function concat(t1, t2) { - if (t1) { - if (t2) { - return join(t1, min_elt(t2), remove_min_elt(t2)); - } else { - return t1; - } - } else { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; + } else if (/* tag */typeof t2 === "number" || typeof t2 === "string") { + return t1; + } else { + return join(t1, min_elt(t2), remove_min_elt(t2)); } } function split(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, false, @@ -371,17 +379,17 @@ function split(x, param) { } function is_empty(param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } } function mem(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(AAA.compare, x, param.v); @@ -394,7 +402,7 @@ function mem(x, _param) { } function remove(x, t) { - if (!t) { + if (/* tag */typeof t === "number" || typeof t === "string") { return /* Empty */0; } const r = t.r; @@ -402,14 +410,12 @@ function remove(x, t) { const l = t.l; const c = Curry._2(AAA.compare, x, v); if (c === 0) { - if (l) { - if (r) { - return bal(l, min_elt(r), remove_min_elt(r)); - } else { - return l; - } - } else { + if (/* tag */typeof l === "number" || typeof l === "string") { return r; + } else if (/* tag */typeof r === "number" || typeof r === "string") { + return l; + } else { + return bal(l, min_elt(r), remove_min_elt(r)); } } if (c < 0) { @@ -429,16 +435,16 @@ function remove(x, t) { } function union(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return s2; } - if (!s2) { + const h1 = s1.h; + const v1 = s1.v; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const h2 = s2.h; const v2 = s2.v; - const h1 = s1.h; - const v1 = s1.v; if (h1 >= h2) { if (h2 === 1) { return add(v2, s1); @@ -454,10 +460,10 @@ function union(s1, s2) { } function inter(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return /* Empty */0; } - if (!s2) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return /* Empty */0; } const r1 = s1.r; @@ -473,8 +479,9 @@ function inter(s1, s2) { } function split_bis(x, param) { - if (!param) { - return /* NotFound */{ + if (/* tag */typeof param === "number" || typeof param === "string") { + return { + TAG: /* NotFound */0, _0: /* Empty */0, _1: (function (param) { return /* Empty */0; @@ -490,11 +497,12 @@ function split_bis(x, param) { } if (c < 0) { const match = split_bis(x, l); - if (!match) { + if (/* tag */typeof match === "number" || typeof match === "string") { return /* Found */0; } const rl = match._1; - return /* NotFound */{ + return { + TAG: /* NotFound */0, _0: match._0, _1: (function (param) { return join(Curry._1(rl, undefined), v, r); @@ -502,13 +510,14 @@ function split_bis(x, param) { }; } const match$1 = split_bis(x, r); - if (match$1) { - return /* NotFound */{ + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { + return /* Found */0; + } else { + return { + TAG: /* NotFound */0, _0: join(l, v, match$1._0), _1: match$1._1 }; - } else { - return /* Found */0; } } @@ -516,17 +525,17 @@ function disjoint(_s1, _s2) { while(true) { const s2 = _s2; const s1 = _s1; - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return true; } - if (!s2) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return true; } if (s1 === s2) { return false; } const match = split_bis(s1.v, s2); - if (!match) { + if (/* tag */typeof match === "number" || typeof match === "string") { return false; } if (!disjoint(s1.l, match._0)) { @@ -539,10 +548,10 @@ function disjoint(_s1, _s2) { } function diff(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return /* Empty */0; } - if (!s2) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const r1 = s1.r; @@ -561,10 +570,11 @@ function cons_enum(_s, _e) { while(true) { const e = _e; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: s.v, _1: s.r, _2: e @@ -580,14 +590,14 @@ function compare$1(s1, s2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return -1; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 0; + } else { + return -1; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 1; } const c = Curry._2(AAA.compare, e1._0, e2._0); @@ -608,17 +618,17 @@ function subset(_s1, _s2) { while(true) { const s2 = _s2; const s1 = _s1; - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return true; } - if (!s2) { + const r1 = s1.r; + const v1 = s1.v; + const l1 = s1.l; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return false; } const r2 = s2.r; const l2 = s2.l; - const r1 = s1.r; - const v1 = s1.v; - const l1 = s1.l; const c = Curry._2(AAA.compare, v1, s2.v); if (c === 0) { if (!subset(l1, l2)) { @@ -629,7 +639,8 @@ function subset(_s1, _s2) { continue ; } if (c < 0) { - if (!subset(/* Node */{ + if (!subset({ + TAG: /* Node */0, l: l1, v: v1, r: /* Empty */0, @@ -640,7 +651,8 @@ function subset(_s1, _s2) { _s1 = r1; continue ; } - if (!subset(/* Node */{ + if (!subset({ + TAG: /* Node */0, l: /* Empty */0, v: v1, r: r1, @@ -656,7 +668,7 @@ function subset(_s1, _s2) { function iter(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } iter(f, param.l); @@ -670,7 +682,7 @@ function fold(f, _s, _accu) { while(true) { const accu = _accu; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return accu; } _accu = Curry._2(f, s.v, fold(f, s.l, accu)); @@ -682,7 +694,7 @@ function fold(f, _s, _accu) { function for_all(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; } if (!Curry._1(p, param.v)) { @@ -699,7 +711,7 @@ function for_all(p, _param) { function exists(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } if (Curry._1(p, param.v)) { @@ -714,7 +726,7 @@ function exists(p, _param) { } function filter(p, t) { - if (!t) { + if (/* tag */typeof t === "number" || typeof t === "string") { return /* Empty */0; } const r = t.r; @@ -735,7 +747,7 @@ function filter(p, t) { } function partition(p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, /* Empty */0 @@ -763,10 +775,10 @@ function partition(p, param) { } function cardinal(param) { - if (param) { - return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; } } @@ -774,7 +786,7 @@ function elements_aux(_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param.l; @@ -793,58 +805,58 @@ function elements(s) { function find(x, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - const c = Curry._2(AAA.compare, x, v); - if (c === 0) { - return v; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const v = param.v; + const c = Curry._2(AAA.compare, x, v); + if (c === 0) { + return v; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } function find_first(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _param$1 = param.l; - while(true) { - const param$1 = _param$1; - const v0 = _v0; - if (!param$1) { - return v0; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.l; - _v0 = v$1; - continue ; - } - _param$1 = param$1.r; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _param$1 = param.l; + while(true) { + const param$1 = _param$1; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return v0; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.l; + _v0 = v$1; continue ; - }; - } - _param = param.r; - continue ; + } + _param$1 = param$1.r; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.r; + continue ; }; } function find_first_opt(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -854,7 +866,7 @@ function find_first_opt(f, _param) { while(true) { const param$1 = _param$1; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return Caml_option.some(v0); } const v$1 = param$1.v; @@ -875,40 +887,40 @@ function find_first_opt(f, _param) { function find_last(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _param$1 = param.r; - while(true) { - const param$1 = _param$1; - const v0 = _v0; - if (!param$1) { - return v0; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.r; - _v0 = v$1; - continue ; - } - _param$1 = param$1.l; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _param$1 = param.r; + while(true) { + const param$1 = _param$1; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return v0; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.r; + _v0 = v$1; continue ; - }; - } - _param = param.l; - continue ; + } + _param$1 = param$1.l; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.l; + continue ; }; } function find_last_opt(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -918,7 +930,7 @@ function find_last_opt(f, _param) { while(true) { const param$1 = _param$1; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return Caml_option.some(v0); } const v$1 = param$1.v; @@ -939,7 +951,7 @@ function find_last_opt(f, _param) { function find_opt(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -961,7 +973,7 @@ function try_join(l, v, r) { } function map(f, t) { - if (!t) { + if (/* tag */typeof t === "number" || typeof t === "string") { return /* Empty */0; } const r = t.r; @@ -978,7 +990,7 @@ function map(f, t) { } function filter_map(f, t) { - if (!t) { + if (/* tag */typeof t === "number" || typeof t === "string") { return /* Empty */0; } const r = t.r; @@ -988,14 +1000,12 @@ function filter_map(f, t) { const v$p = Curry._1(f, v); const r$p = filter_map(f, r); if (v$p === undefined) { - if (l$p) { - if (r$p) { - return try_join(l$p, min_elt(r$p), remove_min_elt(r$p)); - } else { - return l$p; - } - } else { + if (/* tag */typeof l$p === "number" || typeof l$p === "string") { return r$p; + } else if (/* tag */typeof r$p === "number" || typeof r$p === "string") { + return l$p; + } else { + return try_join(l$p, min_elt(r$p), remove_min_elt(r$p)); } } const v$p$1 = Caml_option.valFromOption(v$p); @@ -1040,7 +1050,8 @@ function of_list(l) { case 1 : if (l) { return [ - /* Node */{ + { + TAG: /* Node */0, l: /* Empty */0, v: l.hd, r: /* Empty */0, @@ -1055,8 +1066,10 @@ function of_list(l) { const match = l.tl; if (match) { return [ - /* Node */{ - l: /* Node */{ + { + TAG: /* Node */0, + l: { + TAG: /* Node */0, l: /* Empty */0, v: l.hd, r: /* Empty */0, @@ -1079,15 +1092,18 @@ function of_list(l) { const match$2 = match$1.tl; if (match$2) { return [ - /* Node */{ - l: /* Node */{ + { + TAG: /* Node */0, + l: { + TAG: /* Node */0, l: /* Empty */0, v: l.hd, r: /* Empty */0, h: 1 }, v: match$1.hd, - r: /* Node */{ + r: { + TAG: /* Node */0, l: /* Empty */0, v: match$2.hd, r: /* Empty */0, @@ -1145,11 +1161,12 @@ function of_seq(i) { } function seq_of_enum_(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = cons_enum(c._1, c._2); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: c._0, _1: (function (param) { return seq_of_enum_(partial_arg, param); @@ -1168,10 +1185,11 @@ function snoc_enum(_s, _e) { while(true) { const e = _e; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: s.v, _1: s.l, _2: e @@ -1182,11 +1200,12 @@ function snoc_enum(_s, _e) { } function rev_seq_of_enum_(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = snoc_enum(c._1, c._2); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: c._0, _1: (function (param) { return rev_seq_of_enum_(partial_arg, param); @@ -1206,14 +1225,15 @@ function to_seq_from(low, s) { while(true) { const c = _c; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return c; } const r = s.r; const v = s.v; const n = Curry._2(AAA.compare, v, low); if (n === 0) { - return /* More */{ + return { + TAG: /* More */0, _0: v, _1: r, _2: c @@ -1223,7 +1243,8 @@ function to_seq_from(low, s) { _s = r; continue ; } - _c = /* More */{ + _c = { + TAG: /* More */0, _0: v, _1: r, _2: c diff --git a/jscomp/test/dist/jscomp/test/record_extension_test.js b/jscomp/test/dist/jscomp/test/record_extension_test.js index ba0ca26660..067d89dded 100644 --- a/jscomp/test/dist/jscomp/test/record_extension_test.js +++ b/jscomp/test/dist/jscomp/test/record_extension_test.js @@ -37,7 +37,7 @@ const v0 = { eq("File \"jscomp/test/record_extension_test.ml\", line 18, characters 6-13", f(v0), 7); function f2(x) { - if (typeof x === "number" || x.TAG !== /* C */0) { + if (/* tag */typeof x === "number" || typeof x === "string" || x.TAG !== /* C */0) { return 0; } else { return x.x; @@ -45,7 +45,7 @@ function f2(x) { } function f2_with(x) { - if (typeof x === "number" || x.TAG !== /* C */0) { + if (/* tag */typeof x === "number" || typeof x === "string" || x.TAG !== /* C */0) { return x; } else { return { diff --git a/jscomp/test/dist/jscomp/test/recursive_records_test.js b/jscomp/test/dist/jscomp/test/recursive_records_test.js index d38920d415..58e331d8e7 100644 --- a/jscomp/test/dist/jscomp/test/recursive_records_test.js +++ b/jscomp/test/dist/jscomp/test/recursive_records_test.js @@ -49,7 +49,8 @@ rec_cell2.next = rec_cell2; function f2(x) { let rec_cell2 = {}; - Caml_obj.update_dummy(rec_cell2, /* Cons */{ + Caml_obj.update_dummy(rec_cell2, { + TAG: /* Cons */0, content: Math.imul(x, x) - 6 | 0, next: rec_cell2 }); @@ -57,15 +58,15 @@ function f2(x) { } function hd(x) { - if (x) { - return x.content; - } else { + if (/* tag */typeof x === "number" || typeof x === "string") { return 0; + } else { + return x.content; } } function tl_exn(x) { - if (x) { + if (!/* tag */(typeof x === "number" || typeof x === "string")) { return x.next; } throw new Caml_js_exceptions.MelangeError("Assert_failure", { diff --git a/jscomp/test/dist/jscomp/test/scanf_io.js b/jscomp/test/dist/jscomp/test/scanf_io.js index 42743de846..6f124849b6 100644 --- a/jscomp/test/dist/jscomp/test/scanf_io.js +++ b/jscomp/test/dist/jscomp/test/scanf_io.js @@ -27,7 +27,8 @@ const tscanf_data_file_lines = { function create_tscanf_data(ob, lines) { const add_line = function (param) { - Stdlib__Buffer.add_string(ob, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Stdlib__Buffer.add_string(ob, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Caml_string */3, _0: /* No_padding */0, @@ -36,7 +37,8 @@ function create_tscanf_data(ob, lines) { _1: "%S" }), param[0])); Stdlib__Buffer.add_string(ob, " -> "); - Stdlib__Buffer.add_string(ob, Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Stdlib__Buffer.add_string(ob, Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Caml_string */3, _0: /* No_padding */0, @@ -65,7 +67,8 @@ function get_lines(fname) { }; try { while(!Stdlib__Scanf.Scanning.end_of_input(ib)) { - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -103,7 +106,8 @@ function get_lines(fname) { catch (raw_s){ const s = Caml_js_exceptions.internalToOCamlException(raw_s); if (s.MEL_EXN_ID === Stdlib__Scanf.Scan_failure) { - const s$1 = Curry._2(Stdlib__Printf.sprintf(/* Format */{ + const s$1 = Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "in file ", @@ -129,7 +133,8 @@ function get_lines(fname) { }); } if (s.MEL_EXN_ID === Stdlib.End_of_file) { - const s$2 = Curry._1(Stdlib__Printf.sprintf(/* Format */{ + const s$2 = Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "in file ", @@ -156,7 +161,8 @@ function get_lines(fname) { function add_digest_ib(ob, ib) { const scan_line = function (ib, f) { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, diff --git a/jscomp/test/dist/jscomp/test/scanf_reference_error_regression_test.js b/jscomp/test/dist/jscomp/test/scanf_reference_error_regression_test.js index 6ae00b5f10..06a4615a81 100644 --- a/jscomp/test/dist/jscomp/test/scanf_reference_error_regression_test.js +++ b/jscomp/test/dist/jscomp/test/scanf_reference_error_regression_test.js @@ -22,7 +22,8 @@ function eq(f, param) { } function scan_rest(ib, accu) { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -34,7 +35,8 @@ function scan_rest(ib, accu) { if (param === "]") { return accu; } else { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -56,7 +58,8 @@ function scan_rest(ib, accu) { hd: i, tl: accu }; - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: 1, @@ -71,7 +74,8 @@ function scan_rest(ib, accu) { case "]" : return accu$1; default: - const s = Stdlib__Printf.sprintf(/* Format */{ + const s = Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "scan_int_list", @@ -91,7 +95,8 @@ function scan_rest(ib, accu) { } function scan_int_list(ib) { - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " [ ", diff --git a/jscomp/test/dist/jscomp/test/scanf_test.js b/jscomp/test/dist/jscomp/test/scanf_test.js index 818f1e722e..68282169c8 100644 --- a/jscomp/test/dist/jscomp/test/scanf_test.js +++ b/jscomp/test/dist/jscomp/test/scanf_test.js @@ -19,7 +19,8 @@ function eq(f, param) { } eq("File \"jscomp/test/scanf_test.ml\", line 6, characters 5-12", [ - Curry._1(Stdlib__Scanf.sscanf("32 31", /* Format */{ + Curry._1(Stdlib__Scanf.sscanf("32 31", { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -45,7 +46,8 @@ eq("File \"jscomp/test/scanf_test.ml\", line 6, characters 5-12", [ ]); eq("File \"jscomp/test/scanf_test.ml\", line 7, characters 5-12", [ - Curry._1(Stdlib__Scanf.sscanf("12306459064359371967", /* Format */{ + Curry._1(Stdlib__Scanf.sscanf("12306459064359371967", { + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_u */12, diff --git a/jscomp/test/dist/jscomp/test/set_gen.js b/jscomp/test/dist/jscomp/test/set_gen.js index 1f838ed86b..d17dbaeb9c 100644 --- a/jscomp/test/dist/jscomp/test/set_gen.js +++ b/jscomp/test/dist/jscomp/test/set_gen.js @@ -12,10 +12,11 @@ function cons_enum(_s, _e) { while(true) { const e = _e; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: s._1, _1: s._2, _2: e @@ -26,51 +27,52 @@ function cons_enum(_s, _e) { } function height(param) { - if (param) { - return param._3; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param._3; } } function min_elt(_param) { while(true) { const param = _param; - if (param) { - const l = param._0; - if (!l) { - return param._1; - } - _param = l; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const l = param._0; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param._1; + } + _param = l; + continue ; }; } function max_elt(_param) { while(true) { const param = _param; - if (param) { - if (!param._2) { - return param._1; - } - _param = param._2; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + let tmp = param._2; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return param._1; + } + _param = param._2; + continue ; }; } function is_empty(param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } } @@ -78,7 +80,7 @@ function cardinal_aux(_acc, _param) { while(true) { const param = _param; const acc = _acc; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return acc; } _param = param._0; @@ -95,7 +97,7 @@ function elements_aux(_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param._0; @@ -114,7 +116,7 @@ function elements(s) { function iter(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } iter(f, param._0); @@ -128,7 +130,7 @@ function fold(f, _s, _accu) { while(true) { const accu = _accu; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return accu; } _accu = Curry._2(f, s._1, fold(f, s._0, accu)); @@ -140,7 +142,7 @@ function fold(f, _s, _accu) { function for_all(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; } if (!Curry._1(p, param._1)) { @@ -157,7 +159,7 @@ function for_all(p, _param) { function exists(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } if (Curry._1(p, param._1)) { @@ -198,7 +200,7 @@ const Height_invariant_broken = /* @__PURE__ */Caml_exceptions.create("Set_gen.H const Height_diff_borken = /* @__PURE__ */Caml_exceptions.create("Set_gen.Height_diff_borken"); function check_height_and_diff(param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; } const h = param._3; @@ -223,9 +225,12 @@ function check(tree) { } function create(l, v, r) { - const hl = l ? l._3 : 0; - const hr = r ? r._3 : 0; - return /* Node */{ + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l._3; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r._3; + return { + TAG: /* Node */0, _0: l, _1: v, _2: r, @@ -234,91 +239,95 @@ function create(l, v, r) { } function internal_bal(l, v, r) { - const hl = l ? l._3 : 0; - const hr = r ? r._3 : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l._3; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r._3; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l._2; - const lv = l._1; - const ll = l._0; - if (height(ll) >= height(lr)) { - return create(ll, lv, create(lr, v, r)); - } - if (lr) { - return create(create(ll, lv, lr._0), lr._1, create(lr._2, v, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ "jscomp/test/set_gen.ml", - 235, - 19 + 225, + 15 ] }); } + const lr = l._2; + const lv = l._1; + const ll = l._0; + if (height(ll) >= height(lr)) { + return create(ll, lv, create(lr, v, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, lr._0), lr._1, create(lr._2, v, r)); + } throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ "jscomp/test/set_gen.ml", - 225, - 15 + 235, + 19 ] }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: v, _2: r, _3: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r._2; - const rv = r._1; - const rl = r._0; - if (height(rr) >= height(rl)) { - return create(create(l, v, rl), rv, rr); - } - if (rl) { - return create(create(l, v, rl._0), rl._1, create(rl._2, rv, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ "jscomp/test/set_gen.ml", - 251, - 19 + 245, + 15 ] }); } + const rr = r._2; + const rv = r._1; + const rl = r._0; + if (height(rr) >= height(rl)) { + return create(create(l, v, rl), rv, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, v, rl._0), rl._1, create(rl._2, rv, rr)); + } throw new Caml_js_exceptions.MelangeError("Assert_failure", { MEL_EXN_ID: "Assert_failure", _1: [ "jscomp/test/set_gen.ml", - 245, - 15 + 251, + 19 ] }); } function remove_min_elt(param) { - if (param) { - const l = param._0; - if (l) { - return internal_bal(remove_min_elt(l), param._1, param._2); - } else { - return param._2; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Invalid_argument", { + MEL_EXN_ID: "Invalid_argument", + _1: "Set.remove_min_elt" + }); + } + const l = param._0; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param._2; + } else { + return internal_bal(remove_min_elt(l), param._1, param._2); } - throw new Caml_js_exceptions.MelangeError("Invalid_argument", { - MEL_EXN_ID: "Invalid_argument", - _1: "Set.remove_min_elt" - }); } function singleton(x) { - return /* Node */{ + return { + TAG: /* Node */0, _0: /* Empty */0, _1: x, _2: /* Empty */0, @@ -327,42 +336,40 @@ function singleton(x) { } function internal_merge(l, r) { - if (l) { - if (r) { - return internal_bal(l, min_elt(r), remove_min_elt(r)); - } else { - return l; - } - } else { + if (/* tag */typeof l === "number" || typeof l === "string") { return r; + } else if (/* tag */typeof r === "number" || typeof r === "string") { + return l; + } else { + return internal_bal(l, min_elt(r), remove_min_elt(r)); } } function add_min_element(v, param) { - if (param) { - return internal_bal(add_min_element(v, param._0), param._1, param._2); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(v); + } else { + return internal_bal(add_min_element(v, param._0), param._1, param._2); } } function add_max_element(v, param) { - if (param) { - return internal_bal(param._0, param._1, add_max_element(v, param._2)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(v); + } else { + return internal_bal(param._0, param._1, add_max_element(v, param._2)); } } function internal_join(l, v, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_element(v, r); } - if (!r) { + const lh = l._3; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_element(v, l); } const rh = r._3; - const lh = l._3; if (lh > (rh + 2 | 0)) { return internal_bal(l._0, l._1, internal_join(l._2, v, r)); } else if (rh > (lh + 2 | 0)) { @@ -373,19 +380,17 @@ function internal_join(l, v, r) { } function internal_concat(t1, t2) { - if (t1) { - if (t2) { - return internal_join(t1, min_elt(t2), remove_min_elt(t2)); - } else { - return t1; - } - } else { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; + } else if (/* tag */typeof t2 === "number" || typeof t2 === "string") { + return t1; + } else { + return internal_join(t1, min_elt(t2), remove_min_elt(t2)); } } function filter(p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param._1; @@ -400,7 +405,7 @@ function filter(p, param) { } function partition(p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, /* Empty */0 @@ -438,7 +443,8 @@ function of_sorted_list(l) { case 1 : if (l) { return [ - /* Node */{ + { + TAG: /* Node */0, _0: /* Empty */0, _1: l.hd, _2: /* Empty */0, @@ -453,8 +459,10 @@ function of_sorted_list(l) { const match = l.tl; if (match) { return [ - /* Node */{ - _0: /* Node */{ + { + TAG: /* Node */0, + _0: { + TAG: /* Node */0, _0: /* Empty */0, _1: l.hd, _2: /* Empty */0, @@ -477,15 +485,18 @@ function of_sorted_list(l) { const match$2 = match$1.tl; if (match$2) { return [ - /* Node */{ - _0: /* Node */{ + { + TAG: /* Node */0, + _0: { + TAG: /* Node */0, _0: /* Empty */0, _1: l.hd, _2: /* Empty */0, _3: 1 }, _1: match$1.hd, - _2: /* Node */{ + _2: { + TAG: /* Node */0, _0: /* Empty */0, _1: match$2.hd, _2: /* Empty */0, @@ -533,7 +544,8 @@ function of_sorted_array(l) { } if (n === 1) { const x0 = l[start]; - return /* Node */{ + return { + TAG: /* Node */0, _0: /* Empty */0, _1: x0, _2: /* Empty */0, @@ -543,8 +555,10 @@ function of_sorted_array(l) { if (n === 2) { const x0$1 = l[start]; const x1 = l[start + 1 | 0]; - return /* Node */{ - _0: /* Node */{ + return { + TAG: /* Node */0, + _0: { + TAG: /* Node */0, _0: /* Empty */0, _1: x0$1, _2: /* Empty */0, @@ -559,15 +573,18 @@ function of_sorted_array(l) { const x0$2 = l[start]; const x1$1 = l[start + 1 | 0]; const x2 = l[start + 2 | 0]; - return /* Node */{ - _0: /* Node */{ + return { + TAG: /* Node */0, + _0: { + TAG: /* Node */0, _0: /* Empty */0, _1: x0$2, _2: /* Empty */0, _3: 1 }, _1: x1$1, - _2: /* Node */{ + _2: { + TAG: /* Node */0, _0: /* Empty */0, _1: x2, _2: /* Empty */0, @@ -588,7 +605,7 @@ function of_sorted_array(l) { function is_ordered(cmp, tree) { const is_ordered_min_max = function (tree) { - if (!tree) { + if (/* tag */typeof tree === "number" || typeof tree === "string") { return "Empty"; } const r = tree._2; @@ -667,14 +684,14 @@ function compare_aux(cmp, _e1, _e2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return -1; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 0; + } else { + return -1; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 1; } const c = Curry._2(cmp, e1._0, e2._0); diff --git a/jscomp/test/dist/jscomp/test/sexpm.js b/jscomp/test/dist/jscomp/test/sexpm.js index 88429107c2..d410044254 100644 --- a/jscomp/test/dist/jscomp/test/sexpm.js +++ b/jscomp/test/dist/jscomp/test/sexpm.js @@ -117,7 +117,8 @@ function to_buf(b, t) { }), l); return Stdlib__Buffer.add_char(b, /* ')' */41); } else { - return Curry._2(Stdlib__Printf.bprintf(b, /* Format */{ + return Curry._2(Stdlib__Printf.bprintf(b, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '(' */40, @@ -139,7 +140,8 @@ function to_buf(b, t) { } const s = t.VAL; if (_must_escape(s)) { - return Curry._1(Stdlib__Printf.bprintf(b, /* Format */{ + return Curry._1(Stdlib__Printf.bprintf(b, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '"' */34, @@ -171,12 +173,14 @@ function print(fmt, t) { const l = t.VAL; if (l) { if (l.tl) { - Stdlib__Format.fprintf(fmt)(/* Format */{ + Stdlib__Format.fprintf(fmt)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -195,7 +199,8 @@ function print(fmt, t) { }); Stdlib__List.iteri((function (i, t$p) { if (i > 0) { - Stdlib__Format.fprintf(fmt)(/* Format */{ + Stdlib__Format.fprintf(fmt)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_lit */17, _0: { @@ -211,7 +216,8 @@ function print(fmt, t) { } print(fmt, t$p); }), l); - return Stdlib__Format.fprintf(fmt)(/* Format */{ + return Stdlib__Format.fprintf(fmt)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ')' */41, @@ -224,12 +230,14 @@ function print(fmt, t) { _1: ")@]" }); } else { - return Curry._2(Stdlib__Format.fprintf(fmt)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(fmt)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "", @@ -264,7 +272,8 @@ function print(fmt, t) { } const s = t.VAL; if (_must_escape(s)) { - return Curry._1(Stdlib__Format.fprintf(fmt)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(fmt)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '"' */34, @@ -299,7 +308,8 @@ function print_noindent(fmt, t) { }), l); return Stdlib__Format.pp_print_char(fmt, /* ')' */41); } else { - return Curry._2(Stdlib__Format.fprintf(fmt)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(fmt)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '(' */40, @@ -321,7 +331,8 @@ function print_noindent(fmt, t) { } const s = t.VAL; if (_must_escape(s)) { - return Curry._1(Stdlib__Format.fprintf(fmt)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(fmt)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '"' */34, @@ -445,7 +456,8 @@ function _get(t) { function _error(t, msg) { const b = Stdlib__Buffer.create(32); - Curry._2(Stdlib__Printf.bprintf(b, /* Format */{ + Curry._2(Stdlib__Printf.bprintf(b, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "at ", @@ -483,7 +495,8 @@ function _error(t, msg) { } function _error_eof(t) { - return _error(t, /* Format */{ + return _error(t, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unexpected end of input", @@ -522,7 +535,8 @@ function expr_starting_with(c, k, t) { }), t); } if (c === 92) { - return _error(t, /* Format */{ + return _error(t, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unexpected '\\'", @@ -556,7 +570,8 @@ function expr_starting_with(c, k, t) { case 40 : return expr_list(/* [] */0, k, t); case 41 : - return _error(t, /* Format */{ + return _error(t, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unexpected ')'", @@ -659,7 +674,8 @@ function atom(k, t) { if (c >= 35) { if (c >= 42) { if (c === 92) { - return _error(t, /* Format */{ + return _error(t, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unexpected '\\' in non-quoted string", @@ -682,7 +698,8 @@ function atom(k, t) { exit = 1; break; case 34 : - return _error(t, /* Format */{ + return _error(t, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unexpected '\"' in the middle of an atom", @@ -784,7 +801,8 @@ function escaped(k, t) { return Curry._1(k, Stdlib__Char.chr(n)); }), t); } else { - return Curry._1(_error(t, /* Format */{ + return Curry._1(_error(t, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unexpected escaped char '", @@ -812,7 +830,8 @@ function read2int(i, k, t) { if (_is_digit(c)) { return read1int(Math.imul(10, i) + (c - /* '0' */48 | 0) | 0, k, t); } else { - return Curry._1(_error(t, /* Format */{ + return Curry._1(_error(t, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unexpected char '", @@ -840,7 +859,8 @@ function read1int(i, k, t) { if (_is_digit(c)) { return Curry._1(k, Math.imul(10, i) + (c - /* '0' */48 | 0) | 0); } else { - return Curry._1(_error(t, /* Format */{ + return Curry._1(_error(t, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unexpected char '", @@ -1053,7 +1073,8 @@ function MakeDecode(funarg) { }; const _error = function (t, msg) { const b = Stdlib__Buffer.create(32); - Curry._2(Stdlib__Printf.bprintf(b, /* Format */{ + Curry._2(Stdlib__Printf.bprintf(b, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "at ", @@ -1090,7 +1111,8 @@ function MakeDecode(funarg) { }), b, msg); }; const _error_eof = function (t) { - return _error(t, /* Format */{ + return _error(t, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unexpected end of input", @@ -1127,7 +1149,8 @@ function MakeDecode(funarg) { }), t); } if (c === 92) { - return _error(t, /* Format */{ + return _error(t, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unexpected '\\'", @@ -1161,7 +1184,8 @@ function MakeDecode(funarg) { case 40 : return expr_list(/* [] */0, k, t); case 41 : - return _error(t, /* Format */{ + return _error(t, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unexpected ')'", @@ -1261,7 +1285,8 @@ function MakeDecode(funarg) { if (c >= 35) { if (c >= 42) { if (c === 92) { - return _error(t, /* Format */{ + return _error(t, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unexpected '\\' in non-quoted string", @@ -1284,7 +1309,8 @@ function MakeDecode(funarg) { exit = 1; break; case 34 : - return _error(t, /* Format */{ + return _error(t, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unexpected '\"' in the middle of an atom", @@ -1384,7 +1410,8 @@ function MakeDecode(funarg) { return Curry._1(k, Stdlib__Char.chr(n)); }), t); } else { - return Curry._1(_error(t, /* Format */{ + return Curry._1(_error(t, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unexpected escaped char '", @@ -1411,7 +1438,8 @@ function MakeDecode(funarg) { if (_is_digit(c)) { return read1int(Math.imul(10, i) + (c - /* '0' */48 | 0) | 0, k, t); } else { - return Curry._1(_error(t, /* Format */{ + return Curry._1(_error(t, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unexpected char '", @@ -1438,7 +1466,8 @@ function MakeDecode(funarg) { if (_is_digit(c)) { return Curry._1(k, Math.imul(10, i) + (c - /* '0' */48 | 0) | 0); } else { - return Curry._1(_error(t, /* Format */{ + return Curry._1(_error(t, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "unexpected char '", diff --git a/jscomp/test/dist/jscomp/test/sexpm_test.js b/jscomp/test/dist/jscomp/test/sexpm_test.js index 62916707cd..bcc849d0e0 100644 --- a/jscomp/test/dist/jscomp/test/sexpm_test.js +++ b/jscomp/test/dist/jscomp/test/sexpm_test.js @@ -35,12 +35,14 @@ function eq(loc, param) { function print_or_error(fmt, x) { if (x.NAME === "Error") { - return Curry._1(Stdlib__Format.fprintf(fmt)(/* Format */{ + return Curry._1(Stdlib__Format.fprintf(fmt)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -66,12 +68,14 @@ function print_or_error(fmt, x) { _1: "@[Error:%s@]@." }), x.VAL); } else { - return Curry._2(Stdlib__Format.fprintf(fmt)(/* Format */{ + return Curry._2(Stdlib__Format.fprintf(fmt)({ + TAG: /* Format */0, _0: { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -142,7 +146,8 @@ eq("File \"jscomp/test/sexpm_test.ml\", line 17, characters 7-14", [ ]); eq("File \"jscomp/test/sexpm_test.ml\", line 21, characters 7-14", [ - Curry._2(Stdlib__Format.asprintf(/* Format */{ + Curry._2(Stdlib__Format.asprintf({ + TAG: /* Format */0, _0: { TAG: /* Alpha */15, _0: /* End_of_format */0 diff --git a/jscomp/test/dist/jscomp/test/simplify_lambda_632o.js b/jscomp/test/dist/jscomp/test/simplify_lambda_632o.js index baeb8b4635..e5ca0c87df 100644 --- a/jscomp/test/dist/jscomp/test/simplify_lambda_632o.js +++ b/jscomp/test/dist/jscomp/test/simplify_lambda_632o.js @@ -3,11 +3,31 @@ function f(x) { - return x; + switch (x) { + case /* X1 */0 : + return /* X1 */0; + case /* X2 */1 : + return /* X2 */1; + case /* X3 */2 : + return /* X3 */2; + case /* X4 */3 : + return /* X4 */3; + + } } function f2(x) { - return x; + switch (x) { + case /* X1 */0 : + return /* X1 */0; + case /* X2 */1 : + return /* X2 */1; + case /* X3 */2 : + return /* X3 */2; + case /* X4 */3 : + return /* X4 */3; + + } } exports.f = f; diff --git a/jscomp/test/dist/jscomp/test/sprintf_reg_test.js b/jscomp/test/dist/jscomp/test/sprintf_reg_test.js index 23f36dda0f..ef3539c1e3 100644 --- a/jscomp/test/dist/jscomp/test/sprintf_reg_test.js +++ b/jscomp/test/dist/jscomp/test/sprintf_reg_test.js @@ -18,7 +18,8 @@ function eq(f, param) { Mt_global.collect_eq(test_id, suites, f, param[0], param[1]); } -const s = Curry._1(Stdlib__Printf.sprintf(/* Format */{ +const s = Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Format_arg */13, _0: undefined, @@ -33,7 +34,8 @@ const s = Curry._1(Stdlib__Printf.sprintf(/* Format */{ } }, _1: "%{%s%}." - }), /* Format */{ + }), { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "32", @@ -51,7 +53,8 @@ eq("File \"jscomp/test/sprintf_reg_test.ml\", line 8, characters 5-12", [ "%s." ]); -const s$1 = Curry._2(Stdlib__Printf.sprintf(/* Format */{ +const s$1 = Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -72,7 +75,8 @@ const s$1 = Curry._2(Stdlib__Printf.sprintf(/* Format */{ } }, _1: "%i %{%s%}" - }), 1, /* Format */{ + }), 1, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "spells one ", diff --git a/jscomp/test/dist/jscomp/test/stdlib_bytes_utf8_test.js b/jscomp/test/dist/jscomp/test/stdlib_bytes_utf8_test.js index e8e745eaa7..bf2f842a7b 100644 --- a/jscomp/test/dist/jscomp/test/stdlib_bytes_utf8_test.js +++ b/jscomp/test/dist/jscomp/test/stdlib_bytes_utf8_test.js @@ -958,7 +958,8 @@ if ((d8 & 16777215) !== Stdlib__Uchar.of_int(65)) { }); } -Stdlib__Printf.printf(/* Format */{ +Stdlib__Printf.printf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "All UTF tests passed!\n", diff --git a/jscomp/test/dist/jscomp/test/string_set.js b/jscomp/test/dist/jscomp/test/string_set.js index 050cac6642..68be75a702 100644 --- a/jscomp/test/dist/jscomp/test/string_set.js +++ b/jscomp/test/dist/jscomp/test/string_set.js @@ -10,7 +10,7 @@ const Stdlib__List = require("melange/list.js"); const Stdlib__String = require("melange/string.js"); function split(x, tree) { - if (!tree) { + if (/* tag */typeof tree === "number" || typeof tree === "string") { return [ /* Empty */0, false, @@ -45,8 +45,9 @@ function split(x, tree) { } function add(x, tree) { - if (!tree) { - return /* Node */{ + if (/* tag */typeof tree === "number" || typeof tree === "string") { + return { + TAG: /* Node */0, _0: /* Empty */0, _1: x, _2: /* Empty */0, @@ -67,16 +68,16 @@ function add(x, tree) { } function union(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return s2; } - if (!s2) { + const h1 = s1._3; + const v1 = s1._1; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const h2 = s2._3; const v2 = s2._1; - const h1 = s1._3; - const v1 = s1._1; if (h1 >= h2) { if (h2 === 1) { return add(v2, s1); @@ -92,10 +93,10 @@ function union(s1, s2) { } function inter(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return /* Empty */0; } - if (!s2) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return /* Empty */0; } const r1 = s1._2; @@ -111,10 +112,10 @@ function inter(s1, s2) { } function diff(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return /* Empty */0; } - if (!s2) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const r1 = s1._2; @@ -132,7 +133,7 @@ function diff(s1, s2) { function mem(x, _tree) { while(true) { const tree = _tree; - if (!tree) { + if (/* tag */typeof tree === "number" || typeof tree === "string") { return false; } const c = Caml.caml_string_compare(x, tree._1); @@ -145,7 +146,7 @@ function mem(x, _tree) { } function remove(x, tree) { - if (!tree) { + if (/* tag */typeof tree === "number" || typeof tree === "string") { return /* Empty */0; } const r = tree._2; @@ -173,17 +174,17 @@ function subset(_s1, _s2) { while(true) { const s2 = _s2; const s1 = _s1; - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return true; } - if (!s2) { + const r1 = s1._2; + const v1 = s1._1; + const l1 = s1._0; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return false; } const r2 = s2._2; const l2 = s2._0; - const r1 = s1._2; - const v1 = s1._1; - const l1 = s1._0; const c = Caml.caml_string_compare(v1, s2._1); if (c === 0) { if (!subset(l1, l2)) { @@ -194,7 +195,8 @@ function subset(_s1, _s2) { continue ; } if (c < 0) { - if (!subset(/* Node */{ + if (!subset({ + TAG: /* Node */0, _0: l1, _1: v1, _2: /* Empty */0, @@ -205,7 +207,8 @@ function subset(_s1, _s2) { _s1 = r1; continue ; } - if (!subset(/* Node */{ + if (!subset({ + TAG: /* Node */0, _0: /* Empty */0, _1: v1, _2: r1, @@ -221,18 +224,18 @@ function subset(_s1, _s2) { function find(x, _tree) { while(true) { const tree = _tree; - if (tree) { - const v = tree._1; - const c = Caml.caml_string_compare(x, v); - if (c === 0) { - return v; - } - _tree = c < 0 ? tree._0 : tree._2; - continue ; + if (/* tag */typeof tree === "number" || typeof tree === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const v = tree._1; + const c = Caml.caml_string_compare(x, v); + if (c === 0) { + return v; + } + _tree = c < 0 ? tree._0 : tree._2; + continue ; }; } diff --git a/jscomp/test/dist/jscomp/test/test_demo.js b/jscomp/test/dist/jscomp/test/test_demo.js index a3011a3775..16a3351fbf 100644 --- a/jscomp/test/dist/jscomp/test/test_demo.js +++ b/jscomp/test/dist/jscomp/test/test_demo.js @@ -13,20 +13,22 @@ function fib(n) { } function cons(x, y) { - return /* Cons */{ + return { + TAG: /* Cons */0, _0: x, _1: y }; } function map(f, param) { - if (param) { - return /* Cons */{ + if (/* tag */typeof param === "number" || typeof param === "string") { + return /* Nil */0; + } else { + return { + TAG: /* Cons */0, _0: Curry._1(f, param._0), _1: map(f, param._1) }; - } else { - return /* Nil */0; } } diff --git a/jscomp/test/dist/jscomp/test/test_fib.js b/jscomp/test/dist/jscomp/test/test_fib.js index d1a4843544..d6259555f0 100644 --- a/jscomp/test/dist/jscomp/test/test_fib.js +++ b/jscomp/test/dist/jscomp/test/test_fib.js @@ -36,28 +36,30 @@ for(let i$1 = 10; i$1 >= 0; --i$1){ const sumdown = v$1; function cons(x, y) { - return /* Cons */{ + return { + TAG: /* Cons */0, _0: x, _1: y }; } function length(x) { - if (x) { - return 1 + length(x._1) | 0; - } else { + if (/* tag */typeof x === "number" || typeof x === "string") { return 0; + } else { + return 1 + length(x._1) | 0; } } function map(f, x) { - if (x) { - return /* Cons */{ + if (/* tag */typeof x === "number" || typeof x === "string") { + return /* Nil */0; + } else { + return { + TAG: /* Cons */0, _0: Curry._1(f, x._0), _1: map(f, x._1) }; - } else { - return /* Nil */0; } } diff --git a/jscomp/test/dist/jscomp/test/test_for_map.js b/jscomp/test/dist/jscomp/test/test_for_map.js index cc8afc4933..21f9de6c07 100644 --- a/jscomp/test/dist/jscomp/test/test_for_map.js +++ b/jscomp/test/dist/jscomp/test/test_for_map.js @@ -16,17 +16,18 @@ const funarg = { }; function height(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create(l, x, d, r) { const hl = height(l); const hr = height(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -36,7 +37,8 @@ function create(l, x, d, r) { } function singleton(x, d) { - return /* Node */{ + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: d, @@ -46,32 +48,35 @@ function singleton(x, d) { } function bal(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height(ll) >= height(lr)) { - return create(ll, lv, ld, create(lr, x, d, r)); - } - if (lr) { - return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height(ll) >= height(lr)) { + return create(ll, lv, ld, create(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -79,22 +84,22 @@ function bal(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height(rr) >= height(rl)) { - return create(create(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height(rr) >= height(rl)) { + return create(create(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -102,16 +107,17 @@ function bal(l, x, d, r) { } function is_empty(param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } } function add(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -128,7 +134,8 @@ function add(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -156,63 +163,63 @@ function add(x, data, m) { function find(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(funarg.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(funarg.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } function find_first(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _d0 = param.d; - let _param$1 = param.l; - while(true) { - const param$1 = _param$1; - const d0 = _d0; - const v0 = _v0; - if (!param$1) { - return [ - v0, - d0 - ]; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.l; - _d0 = param$1.d; - _v0 = v$1; - continue ; - } - _param$1 = param$1.r; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _d0 = param.d; + let _param$1 = param.l; + while(true) { + const param$1 = _param$1; + const d0 = _d0; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return [ + v0, + d0 + ]; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.l; + _d0 = param$1.d; + _v0 = v$1; continue ; - }; - } - _param = param.r; - continue ; + } + _param$1 = param$1.r; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.r; + continue ; }; } function find_first_opt(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -224,7 +231,7 @@ function find_first_opt(f, _param) { const param$1 = _param$1; const d0 = _d0; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return [ v0, d0 @@ -249,46 +256,46 @@ function find_first_opt(f, _param) { function find_last(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _d0 = param.d; - let _param$1 = param.r; - while(true) { - const param$1 = _param$1; - const d0 = _d0; - const v0 = _v0; - if (!param$1) { - return [ - v0, - d0 - ]; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.r; - _d0 = param$1.d; - _v0 = v$1; - continue ; - } - _param$1 = param$1.l; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _d0 = param.d; + let _param$1 = param.r; + while(true) { + const param$1 = _param$1; + const d0 = _d0; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return [ + v0, + d0 + ]; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.r; + _d0 = param$1.d; + _v0 = v$1; continue ; - }; - } - _param = param.l; - continue ; + } + _param$1 = param$1.l; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.l; + continue ; }; } function find_last_opt(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -300,7 +307,7 @@ function find_last_opt(f, _param) { const param$1 = _param$1; const d0 = _d0; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return [ v0, d0 @@ -325,7 +332,7 @@ function find_last_opt(f, _param) { function find_opt(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const c = Curry._2(funarg.compare, x, param.v); @@ -340,7 +347,7 @@ function find_opt(x, _param) { function mem(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(funarg.compare, x, param.v); @@ -355,31 +362,31 @@ function mem(x, _param) { function min_binding(_param) { while(true) { const param = _param; - if (param) { - const l = param.l; - if (!l) { - return [ - param.v, - param.d - ]; - } - _param = l; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return [ + param.v, + param.d + ]; + } + _param = l; + continue ; }; } function min_binding_opt(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const l = param.l; - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return [ param.v, param.d @@ -393,29 +400,31 @@ function min_binding_opt(_param) { function max_binding(_param) { while(true) { const param = _param; - if (param) { - if (!param.r) { - return [ - param.v, - param.d - ]; - } - _param = param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return [ + param.v, + param.d + ]; + } + _param = param.r; + continue ; }; } function max_binding_opt(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } - if (!param.r) { + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { return [ param.v, param.d @@ -427,25 +436,25 @@ function max_binding_opt(_param) { } function remove_min_binding(param) { - if (param) { - const l = param.l; - if (l) { - return bal(remove_min_binding(l), param.v, param.d, param.r); - } else { - return param.r; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Invalid_argument", { + MEL_EXN_ID: "Invalid_argument", + _1: "Map.remove_min_elt" + }); + } + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param.r; + } else { + return bal(remove_min_binding(l), param.v, param.d, param.r); } - throw new Caml_js_exceptions.MelangeError("Invalid_argument", { - MEL_EXN_ID: "Invalid_argument", - _1: "Map.remove_min_elt" - }); } function merge(t1, t2) { - if (!t1) { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; } - if (!t2) { + if (/* tag */typeof t2 === "number" || typeof t2 === "string") { return t1; } const match = min_binding(t2); @@ -453,7 +462,7 @@ function merge(t1, t2) { } function remove(x, m) { - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return /* Empty */0; } const r = m.r; @@ -481,56 +490,58 @@ function remove(x, m) { } function update(x, f, m) { - if (m) { - const r = m.r; - const d = m.d; - const v = m.v; - const l = m.l; - const c = Curry._2(funarg.compare, x, v); - if (c === 0) { - const data = Curry._1(f, Caml_option.some(d)); - if (data === undefined) { - return merge(l, r); - } - const data$1 = Caml_option.valFromOption(data); - if (d === data$1) { - return m; - } else { - return /* Node */{ - l: l, - v: x, - d: data$1, - r: r, - h: m.h - }; - } + if (/* tag */typeof m === "number" || typeof m === "string") { + const data = Curry._1(f, undefined); + if (data !== undefined) { + return { + TAG: /* Node */0, + l: /* Empty */0, + v: x, + d: Caml_option.valFromOption(data), + r: /* Empty */0, + h: 1 + }; + } else { + return /* Empty */0; } - if (c < 0) { - const ll = update(x, f, l); - if (l === ll) { - return m; - } else { - return bal(ll, v, d, r); - } + } + const r = m.r; + const d = m.d; + const v = m.v; + const l = m.l; + const c = Curry._2(funarg.compare, x, v); + if (c === 0) { + const data$1 = Curry._1(f, Caml_option.some(d)); + if (data$1 === undefined) { + return merge(l, r); } - const rr = update(x, f, r); - if (r === rr) { + const data$2 = Caml_option.valFromOption(data$1); + if (d === data$2) { return m; } else { - return bal(l, v, d, rr); + return { + TAG: /* Node */0, + l: l, + v: x, + d: data$2, + r: r, + h: m.h + }; } } - const data$2 = Curry._1(f, undefined); - if (data$2 !== undefined) { - return /* Node */{ - l: /* Empty */0, - v: x, - d: Caml_option.valFromOption(data$2), - r: /* Empty */0, - h: 1 - }; + if (c < 0) { + const ll = update(x, f, l); + if (l === ll) { + return m; + } else { + return bal(ll, v, d, r); + } + } + const rr = update(x, f, r); + if (r === rr) { + return m; } else { - return /* Empty */0; + return bal(l, v, d, rr); } } @@ -554,7 +565,7 @@ function add_to_list(x, data, m) { function iter(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } iter(f, param.l); @@ -565,13 +576,14 @@ function iter(f, _param) { } function map(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const l$p = map(f, param.l); const d$p = Curry._1(f, param.d); const r$p = map(f, param.r); - return /* Node */{ + return { + TAG: /* Node */0, l: l$p, v: param.v, d: d$p, @@ -581,14 +593,15 @@ function map(f, param) { } function mapi(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param.v; const l$p = mapi(f, param.l); const d$p = Curry._2(f, v, param.d); const r$p = mapi(f, param.r); - return /* Node */{ + return { + TAG: /* Node */0, l: l$p, v: v, d: d$p, @@ -601,7 +614,7 @@ function fold(f, _m, _accu) { while(true) { const accu = _accu; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return accu; } _accu = Curry._3(f, m.v, m.d, fold(f, m.l, accu)); @@ -613,7 +626,7 @@ function fold(f, _m, _accu) { function for_all(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; } if (!Curry._2(p, param.v, param.d)) { @@ -630,7 +643,7 @@ function for_all(p, _param) { function exists(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } if (Curry._2(p, param.v, param.d)) { @@ -645,30 +658,30 @@ function exists(p, _param) { } function add_min_binding(k, x, param) { - if (param) { - return bal(add_min_binding(k, x, param.l), param.v, param.d, param.r); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(k, x); + } else { + return bal(add_min_binding(k, x, param.l), param.v, param.d, param.r); } } function add_max_binding(k, x, param) { - if (param) { - return bal(param.l, param.v, param.d, add_max_binding(k, x, param.r)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(k, x); + } else { + return bal(param.l, param.v, param.d, add_max_binding(k, x, param.r)); } } function join(l, v, d, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_binding(v, d, r); } - if (!r) { + const lh = l.h; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_binding(v, d, l); } const rh = r.h; - const lh = l.h; if (lh > (rh + 2 | 0)) { return bal(l.l, l.v, l.d, join(l.r, v, d, r)); } else if (rh > (lh + 2 | 0)) { @@ -679,10 +692,10 @@ function join(l, v, d, r) { } function concat(t1, t2) { - if (!t1) { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; } - if (!t2) { + if (/* tag */typeof t2 === "number" || typeof t2 === "string") { return t1; } const match = min_binding(t2); @@ -698,7 +711,7 @@ function concat_or_join(t1, v, d, t2) { } function split(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, undefined, @@ -734,42 +747,45 @@ function split(x, param) { } function merge$1(f, s1, s2) { - if (s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + return /* Empty */0; + } + + } else { const v1 = s1.v; if (s1.h >= height(s2)) { const match = split(v1, s2); return concat_or_join(merge$1(f, s1.l, match[0]), v1, Curry._3(f, v1, Caml_option.some(s1.d), match[1]), merge$1(f, s1.r, match[2])); } - } else if (!s2) { - return /* Empty */0; } - if (s2) { - const v2 = s2.v; - const match$1 = split(v2, s1); - return concat_or_join(merge$1(f, match$1[0], s2.l), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2.d)), merge$1(f, match$1[2], s2.r)); + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/stdlib/map.ml", + 408, + 10 + ] + }); } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/stdlib/map.ml", - 408, - 10 - ] - }); + const v2 = s2.v; + const match$1 = split(v2, s1); + return concat_or_join(merge$1(f, match$1[0], s2.l), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2.d)), merge$1(f, match$1[2], s2.r)); } function union(f, s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return s2; } - if (!s2) { + const d1 = s1.d; + const v1 = s1.v; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const d2 = s2.d; const v2 = s2.v; - const d1 = s1.d; - const v1 = s1.v; if (s1.h >= s2.h) { const match = split(v1, s2); const d2$1 = match[1]; @@ -793,7 +809,7 @@ function union(f, s1, s2) { } function filter(p, m) { - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return /* Empty */0; } const r = m.r; @@ -815,7 +831,7 @@ function filter(p, m) { } function filter_map(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param.v; @@ -830,7 +846,7 @@ function filter_map(f, param) { } function partition(p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, /* Empty */0 @@ -862,10 +878,11 @@ function cons_enum(_m, _e) { while(true) { const e = _e; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: m.v, _1: m.d, _2: m.r, @@ -882,14 +899,14 @@ function compare$1(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return -1; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 0; + } else { + return -1; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 1; } const c = Curry._2(funarg.compare, e1._0, e2._0); @@ -912,14 +929,14 @@ function equal(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return false; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return true; + } else { + return false; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return false; } if (Curry._2(funarg.compare, e1._0, e2._0) !== 0) { @@ -935,10 +952,10 @@ function equal(cmp, m1, m2) { } function cardinal(param) { - if (param) { - return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; } } @@ -946,7 +963,7 @@ function bindings_aux(_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param.l; @@ -982,11 +999,12 @@ function of_seq(i) { } function seq_of_enum_(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = cons_enum(c._2, c._3); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: [ c._0, c._1 @@ -1008,10 +1026,11 @@ function snoc_enum(_s, _e) { while(true) { const e = _e; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: s.v, _1: s.d, _2: s.l, @@ -1023,11 +1042,12 @@ function snoc_enum(_s, _e) { } function rev_seq_of_enum_(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = snoc_enum(c._2, c._3); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: [ c._0, c._1 @@ -1050,7 +1070,7 @@ function to_seq_from(low, m) { while(true) { const c = _c; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return c; } const r = m.r; @@ -1058,7 +1078,8 @@ function to_seq_from(low, m) { const v = m.v; const n = Curry._2(funarg.compare, v, low); if (n === 0) { - return /* More */{ + return { + TAG: /* More */0, _0: v, _1: d, _2: r, @@ -1069,7 +1090,8 @@ function to_seq_from(low, m) { _m = r; continue ; } - _c = /* More */{ + _c = { + TAG: /* More */0, _0: v, _1: d, _2: r, diff --git a/jscomp/test/dist/jscomp/test/test_format.js b/jscomp/test/dist/jscomp/test/test_format.js index fe2eee2d96..6f27dcf859 100644 --- a/jscomp/test/dist/jscomp/test/test_format.js +++ b/jscomp/test/dist/jscomp/test/test_format.js @@ -4,7 +4,8 @@ const Curry = require("melange.js/curry.js"); const Stdlib__Format = require("melange/format.js"); -Curry._1(Stdlib__Format.fprintf(Stdlib__Format.std_formatter)(/* Format */{ +Curry._1(Stdlib__Format.fprintf(Stdlib__Format.std_formatter)({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, diff --git a/jscomp/test/dist/jscomp/test/test_formatter.js b/jscomp/test/dist/jscomp/test/test_formatter.js index 0bb1332b9f..afc23a07a2 100644 --- a/jscomp/test/dist/jscomp/test/test_formatter.js +++ b/jscomp/test/dist/jscomp/test/test_formatter.js @@ -3,7 +3,8 @@ function f(param) { - return /* Format */{ + return { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, diff --git a/jscomp/test/dist/jscomp/test/test_functor_dead_code.js b/jscomp/test/dist/jscomp/test/test_functor_dead_code.js index 71b2b749c7..8fc644da53 100644 --- a/jscomp/test/dist/jscomp/test/test_functor_dead_code.js +++ b/jscomp/test/dist/jscomp/test/test_functor_dead_code.js @@ -4,10 +4,10 @@ const Curry = require("melange.js/curry.js"); function is_empty(param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } } diff --git a/jscomp/test/dist/jscomp/test/test_incomplete.js b/jscomp/test/dist/jscomp/test/test_incomplete.js index 5690834000..113c77537a 100644 --- a/jscomp/test/dist/jscomp/test/test_incomplete.js +++ b/jscomp/test/dist/jscomp/test/test_incomplete.js @@ -26,7 +26,7 @@ function f2(x) { } function f3(x) { - switch (x.TAG | 0) { + switch (x.TAG) { case /* A */0 : case /* C */2 : return x._0 + 1 | 0; diff --git a/jscomp/test/dist/jscomp/test/test_int_map_find.js b/jscomp/test/dist/jscomp/test/test_int_map_find.js index efd427077e..60e0ceb61a 100644 --- a/jscomp/test/dist/jscomp/test/test_int_map_find.js +++ b/jscomp/test/dist/jscomp/test/test_int_map_find.js @@ -13,17 +13,18 @@ const funarg = { }; function height(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create(l, x, d, r) { const hl = height(l); const hr = height(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -33,32 +34,35 @@ function create(l, x, d, r) { } function bal(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height(ll) >= height(lr)) { - return create(ll, lv, ld, create(lr, x, d, r)); - } - if (lr) { - return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height(ll) >= height(lr)) { + return create(ll, lv, ld, create(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -66,22 +70,22 @@ function bal(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height(rr) >= height(rl)) { - return create(create(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height(rr) >= height(rl)) { + return create(create(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -89,8 +93,9 @@ function bal(l, x, d, r) { } function add(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -107,7 +112,8 @@ function add(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, diff --git a/jscomp/test/dist/jscomp/test/test_internalOO.js b/jscomp/test/dist/jscomp/test/test_internalOO.js index 5b7319b44b..4f92dabdd1 100644 --- a/jscomp/test/dist/jscomp/test/test_internalOO.js +++ b/jscomp/test/dist/jscomp/test/test_internalOO.js @@ -50,17 +50,18 @@ const funarg = { }; function height(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create(l, x, d, r) { const hl = height(l); const hr = height(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -70,7 +71,8 @@ function create(l, x, d, r) { } function singleton(x, d) { - return /* Node */{ + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: d, @@ -80,32 +82,35 @@ function singleton(x, d) { } function bal(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height(ll) >= height(lr)) { - return create(ll, lv, ld, create(lr, x, d, r)); - } - if (lr) { - return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height(ll) >= height(lr)) { + return create(ll, lv, ld, create(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -113,22 +118,22 @@ function bal(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height(rr) >= height(rl)) { - return create(create(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height(rr) >= height(rl)) { + return create(create(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -136,16 +141,17 @@ function bal(l, x, d, r) { } function is_empty(param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } } function add(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -162,7 +168,8 @@ function add(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -190,63 +197,63 @@ function add(x, data, m) { function find(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(funarg.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(funarg.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } function find_first(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _d0 = param.d; - let _param$1 = param.l; - while(true) { - const param$1 = _param$1; - const d0 = _d0; - const v0 = _v0; - if (!param$1) { - return [ - v0, - d0 - ]; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.l; - _d0 = param$1.d; - _v0 = v$1; - continue ; - } - _param$1 = param$1.r; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _d0 = param.d; + let _param$1 = param.l; + while(true) { + const param$1 = _param$1; + const d0 = _d0; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return [ + v0, + d0 + ]; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.l; + _d0 = param$1.d; + _v0 = v$1; continue ; - }; - } - _param = param.r; - continue ; + } + _param$1 = param$1.r; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.r; + continue ; }; } function find_first_opt(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -258,7 +265,7 @@ function find_first_opt(f, _param) { const param$1 = _param$1; const d0 = _d0; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return [ v0, d0 @@ -283,46 +290,46 @@ function find_first_opt(f, _param) { function find_last(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _d0 = param.d; - let _param$1 = param.r; - while(true) { - const param$1 = _param$1; - const d0 = _d0; - const v0 = _v0; - if (!param$1) { - return [ - v0, - d0 - ]; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.r; - _d0 = param$1.d; - _v0 = v$1; - continue ; - } - _param$1 = param$1.l; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _d0 = param.d; + let _param$1 = param.r; + while(true) { + const param$1 = _param$1; + const d0 = _d0; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return [ + v0, + d0 + ]; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.r; + _d0 = param$1.d; + _v0 = v$1; continue ; - }; - } - _param = param.l; - continue ; + } + _param$1 = param$1.l; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.l; + continue ; }; } function find_last_opt(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -334,7 +341,7 @@ function find_last_opt(f, _param) { const param$1 = _param$1; const d0 = _d0; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return [ v0, d0 @@ -359,7 +366,7 @@ function find_last_opt(f, _param) { function find_opt(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const c = Curry._2(funarg.compare, x, param.v); @@ -374,7 +381,7 @@ function find_opt(x, _param) { function mem(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(funarg.compare, x, param.v); @@ -389,31 +396,31 @@ function mem(x, _param) { function min_binding(_param) { while(true) { const param = _param; - if (param) { - const l = param.l; - if (!l) { - return [ - param.v, - param.d - ]; - } - _param = l; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return [ + param.v, + param.d + ]; + } + _param = l; + continue ; }; } function min_binding_opt(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const l = param.l; - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return [ param.v, param.d @@ -427,29 +434,31 @@ function min_binding_opt(_param) { function max_binding(_param) { while(true) { const param = _param; - if (param) { - if (!param.r) { - return [ - param.v, - param.d - ]; - } - _param = param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return [ + param.v, + param.d + ]; + } + _param = param.r; + continue ; }; } function max_binding_opt(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } - if (!param.r) { + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { return [ param.v, param.d @@ -461,25 +470,25 @@ function max_binding_opt(_param) { } function remove_min_binding(param) { - if (param) { - const l = param.l; - if (l) { - return bal(remove_min_binding(l), param.v, param.d, param.r); - } else { - return param.r; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Invalid_argument", { + MEL_EXN_ID: "Invalid_argument", + _1: "Map.remove_min_elt" + }); + } + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param.r; + } else { + return bal(remove_min_binding(l), param.v, param.d, param.r); } - throw new Caml_js_exceptions.MelangeError("Invalid_argument", { - MEL_EXN_ID: "Invalid_argument", - _1: "Map.remove_min_elt" - }); } function merge(t1, t2) { - if (!t1) { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; } - if (!t2) { + if (/* tag */typeof t2 === "number" || typeof t2 === "string") { return t1; } const match = min_binding(t2); @@ -487,7 +496,7 @@ function merge(t1, t2) { } function remove(x, m) { - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return /* Empty */0; } const r = m.r; @@ -515,56 +524,58 @@ function remove(x, m) { } function update(x, f, m) { - if (m) { - const r = m.r; - const d = m.d; - const v = m.v; - const l = m.l; - const c = Curry._2(funarg.compare, x, v); - if (c === 0) { - const data = Curry._1(f, Caml_option.some(d)); - if (data === undefined) { - return merge(l, r); - } - const data$1 = Caml_option.valFromOption(data); - if (d === data$1) { - return m; - } else { - return /* Node */{ - l: l, - v: x, - d: data$1, - r: r, - h: m.h - }; - } + if (/* tag */typeof m === "number" || typeof m === "string") { + const data = Curry._1(f, undefined); + if (data !== undefined) { + return { + TAG: /* Node */0, + l: /* Empty */0, + v: x, + d: Caml_option.valFromOption(data), + r: /* Empty */0, + h: 1 + }; + } else { + return /* Empty */0; } - if (c < 0) { - const ll = update(x, f, l); - if (l === ll) { - return m; - } else { - return bal(ll, v, d, r); - } + } + const r = m.r; + const d = m.d; + const v = m.v; + const l = m.l; + const c = Curry._2(funarg.compare, x, v); + if (c === 0) { + const data$1 = Curry._1(f, Caml_option.some(d)); + if (data$1 === undefined) { + return merge(l, r); } - const rr = update(x, f, r); - if (r === rr) { + const data$2 = Caml_option.valFromOption(data$1); + if (d === data$2) { return m; } else { - return bal(l, v, d, rr); + return { + TAG: /* Node */0, + l: l, + v: x, + d: data$2, + r: r, + h: m.h + }; } } - const data$2 = Curry._1(f, undefined); - if (data$2 !== undefined) { - return /* Node */{ - l: /* Empty */0, - v: x, - d: Caml_option.valFromOption(data$2), - r: /* Empty */0, - h: 1 - }; + if (c < 0) { + const ll = update(x, f, l); + if (l === ll) { + return m; + } else { + return bal(ll, v, d, r); + } + } + const rr = update(x, f, r); + if (r === rr) { + return m; } else { - return /* Empty */0; + return bal(l, v, d, rr); } } @@ -588,7 +599,7 @@ function add_to_list(x, data, m) { function iter(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } iter(f, param.l); @@ -599,13 +610,14 @@ function iter(f, _param) { } function map(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const l$p = map(f, param.l); const d$p = Curry._1(f, param.d); const r$p = map(f, param.r); - return /* Node */{ + return { + TAG: /* Node */0, l: l$p, v: param.v, d: d$p, @@ -615,14 +627,15 @@ function map(f, param) { } function mapi(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param.v; const l$p = mapi(f, param.l); const d$p = Curry._2(f, v, param.d); const r$p = mapi(f, param.r); - return /* Node */{ + return { + TAG: /* Node */0, l: l$p, v: v, d: d$p, @@ -635,7 +648,7 @@ function fold(f, _m, _accu) { while(true) { const accu = _accu; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return accu; } _accu = Curry._3(f, m.v, m.d, fold(f, m.l, accu)); @@ -647,7 +660,7 @@ function fold(f, _m, _accu) { function for_all(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; } if (!Curry._2(p, param.v, param.d)) { @@ -664,7 +677,7 @@ function for_all(p, _param) { function exists(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } if (Curry._2(p, param.v, param.d)) { @@ -679,30 +692,30 @@ function exists(p, _param) { } function add_min_binding(k, x, param) { - if (param) { - return bal(add_min_binding(k, x, param.l), param.v, param.d, param.r); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(k, x); + } else { + return bal(add_min_binding(k, x, param.l), param.v, param.d, param.r); } } function add_max_binding(k, x, param) { - if (param) { - return bal(param.l, param.v, param.d, add_max_binding(k, x, param.r)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(k, x); + } else { + return bal(param.l, param.v, param.d, add_max_binding(k, x, param.r)); } } function join(l, v, d, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_binding(v, d, r); } - if (!r) { + const lh = l.h; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_binding(v, d, l); } const rh = r.h; - const lh = l.h; if (lh > (rh + 2 | 0)) { return bal(l.l, l.v, l.d, join(l.r, v, d, r)); } else if (rh > (lh + 2 | 0)) { @@ -713,10 +726,10 @@ function join(l, v, d, r) { } function concat(t1, t2) { - if (!t1) { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; } - if (!t2) { + if (/* tag */typeof t2 === "number" || typeof t2 === "string") { return t1; } const match = min_binding(t2); @@ -732,7 +745,7 @@ function concat_or_join(t1, v, d, t2) { } function split(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, undefined, @@ -768,42 +781,45 @@ function split(x, param) { } function merge$1(f, s1, s2) { - if (s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + return /* Empty */0; + } + + } else { const v1 = s1.v; if (s1.h >= height(s2)) { const match = split(v1, s2); return concat_or_join(merge$1(f, s1.l, match[0]), v1, Curry._3(f, v1, Caml_option.some(s1.d), match[1]), merge$1(f, s1.r, match[2])); } - } else if (!s2) { - return /* Empty */0; } - if (s2) { - const v2 = s2.v; - const match$1 = split(v2, s1); - return concat_or_join(merge$1(f, match$1[0], s2.l), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2.d)), merge$1(f, match$1[2], s2.r)); - } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/stdlib/map.ml", - 408, - 10 - ] - }); + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/stdlib/map.ml", + 408, + 10 + ] + }); + } + const v2 = s2.v; + const match$1 = split(v2, s1); + return concat_or_join(merge$1(f, match$1[0], s2.l), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2.d)), merge$1(f, match$1[2], s2.r)); } function union(f, s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return s2; } - if (!s2) { + const d1 = s1.d; + const v1 = s1.v; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const d2 = s2.d; const v2 = s2.v; - const d1 = s1.d; - const v1 = s1.v; if (s1.h >= s2.h) { const match = split(v1, s2); const d2$1 = match[1]; @@ -827,7 +843,7 @@ function union(f, s1, s2) { } function filter(p, m) { - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return /* Empty */0; } const r = m.r; @@ -849,7 +865,7 @@ function filter(p, m) { } function filter_map(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param.v; @@ -864,7 +880,7 @@ function filter_map(f, param) { } function partition(p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, /* Empty */0 @@ -896,10 +912,11 @@ function cons_enum(_m, _e) { while(true) { const e = _e; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: m.v, _1: m.d, _2: m.r, @@ -916,14 +933,14 @@ function compare$1(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return -1; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 0; + } else { + return -1; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 1; } const c = Curry._2(funarg.compare, e1._0, e2._0); @@ -946,14 +963,14 @@ function equal(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return false; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return true; + } else { + return false; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return false; } if (Curry._2(funarg.compare, e1._0, e2._0) !== 0) { @@ -969,10 +986,10 @@ function equal(cmp, m1, m2) { } function cardinal(param) { - if (param) { - return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; } } @@ -980,7 +997,7 @@ function bindings_aux(_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param.l; @@ -1016,11 +1033,12 @@ function of_seq(i) { } function seq_of_enum_(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = cons_enum(c._2, c._3); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: [ c._0, c._1 @@ -1042,10 +1060,11 @@ function snoc_enum(_s, _e) { while(true) { const e = _e; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: s.v, _1: s.d, _2: s.l, @@ -1057,11 +1076,12 @@ function snoc_enum(_s, _e) { } function rev_seq_of_enum_(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = snoc_enum(c._2, c._3); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: [ c._0, c._1 @@ -1084,7 +1104,7 @@ function to_seq_from(low, m) { while(true) { const c = _c; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return c; } const r = m.r; @@ -1092,7 +1112,8 @@ function to_seq_from(low, m) { const v = m.v; const n = Curry._2(funarg.compare, v, low); if (n === 0) { - return /* More */{ + return { + TAG: /* More */0, _0: v, _1: d, _2: r, @@ -1103,7 +1124,8 @@ function to_seq_from(low, m) { _m = r; continue ; } - _c = /* More */{ + _c = { + TAG: /* More */0, _0: v, _1: d, _2: r, @@ -1172,17 +1194,18 @@ const funarg$1 = { }; function height$1(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$1(l, x, d, r) { const hl = height$1(l); const hr = height$1(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -1192,7 +1215,8 @@ function create$1(l, x, d, r) { } function singleton$1(x, d) { - return /* Node */{ + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: d, @@ -1202,32 +1226,35 @@ function singleton$1(x, d) { } function bal$1(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height$1(ll) >= height$1(lr)) { - return create$1(ll, lv, ld, create$1(lr, x, d, r)); - } - if (lr) { - return create$1(create$1(ll, lv, ld, lr.l), lr.v, lr.d, create$1(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height$1(ll) >= height$1(lr)) { + return create$1(ll, lv, ld, create$1(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$1(create$1(ll, lv, ld, lr.l), lr.v, lr.d, create$1(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -1235,22 +1262,22 @@ function bal$1(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height$1(rr) >= height$1(rl)) { - return create$1(create$1(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create$1(create$1(l, x, d, rl.l), rl.v, rl.d, create$1(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height$1(rr) >= height$1(rl)) { + return create$1(create$1(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$1(create$1(l, x, d, rl.l), rl.v, rl.d, create$1(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -1258,16 +1285,17 @@ function bal$1(l, x, d, r) { } function is_empty$1(param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } } function add$1(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -1284,7 +1312,8 @@ function add$1(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -1312,63 +1341,63 @@ function add$1(x, data, m) { function find$1(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(funarg$1.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(funarg$1.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } function find_first$1(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _d0 = param.d; - let _param$1 = param.l; - while(true) { - const param$1 = _param$1; - const d0 = _d0; - const v0 = _v0; - if (!param$1) { - return [ - v0, - d0 - ]; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.l; - _d0 = param$1.d; - _v0 = v$1; - continue ; - } - _param$1 = param$1.r; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _d0 = param.d; + let _param$1 = param.l; + while(true) { + const param$1 = _param$1; + const d0 = _d0; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return [ + v0, + d0 + ]; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.l; + _d0 = param$1.d; + _v0 = v$1; continue ; - }; - } - _param = param.r; - continue ; + } + _param$1 = param$1.r; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.r; + continue ; }; } function find_first_opt$1(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -1380,7 +1409,7 @@ function find_first_opt$1(f, _param) { const param$1 = _param$1; const d0 = _d0; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return [ v0, d0 @@ -1405,46 +1434,46 @@ function find_first_opt$1(f, _param) { function find_last$1(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _d0 = param.d; - let _param$1 = param.r; - while(true) { - const param$1 = _param$1; - const d0 = _d0; - const v0 = _v0; - if (!param$1) { - return [ - v0, - d0 - ]; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.r; - _d0 = param$1.d; - _v0 = v$1; - continue ; - } - _param$1 = param$1.l; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _d0 = param.d; + let _param$1 = param.r; + while(true) { + const param$1 = _param$1; + const d0 = _d0; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return [ + v0, + d0 + ]; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.r; + _d0 = param$1.d; + _v0 = v$1; continue ; - }; - } - _param = param.l; - continue ; + } + _param$1 = param$1.l; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.l; + continue ; }; } function find_last_opt$1(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -1456,7 +1485,7 @@ function find_last_opt$1(f, _param) { const param$1 = _param$1; const d0 = _d0; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return [ v0, d0 @@ -1481,7 +1510,7 @@ function find_last_opt$1(f, _param) { function find_opt$1(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const c = Curry._2(funarg$1.compare, x, param.v); @@ -1496,7 +1525,7 @@ function find_opt$1(x, _param) { function mem$1(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(funarg$1.compare, x, param.v); @@ -1511,31 +1540,31 @@ function mem$1(x, _param) { function min_binding$1(_param) { while(true) { const param = _param; - if (param) { - const l = param.l; - if (!l) { - return [ - param.v, - param.d - ]; - } - _param = l; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return [ + param.v, + param.d + ]; + } + _param = l; + continue ; }; } function min_binding_opt$1(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const l = param.l; - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return [ param.v, param.d @@ -1549,29 +1578,31 @@ function min_binding_opt$1(_param) { function max_binding$1(_param) { while(true) { const param = _param; - if (param) { - if (!param.r) { - return [ - param.v, - param.d - ]; - } - _param = param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return [ + param.v, + param.d + ]; + } + _param = param.r; + continue ; }; } function max_binding_opt$1(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } - if (!param.r) { + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { return [ param.v, param.d @@ -1583,25 +1614,25 @@ function max_binding_opt$1(_param) { } function remove_min_binding$1(param) { - if (param) { - const l = param.l; - if (l) { - return bal$1(remove_min_binding$1(l), param.v, param.d, param.r); - } else { - return param.r; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Invalid_argument", { + MEL_EXN_ID: "Invalid_argument", + _1: "Map.remove_min_elt" + }); + } + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param.r; + } else { + return bal$1(remove_min_binding$1(l), param.v, param.d, param.r); } - throw new Caml_js_exceptions.MelangeError("Invalid_argument", { - MEL_EXN_ID: "Invalid_argument", - _1: "Map.remove_min_elt" - }); } function merge$2(t1, t2) { - if (!t1) { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; } - if (!t2) { + if (/* tag */typeof t2 === "number" || typeof t2 === "string") { return t1; } const match = min_binding$1(t2); @@ -1609,7 +1640,7 @@ function merge$2(t1, t2) { } function remove$1(x, m) { - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return /* Empty */0; } const r = m.r; @@ -1637,56 +1668,58 @@ function remove$1(x, m) { } function update$1(x, f, m) { - if (m) { - const r = m.r; - const d = m.d; - const v = m.v; - const l = m.l; - const c = Curry._2(funarg$1.compare, x, v); - if (c === 0) { - const data = Curry._1(f, Caml_option.some(d)); - if (data === undefined) { - return merge$2(l, r); - } - const data$1 = Caml_option.valFromOption(data); - if (d === data$1) { - return m; - } else { - return /* Node */{ - l: l, - v: x, - d: data$1, - r: r, - h: m.h - }; - } + if (/* tag */typeof m === "number" || typeof m === "string") { + const data = Curry._1(f, undefined); + if (data !== undefined) { + return { + TAG: /* Node */0, + l: /* Empty */0, + v: x, + d: Caml_option.valFromOption(data), + r: /* Empty */0, + h: 1 + }; + } else { + return /* Empty */0; } - if (c < 0) { - const ll = update$1(x, f, l); - if (l === ll) { - return m; - } else { - return bal$1(ll, v, d, r); - } + } + const r = m.r; + const d = m.d; + const v = m.v; + const l = m.l; + const c = Curry._2(funarg$1.compare, x, v); + if (c === 0) { + const data$1 = Curry._1(f, Caml_option.some(d)); + if (data$1 === undefined) { + return merge$2(l, r); + } + const data$2 = Caml_option.valFromOption(data$1); + if (d === data$2) { + return m; + } else { + return { + TAG: /* Node */0, + l: l, + v: x, + d: data$2, + r: r, + h: m.h + }; } - const rr = update$1(x, f, r); - if (r === rr) { + } + if (c < 0) { + const ll = update$1(x, f, l); + if (l === ll) { return m; } else { - return bal$1(l, v, d, rr); + return bal$1(ll, v, d, r); } } - const data$2 = Curry._1(f, undefined); - if (data$2 !== undefined) { - return /* Node */{ - l: /* Empty */0, - v: x, - d: Caml_option.valFromOption(data$2), - r: /* Empty */0, - h: 1 - }; + const rr = update$1(x, f, r); + if (r === rr) { + return m; } else { - return /* Empty */0; + return bal$1(l, v, d, rr); } } @@ -1710,7 +1743,7 @@ function add_to_list$1(x, data, m) { function iter$1(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } iter$1(f, param.l); @@ -1721,13 +1754,14 @@ function iter$1(f, _param) { } function map$1(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const l$p = map$1(f, param.l); const d$p = Curry._1(f, param.d); const r$p = map$1(f, param.r); - return /* Node */{ + return { + TAG: /* Node */0, l: l$p, v: param.v, d: d$p, @@ -1737,14 +1771,15 @@ function map$1(f, param) { } function mapi$1(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param.v; const l$p = mapi$1(f, param.l); const d$p = Curry._2(f, v, param.d); const r$p = mapi$1(f, param.r); - return /* Node */{ + return { + TAG: /* Node */0, l: l$p, v: v, d: d$p, @@ -1757,7 +1792,7 @@ function fold$1(f, _m, _accu) { while(true) { const accu = _accu; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return accu; } _accu = Curry._3(f, m.v, m.d, fold$1(f, m.l, accu)); @@ -1769,7 +1804,7 @@ function fold$1(f, _m, _accu) { function for_all$1(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; } if (!Curry._2(p, param.v, param.d)) { @@ -1786,7 +1821,7 @@ function for_all$1(p, _param) { function exists$1(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } if (Curry._2(p, param.v, param.d)) { @@ -1801,30 +1836,30 @@ function exists$1(p, _param) { } function add_min_binding$1(k, x, param) { - if (param) { - return bal$1(add_min_binding$1(k, x, param.l), param.v, param.d, param.r); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton$1(k, x); + } else { + return bal$1(add_min_binding$1(k, x, param.l), param.v, param.d, param.r); } } function add_max_binding$1(k, x, param) { - if (param) { - return bal$1(param.l, param.v, param.d, add_max_binding$1(k, x, param.r)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton$1(k, x); + } else { + return bal$1(param.l, param.v, param.d, add_max_binding$1(k, x, param.r)); } } function join$1(l, v, d, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_binding$1(v, d, r); } - if (!r) { + const lh = l.h; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_binding$1(v, d, l); } const rh = r.h; - const lh = l.h; if (lh > (rh + 2 | 0)) { return bal$1(l.l, l.v, l.d, join$1(l.r, v, d, r)); } else if (rh > (lh + 2 | 0)) { @@ -1835,10 +1870,10 @@ function join$1(l, v, d, r) { } function concat$1(t1, t2) { - if (!t1) { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; } - if (!t2) { + if (/* tag */typeof t2 === "number" || typeof t2 === "string") { return t1; } const match = min_binding$1(t2); @@ -1854,7 +1889,7 @@ function concat_or_join$1(t1, v, d, t2) { } function split$1(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, undefined, @@ -1890,42 +1925,45 @@ function split$1(x, param) { } function merge$3(f, s1, s2) { - if (s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + return /* Empty */0; + } + + } else { const v1 = s1.v; if (s1.h >= height$1(s2)) { const match = split$1(v1, s2); return concat_or_join$1(merge$3(f, s1.l, match[0]), v1, Curry._3(f, v1, Caml_option.some(s1.d), match[1]), merge$3(f, s1.r, match[2])); } - } else if (!s2) { - return /* Empty */0; } - if (s2) { - const v2 = s2.v; - const match$1 = split$1(v2, s1); - return concat_or_join$1(merge$3(f, match$1[0], s2.l), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2.d)), merge$3(f, match$1[2], s2.r)); - } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/stdlib/map.ml", - 408, - 10 - ] - }); + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/stdlib/map.ml", + 408, + 10 + ] + }); + } + const v2 = s2.v; + const match$1 = split$1(v2, s1); + return concat_or_join$1(merge$3(f, match$1[0], s2.l), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2.d)), merge$3(f, match$1[2], s2.r)); } function union$1(f, s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return s2; } - if (!s2) { + const d1 = s1.d; + const v1 = s1.v; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const d2 = s2.d; const v2 = s2.v; - const d1 = s1.d; - const v1 = s1.v; if (s1.h >= s2.h) { const match = split$1(v1, s2); const d2$1 = match[1]; @@ -1949,7 +1987,7 @@ function union$1(f, s1, s2) { } function filter$1(p, m) { - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return /* Empty */0; } const r = m.r; @@ -1971,7 +2009,7 @@ function filter$1(p, m) { } function filter_map$1(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param.v; @@ -1986,7 +2024,7 @@ function filter_map$1(f, param) { } function partition$1(p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, /* Empty */0 @@ -2018,10 +2056,11 @@ function cons_enum$1(_m, _e) { while(true) { const e = _e; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: m.v, _1: m.d, _2: m.r, @@ -2038,14 +2077,14 @@ function compare$3(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return -1; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 0; + } else { + return -1; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 1; } const c = Curry._2(funarg$1.compare, e1._0, e2._0); @@ -2068,14 +2107,14 @@ function equal$1(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return false; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return true; + } else { + return false; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return false; } if (Curry._2(funarg$1.compare, e1._0, e2._0) !== 0) { @@ -2091,10 +2130,10 @@ function equal$1(cmp, m1, m2) { } function cardinal$1(param) { - if (param) { - return (cardinal$1(param.l) + 1 | 0) + cardinal$1(param.r) | 0; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return (cardinal$1(param.l) + 1 | 0) + cardinal$1(param.r) | 0; } } @@ -2102,7 +2141,7 @@ function bindings_aux$1(_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param.l; @@ -2138,11 +2177,12 @@ function of_seq$1(i) { } function seq_of_enum_$1(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = cons_enum$1(c._2, c._3); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: [ c._0, c._1 @@ -2164,10 +2204,11 @@ function snoc_enum$1(_s, _e) { while(true) { const e = _e; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: s.v, _1: s.d, _2: s.l, @@ -2179,11 +2220,12 @@ function snoc_enum$1(_s, _e) { } function rev_seq_of_enum_$1(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = snoc_enum$1(c._2, c._3); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: [ c._0, c._1 @@ -2206,7 +2248,7 @@ function to_seq_from$1(low, m) { while(true) { const c = _c; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return c; } const r = m.r; @@ -2214,7 +2256,8 @@ function to_seq_from$1(low, m) { const v = m.v; const n = Curry._2(funarg$1.compare, v, low); if (n === 0) { - return /* More */{ + return { + TAG: /* More */0, _0: v, _1: d, _2: r, @@ -2225,7 +2268,8 @@ function to_seq_from$1(low, m) { _m = r; continue ; } - _c = /* More */{ + _c = { + TAG: /* More */0, _0: v, _1: d, _2: r, @@ -2294,17 +2338,18 @@ const funarg$2 = { }; function height$2(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create$2(l, x, d, r) { const hl = height$2(l); const hr = height$2(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -2314,7 +2359,8 @@ function create$2(l, x, d, r) { } function singleton$2(x, d) { - return /* Node */{ + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: d, @@ -2324,32 +2370,35 @@ function singleton$2(x, d) { } function bal$2(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height$2(ll) >= height$2(lr)) { - return create$2(ll, lv, ld, create$2(lr, x, d, r)); - } - if (lr) { - return create$2(create$2(ll, lv, ld, lr.l), lr.v, lr.d, create$2(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height$2(ll) >= height$2(lr)) { + return create$2(ll, lv, ld, create$2(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create$2(create$2(ll, lv, ld, lr.l), lr.v, lr.d, create$2(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -2357,22 +2406,22 @@ function bal$2(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height$2(rr) >= height$2(rl)) { - return create$2(create$2(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create$2(create$2(l, x, d, rl.l), rl.v, rl.d, create$2(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height$2(rr) >= height$2(rl)) { + return create$2(create$2(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create$2(create$2(l, x, d, rl.l), rl.v, rl.d, create$2(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -2380,16 +2429,17 @@ function bal$2(l, x, d, r) { } function is_empty$2(param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } } function add$2(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -2406,7 +2456,8 @@ function add$2(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -2434,63 +2485,63 @@ function add$2(x, data, m) { function find$2(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(funarg$2.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(funarg$2.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } function find_first$2(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _d0 = param.d; - let _param$1 = param.l; - while(true) { - const param$1 = _param$1; - const d0 = _d0; - const v0 = _v0; - if (!param$1) { - return [ - v0, - d0 - ]; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.l; - _d0 = param$1.d; - _v0 = v$1; - continue ; - } - _param$1 = param$1.r; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _d0 = param.d; + let _param$1 = param.l; + while(true) { + const param$1 = _param$1; + const d0 = _d0; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return [ + v0, + d0 + ]; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.l; + _d0 = param$1.d; + _v0 = v$1; continue ; - }; - } - _param = param.r; - continue ; + } + _param$1 = param$1.r; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.r; + continue ; }; } function find_first_opt$2(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -2502,7 +2553,7 @@ function find_first_opt$2(f, _param) { const param$1 = _param$1; const d0 = _d0; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return [ v0, d0 @@ -2527,46 +2578,46 @@ function find_first_opt$2(f, _param) { function find_last$2(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _d0 = param.d; - let _param$1 = param.r; - while(true) { - const param$1 = _param$1; - const d0 = _d0; - const v0 = _v0; - if (!param$1) { - return [ - v0, - d0 - ]; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.r; - _d0 = param$1.d; - _v0 = v$1; - continue ; - } - _param$1 = param$1.l; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _d0 = param.d; + let _param$1 = param.r; + while(true) { + const param$1 = _param$1; + const d0 = _d0; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return [ + v0, + d0 + ]; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.r; + _d0 = param$1.d; + _v0 = v$1; continue ; - }; - } - _param = param.l; - continue ; + } + _param$1 = param$1.l; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.l; + continue ; }; } function find_last_opt$2(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -2578,7 +2629,7 @@ function find_last_opt$2(f, _param) { const param$1 = _param$1; const d0 = _d0; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return [ v0, d0 @@ -2603,7 +2654,7 @@ function find_last_opt$2(f, _param) { function find_opt$2(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const c = Curry._2(funarg$2.compare, x, param.v); @@ -2618,7 +2669,7 @@ function find_opt$2(x, _param) { function mem$2(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(funarg$2.compare, x, param.v); @@ -2633,31 +2684,31 @@ function mem$2(x, _param) { function min_binding$2(_param) { while(true) { const param = _param; - if (param) { - const l = param.l; - if (!l) { - return [ - param.v, - param.d - ]; - } - _param = l; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return [ + param.v, + param.d + ]; + } + _param = l; + continue ; }; } function min_binding_opt$2(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const l = param.l; - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return [ param.v, param.d @@ -2671,29 +2722,31 @@ function min_binding_opt$2(_param) { function max_binding$2(_param) { while(true) { const param = _param; - if (param) { - if (!param.r) { - return [ - param.v, - param.d - ]; - } - _param = param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return [ + param.v, + param.d + ]; + } + _param = param.r; + continue ; }; } function max_binding_opt$2(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } - if (!param.r) { + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { return [ param.v, param.d @@ -2705,25 +2758,25 @@ function max_binding_opt$2(_param) { } function remove_min_binding$2(param) { - if (param) { - const l = param.l; - if (l) { - return bal$2(remove_min_binding$2(l), param.v, param.d, param.r); - } else { - return param.r; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Invalid_argument", { + MEL_EXN_ID: "Invalid_argument", + _1: "Map.remove_min_elt" + }); + } + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param.r; + } else { + return bal$2(remove_min_binding$2(l), param.v, param.d, param.r); } - throw new Caml_js_exceptions.MelangeError("Invalid_argument", { - MEL_EXN_ID: "Invalid_argument", - _1: "Map.remove_min_elt" - }); } function merge$4(t1, t2) { - if (!t1) { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; } - if (!t2) { + if (/* tag */typeof t2 === "number" || typeof t2 === "string") { return t1; } const match = min_binding$2(t2); @@ -2731,7 +2784,7 @@ function merge$4(t1, t2) { } function remove$2(x, m) { - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return /* Empty */0; } const r = m.r; @@ -2759,56 +2812,58 @@ function remove$2(x, m) { } function update$2(x, f, m) { - if (m) { - const r = m.r; - const d = m.d; - const v = m.v; - const l = m.l; - const c = Curry._2(funarg$2.compare, x, v); - if (c === 0) { - const data = Curry._1(f, Caml_option.some(d)); - if (data === undefined) { - return merge$4(l, r); - } - const data$1 = Caml_option.valFromOption(data); - if (d === data$1) { - return m; - } else { - return /* Node */{ - l: l, - v: x, - d: data$1, - r: r, - h: m.h - }; - } + if (/* tag */typeof m === "number" || typeof m === "string") { + const data = Curry._1(f, undefined); + if (data !== undefined) { + return { + TAG: /* Node */0, + l: /* Empty */0, + v: x, + d: Caml_option.valFromOption(data), + r: /* Empty */0, + h: 1 + }; + } else { + return /* Empty */0; } - if (c < 0) { - const ll = update$2(x, f, l); - if (l === ll) { - return m; - } else { - return bal$2(ll, v, d, r); - } + } + const r = m.r; + const d = m.d; + const v = m.v; + const l = m.l; + const c = Curry._2(funarg$2.compare, x, v); + if (c === 0) { + const data$1 = Curry._1(f, Caml_option.some(d)); + if (data$1 === undefined) { + return merge$4(l, r); + } + const data$2 = Caml_option.valFromOption(data$1); + if (d === data$2) { + return m; + } else { + return { + TAG: /* Node */0, + l: l, + v: x, + d: data$2, + r: r, + h: m.h + }; } - const rr = update$2(x, f, r); - if (r === rr) { + } + if (c < 0) { + const ll = update$2(x, f, l); + if (l === ll) { return m; } else { - return bal$2(l, v, d, rr); + return bal$2(ll, v, d, r); } } - const data$2 = Curry._1(f, undefined); - if (data$2 !== undefined) { - return /* Node */{ - l: /* Empty */0, - v: x, - d: Caml_option.valFromOption(data$2), - r: /* Empty */0, - h: 1 - }; + const rr = update$2(x, f, r); + if (r === rr) { + return m; } else { - return /* Empty */0; + return bal$2(l, v, d, rr); } } @@ -2832,7 +2887,7 @@ function add_to_list$2(x, data, m) { function iter$2(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } iter$2(f, param.l); @@ -2843,13 +2898,14 @@ function iter$2(f, _param) { } function map$2(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const l$p = map$2(f, param.l); const d$p = Curry._1(f, param.d); const r$p = map$2(f, param.r); - return /* Node */{ + return { + TAG: /* Node */0, l: l$p, v: param.v, d: d$p, @@ -2859,14 +2915,15 @@ function map$2(f, param) { } function mapi$2(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param.v; const l$p = mapi$2(f, param.l); const d$p = Curry._2(f, v, param.d); const r$p = mapi$2(f, param.r); - return /* Node */{ + return { + TAG: /* Node */0, l: l$p, v: v, d: d$p, @@ -2879,7 +2936,7 @@ function fold$2(f, _m, _accu) { while(true) { const accu = _accu; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return accu; } _accu = Curry._3(f, m.v, m.d, fold$2(f, m.l, accu)); @@ -2891,7 +2948,7 @@ function fold$2(f, _m, _accu) { function for_all$2(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; } if (!Curry._2(p, param.v, param.d)) { @@ -2908,7 +2965,7 @@ function for_all$2(p, _param) { function exists$2(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } if (Curry._2(p, param.v, param.d)) { @@ -2923,30 +2980,30 @@ function exists$2(p, _param) { } function add_min_binding$2(k, x, param) { - if (param) { - return bal$2(add_min_binding$2(k, x, param.l), param.v, param.d, param.r); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton$2(k, x); + } else { + return bal$2(add_min_binding$2(k, x, param.l), param.v, param.d, param.r); } } function add_max_binding$2(k, x, param) { - if (param) { - return bal$2(param.l, param.v, param.d, add_max_binding$2(k, x, param.r)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton$2(k, x); + } else { + return bal$2(param.l, param.v, param.d, add_max_binding$2(k, x, param.r)); } } function join$2(l, v, d, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_binding$2(v, d, r); } - if (!r) { + const lh = l.h; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_binding$2(v, d, l); } const rh = r.h; - const lh = l.h; if (lh > (rh + 2 | 0)) { return bal$2(l.l, l.v, l.d, join$2(l.r, v, d, r)); } else if (rh > (lh + 2 | 0)) { @@ -2957,10 +3014,10 @@ function join$2(l, v, d, r) { } function concat$2(t1, t2) { - if (!t1) { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; } - if (!t2) { + if (/* tag */typeof t2 === "number" || typeof t2 === "string") { return t1; } const match = min_binding$2(t2); @@ -2976,7 +3033,7 @@ function concat_or_join$2(t1, v, d, t2) { } function split$2(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, undefined, @@ -3012,42 +3069,45 @@ function split$2(x, param) { } function merge$5(f, s1, s2) { - if (s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + return /* Empty */0; + } + + } else { const v1 = s1.v; if (s1.h >= height$2(s2)) { const match = split$2(v1, s2); return concat_or_join$2(merge$5(f, s1.l, match[0]), v1, Curry._3(f, v1, Caml_option.some(s1.d), match[1]), merge$5(f, s1.r, match[2])); } - } else if (!s2) { - return /* Empty */0; } - if (s2) { - const v2 = s2.v; - const match$1 = split$2(v2, s1); - return concat_or_join$2(merge$5(f, match$1[0], s2.l), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2.d)), merge$5(f, match$1[2], s2.r)); - } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/stdlib/map.ml", - 408, - 10 - ] - }); + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/stdlib/map.ml", + 408, + 10 + ] + }); + } + const v2 = s2.v; + const match$1 = split$2(v2, s1); + return concat_or_join$2(merge$5(f, match$1[0], s2.l), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2.d)), merge$5(f, match$1[2], s2.r)); } function union$2(f, s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return s2; } - if (!s2) { + const d1 = s1.d; + const v1 = s1.v; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const d2 = s2.d; const v2 = s2.v; - const d1 = s1.d; - const v1 = s1.v; if (s1.h >= s2.h) { const match = split$2(v1, s2); const d2$1 = match[1]; @@ -3071,7 +3131,7 @@ function union$2(f, s1, s2) { } function filter$2(p, m) { - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return /* Empty */0; } const r = m.r; @@ -3093,7 +3153,7 @@ function filter$2(p, m) { } function filter_map$2(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param.v; @@ -3108,7 +3168,7 @@ function filter_map$2(f, param) { } function partition$2(p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, /* Empty */0 @@ -3140,10 +3200,11 @@ function cons_enum$2(_m, _e) { while(true) { const e = _e; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: m.v, _1: m.d, _2: m.r, @@ -3160,14 +3221,14 @@ function compare$5(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return -1; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 0; + } else { + return -1; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 1; } const c = Curry._2(funarg$2.compare, e1._0, e2._0); @@ -3190,14 +3251,14 @@ function equal$2(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return false; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return true; + } else { + return false; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return false; } if (Curry._2(funarg$2.compare, e1._0, e2._0) !== 0) { @@ -3213,10 +3274,10 @@ function equal$2(cmp, m1, m2) { } function cardinal$2(param) { - if (param) { - return (cardinal$2(param.l) + 1 | 0) + cardinal$2(param.r) | 0; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return (cardinal$2(param.l) + 1 | 0) + cardinal$2(param.r) | 0; } } @@ -3224,7 +3285,7 @@ function bindings_aux$2(_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param.l; @@ -3260,11 +3321,12 @@ function of_seq$2(i) { } function seq_of_enum_$2(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = cons_enum$2(c._2, c._3); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: [ c._0, c._1 @@ -3286,10 +3348,11 @@ function snoc_enum$2(_s, _e) { while(true) { const e = _e; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: s.v, _1: s.d, _2: s.l, @@ -3301,11 +3364,12 @@ function snoc_enum$2(_s, _e) { } function rev_seq_of_enum_$2(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = snoc_enum$2(c._2, c._3); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: [ c._0, c._1 @@ -3328,7 +3392,7 @@ function to_seq_from$2(low, m) { while(true) { const c = _c; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return c; } const r = m.r; @@ -3336,7 +3400,8 @@ function to_seq_from$2(low, m) { const v = m.v; const n = Curry._2(funarg$2.compare, v, low); if (n === 0) { - return /* More */{ + return { + TAG: /* More */0, _0: v, _1: d, _2: r, @@ -3347,7 +3412,8 @@ function to_seq_from$2(low, m) { _m = r; continue ; } - _c = /* More */{ + _c = { + TAG: /* More */0, _0: v, _1: d, _2: r, @@ -3823,7 +3889,8 @@ function build_path(n, keys, tables) { }; let r = res; for(let i = 0; i <= n; ++i){ - r = /* Cons */{ + r = { + TAG: /* Cons */0, _0: Caml_array.get(keys, i), _1: r, _2: /* Empty */0 @@ -3848,7 +3915,8 @@ function lookup_keys(i, keys, tables) { _tables = tables$1.next; continue ; } - const next = /* Cons */{ + const next = { + TAG: /* Cons */0, _0: key, _1: /* Empty */0, _2: /* Empty */0 @@ -4026,7 +4094,7 @@ function method_impl(table, i, arr) { return Caml_array.get(arr, i.contents); }; const clo = next(undefined); - if (typeof clo !== "number") { + if (!/* tag */(typeof clo === "number" || typeof clo === "string")) { return clo; } switch (clo) { diff --git a/jscomp/test/dist/jscomp/test/test_per.js b/jscomp/test/dist/jscomp/test/test_per.js index d112ac908c..44bfe63f75 100644 --- a/jscomp/test/dist/jscomp/test/test_per.js +++ b/jscomp/test/dist/jscomp/test/test_per.js @@ -501,7 +501,8 @@ function string_of_format(param) { } function $caret$caret(param, param$1) { - return /* Format */{ + return { + TAG: /* Format */0, _0: CamlinternalFormatBasics.concat_fmt(param._0, param$1._0), _1: $caret(param._1, $caret("%,", param$1._1)) }; diff --git a/jscomp/test/dist/jscomp/test/test_set.js b/jscomp/test/dist/jscomp/test/test_set.js index a1e0d1a61a..25600db19e 100644 --- a/jscomp/test/dist/jscomp/test/test_set.js +++ b/jscomp/test/dist/jscomp/test/test_set.js @@ -8,16 +8,19 @@ const Stdlib__List = require("melange/list.js"); function Make(Ord) { const height = function (param) { - if (param) { - return param._3; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param._3; } }; const create = function (l, v, r) { - const hl = l ? l._3 : 0; - const hr = r ? r._3 : 0; - return /* Node */{ + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l._3; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r._3; + return { + TAG: /* Node */0, _0: l, _1: v, _2: r, @@ -25,60 +28,64 @@ function Make(Ord) { }; }; const bal = function (l, v, r) { - const hl = l ? l._3 : 0; - const hr = r ? r._3 : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l._3; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r._3; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l._2; - const lv = l._1; - const ll = l._0; - if (height(ll) >= height(lr)) { - return create(ll, lv, create(lr, v, r)); - } - if (lr) { - return create(create(ll, lv, lr._0), lr._1, create(lr._2, v, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const lr = l._2; + const lv = l._1; + const ll = l._0; + if (height(ll) >= height(lr)) { + return create(ll, lv, create(lr, v, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, lr._0), lr._1, create(lr._2, v, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, _0: l, _1: v, _2: r, _3: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r._2; - const rv = r._1; - const rl = r._0; - if (height(rr) >= height(rl)) { - return create(create(l, v, rl), rv, rr); - } - if (rl) { - return create(create(l, v, rl._0), rl._1, create(rl._2, rv, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const rr = r._2; + const rv = r._1; + const rl = r._0; + if (height(rr) >= height(rl)) { + return create(create(l, v, rl), rv, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, v, rl._0), rl._1, create(rl._2, rv, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); }; const add = function (x, t) { - if (!t) { - return /* Node */{ + if (/* tag */typeof t === "number" || typeof t === "string") { + return { + TAG: /* Node */0, _0: /* Empty */0, _1: x, _2: /* Empty */0, @@ -98,7 +105,8 @@ function Make(Ord) { } }; const singleton = function (x) { - return /* Node */{ + return { + TAG: /* Node */0, _0: /* Empty */0, _1: x, _2: /* Empty */0, @@ -106,28 +114,28 @@ function Make(Ord) { }; }; const add_min_element = function (v, param) { - if (param) { - return bal(add_min_element(v, param._0), param._1, param._2); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(v); + } else { + return bal(add_min_element(v, param._0), param._1, param._2); } }; const add_max_element = function (v, param) { - if (param) { - return bal(param._0, param._1, add_max_element(v, param._2)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(v); + } else { + return bal(param._0, param._1, add_max_element(v, param._2)); } }; const join = function (l, v, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_element(v, r); } - if (!r) { + const lh = l._3; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_element(v, l); } const rh = r._3; - const lh = l._3; if (lh > (rh + 2 | 0)) { return bal(l._0, l._1, join(l._2, v, r)); } else if (rh > (lh + 2 | 0)) { @@ -139,72 +147,69 @@ function Make(Ord) { const min_elt = function (_param) { while(true) { const param = _param; - if (param) { - const l = param._0; - if (!l) { - return param._1; - } - _param = l; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const l = param._0; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param._1; + } + _param = l; + continue ; }; }; const max_elt = function (_param) { while(true) { const param = _param; - if (param) { - if (!param._2) { - return param._1; - } - _param = param._2; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + let tmp = param._2; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return param._1; + } + _param = param._2; + continue ; }; }; const remove_min_elt = function (param) { - if (param) { - const l = param._0; - if (l) { - return bal(remove_min_elt(l), param._1, param._2); - } else { - return param._2; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Invalid_argument", { + MEL_EXN_ID: "Invalid_argument", + _1: "Set.remove_min_elt" + }); + } + const l = param._0; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param._2; + } else { + return bal(remove_min_elt(l), param._1, param._2); } - throw new Caml_js_exceptions.MelangeError("Invalid_argument", { - MEL_EXN_ID: "Invalid_argument", - _1: "Set.remove_min_elt" - }); }; const merge = function (t1, t2) { - if (t1) { - if (t2) { - return bal(t1, min_elt(t2), remove_min_elt(t2)); - } else { - return t1; - } - } else { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; + } else if (/* tag */typeof t2 === "number" || typeof t2 === "string") { + return t1; + } else { + return bal(t1, min_elt(t2), remove_min_elt(t2)); } }; const concat = function (t1, t2) { - if (t1) { - if (t2) { - return join(t1, min_elt(t2), remove_min_elt(t2)); - } else { - return t1; - } - } else { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; + } else if (/* tag */typeof t2 === "number" || typeof t2 === "string") { + return t1; + } else { + return join(t1, min_elt(t2), remove_min_elt(t2)); } }; const split = function (x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, false, @@ -238,16 +243,16 @@ function Make(Ord) { ]; }; const is_empty = function (param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } }; const mem = function (x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(Ord.compare, x, param._1); @@ -259,7 +264,7 @@ function Make(Ord) { }; }; const remove = function (x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const r = param._2; @@ -275,16 +280,16 @@ function Make(Ord) { } }; const union = function (s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return s2; } - if (!s2) { + const h1 = s1._3; + const v1 = s1._1; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const h2 = s2._3; const v2 = s2._1; - const h1 = s1._3; - const v1 = s1._1; if (h1 >= h2) { if (h2 === 1) { return add(v2, s1); @@ -299,10 +304,10 @@ function Make(Ord) { return join(union(match$1[0], s2._0), v2, union(match$1[2], s2._2)); }; const inter = function (s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return /* Empty */0; } - if (!s2) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return /* Empty */0; } const r1 = s1._2; @@ -317,10 +322,10 @@ function Make(Ord) { } }; const diff = function (s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return /* Empty */0; } - if (!s2) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const r1 = s1._2; @@ -338,10 +343,11 @@ function Make(Ord) { while(true) { const e = _e; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: s._1, _1: s._2, _2: e @@ -354,14 +360,14 @@ function Make(Ord) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return -1; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 0; + } else { + return -1; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 1; } const c = Curry._2(Ord.compare, e1._0, e2._0); @@ -383,17 +389,17 @@ function Make(Ord) { while(true) { const s2 = _s2; const s1 = _s1; - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return true; } - if (!s2) { + const r1 = s1._2; + const v1 = s1._1; + const l1 = s1._0; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return false; } const r2 = s2._2; const l2 = s2._0; - const r1 = s1._2; - const v1 = s1._1; - const l1 = s1._0; const c = Curry._2(Ord.compare, v1, s2._1); if (c === 0) { if (!subset(l1, l2)) { @@ -404,7 +410,8 @@ function Make(Ord) { continue ; } if (c < 0) { - if (!subset(/* Node */{ + if (!subset({ + TAG: /* Node */0, _0: l1, _1: v1, _2: /* Empty */0, @@ -415,7 +422,8 @@ function Make(Ord) { _s1 = r1; continue ; } - if (!subset(/* Node */{ + if (!subset({ + TAG: /* Node */0, _0: /* Empty */0, _1: v1, _2: r1, @@ -430,7 +438,7 @@ function Make(Ord) { const iter = function (f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } iter(f, param._0); @@ -443,7 +451,7 @@ function Make(Ord) { while(true) { const accu = _accu; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return accu; } _accu = Curry._2(f, s._1, fold(f, s._0, accu)); @@ -454,7 +462,7 @@ function Make(Ord) { const for_all = function (p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; } if (!Curry._1(p, param._1)) { @@ -470,7 +478,7 @@ function Make(Ord) { const exists = function (p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } if (Curry._1(p, param._1)) { @@ -484,7 +492,7 @@ function Make(Ord) { }; }; const filter = function (p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param._1; @@ -498,7 +506,7 @@ function Make(Ord) { } }; const partition = function (p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, /* Empty */0 @@ -525,17 +533,17 @@ function Make(Ord) { } }; const cardinal = function (param) { - if (param) { - return (cardinal(param._0) + 1 | 0) + cardinal(param._2) | 0; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return (cardinal(param._0) + 1 | 0) + cardinal(param._2) | 0; } }; const elements_aux = function (_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param._0; @@ -552,18 +560,18 @@ function Make(Ord) { const find = function (x, _param) { while(true) { const param = _param; - if (param) { - const v = param._1; - const c = Curry._2(Ord.compare, x, v); - if (c === 0) { - return v; - } - _param = c < 0 ? param._0 : param._2; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const v = param._1; + const c = Curry._2(Ord.compare, x, v); + if (c === 0) { + return v; + } + _param = c < 0 ? param._0 : param._2; + continue ; }; }; const of_sorted_list = function (l) { @@ -577,7 +585,8 @@ function Make(Ord) { case 1 : if (l) { return [ - /* Node */{ + { + TAG: /* Node */0, _0: /* Empty */0, _1: l.hd, _2: /* Empty */0, @@ -592,8 +601,10 @@ function Make(Ord) { const match = l.tl; if (match) { return [ - /* Node */{ - _0: /* Node */{ + { + TAG: /* Node */0, + _0: { + TAG: /* Node */0, _0: /* Empty */0, _1: l.hd, _2: /* Empty */0, @@ -616,15 +627,18 @@ function Make(Ord) { const match$2 = match$1.tl; if (match$2) { return [ - /* Node */{ - _0: /* Node */{ + { + TAG: /* Node */0, + _0: { + TAG: /* Node */0, _0: /* Empty */0, _1: l.hd, _2: /* Empty */0, _3: 1 }, _1: match$1.hd, - _2: /* Node */{ + _2: { + TAG: /* Node */0, _0: /* Empty */0, _1: match$2.hd, _2: /* Empty */0, diff --git a/jscomp/test/dist/jscomp/test/test_sprintf.js b/jscomp/test/dist/jscomp/test/test_sprintf.js index e80a4084e4..b157249608 100644 --- a/jscomp/test/dist/jscomp/test/test_sprintf.js +++ b/jscomp/test/dist/jscomp/test/test_sprintf.js @@ -4,7 +4,8 @@ const Curry = require("melange.js/curry.js"); const Stdlib__Printf = require("melange/printf.js"); -console.error(Curry._2(Stdlib__Printf.sprintf(/* Format */{ +console.error(Curry._2(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, diff --git a/jscomp/test/dist/jscomp/test/test_string_map.js b/jscomp/test/dist/jscomp/test/test_string_map.js index fac3158810..e985636d78 100644 --- a/jscomp/test/dist/jscomp/test/test_string_map.js +++ b/jscomp/test/dist/jscomp/test/test_string_map.js @@ -13,17 +13,18 @@ const funarg = { }; function height(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create(l, x, d, r) { const hl = height(l); const hr = height(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -33,32 +34,35 @@ function create(l, x, d, r) { } function bal(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height(ll) >= height(lr)) { - return create(ll, lv, ld, create(lr, x, d, r)); - } - if (lr) { - return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height(ll) >= height(lr)) { + return create(ll, lv, ld, create(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -66,22 +70,22 @@ function bal(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height(rr) >= height(rl)) { - return create(create(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height(rr) >= height(rl)) { + return create(create(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -89,8 +93,9 @@ function bal(l, x, d, r) { } function add(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -107,7 +112,8 @@ function add(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -135,17 +141,17 @@ function add(x, data, m) { function find(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(funarg.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(funarg.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } diff --git a/jscomp/test/dist/jscomp/test/test_switch.js b/jscomp/test/dist/jscomp/test/test_switch.js index e5f76b1b73..3b5afd98e4 100644 --- a/jscomp/test/dist/jscomp/test/test_switch.js +++ b/jscomp/test/dist/jscomp/test/test_switch.js @@ -4,14 +4,14 @@ const Curry = require("melange.js/curry.js"); function f(param) { - if (typeof param === "number") { + if (/* tag */typeof param === "number" || typeof param === "string") { if (param === /* G */0) { return 4; } else { return 5; } } - switch (param.TAG | 0) { + switch (param.TAG) { case /* A */0 : return 0; case /* B */1 : diff --git a/jscomp/test/dist/jscomp/test/test_trywith.js b/jscomp/test/dist/jscomp/test/test_trywith.js index 6845ce61f8..c29cc2a0e1 100644 --- a/jscomp/test/dist/jscomp/test/test_trywith.js +++ b/jscomp/test/dist/jscomp/test/test_trywith.js @@ -115,7 +115,7 @@ function u(param) { } function f(x) { - if (typeof x === "number") { + if (/* tag */typeof x === "number" || typeof x === "string") { return 2; } if (x.TAG === /* D */0) { diff --git a/jscomp/test/dist/jscomp/test/testing.js b/jscomp/test/dist/jscomp/test/testing.js index 385f7eedee..96d735825a 100644 --- a/jscomp/test/dist/jscomp/test/testing.js +++ b/jscomp/test/dist/jscomp/test/testing.js @@ -36,7 +36,8 @@ function print_test_number(param) { function print_failure_test_fail(param) { all_tests_ok.contents = false; - Stdlib.print_string(Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Stdlib.print_string(Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "\n********* Failure Test number ", @@ -58,7 +59,8 @@ function print_failure_test_fail(param) { function print_failure_test_succeed(param) { all_tests_ok.contents = false; - Stdlib.print_string(Curry._1(Stdlib__Printf.sprintf(/* Format */{ + Stdlib.print_string(Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "\n********* Failure Test number ", @@ -83,7 +85,8 @@ function test(b) { print_test_number(undefined); if (!b) { all_tests_ok.contents = false; - return Stdlib.print_string(Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Stdlib.print_string(Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "\n********* Test number ", diff --git a/jscomp/test/dist/jscomp/test/tfloat_record_test.js b/jscomp/test/dist/jscomp/test/tfloat_record_test.js index 51e641fd91..777421f76e 100644 --- a/jscomp/test/dist/jscomp/test/tfloat_record_test.js +++ b/jscomp/test/dist/jscomp/test/tfloat_record_test.js @@ -15,7 +15,8 @@ const buf = Stdlib__Buffer.create(50); const fmt = Stdlib__Format.formatter_of_buffer(buf); function print_float(f) { - Curry._1(Stdlib__Format.fprintf(fmt)(/* Format */{ + Curry._1(Stdlib__Format.fprintf(fmt)({ + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -26,7 +27,8 @@ function print_float(f) { } function print_newline(param) { - Stdlib__Format.fprintf(fmt)(/* Format */{ + Stdlib__Format.fprintf(fmt)({ + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '\n' */10, diff --git a/jscomp/test/dist/jscomp/test/ticker.js b/jscomp/test/dist/jscomp/test/ticker.js index d98f5d3ddf..556873f068 100644 --- a/jscomp/test/dist/jscomp/test/ticker.js +++ b/jscomp/test/dist/jscomp/test/ticker.js @@ -70,14 +70,15 @@ const Util = { }; function string_of_rank(i) { - if (typeof i === "number") { - if (i) { - return "Visited"; - } else { + if (/* tag */typeof i === "number" || typeof i === "string") { + if (i === /* Uninitialized */0) { return "Uninitialized"; + } else { + return "Visited"; } } else { - return Curry._1(Stdlib__Printf.sprintf(/* Format */{ + return Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Ranked(", @@ -106,11 +107,11 @@ function find_ticker_by_name(all_tickers, ticker) { function print_all_composite(all_tickers) { Stdlib__List.iter((function (param) { - if (param.type_) { - console.log(param.ticker_name); + let tmp = param.type_; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { return ; } - + console.log(param.ticker_name); }), all_tickers); } @@ -121,17 +122,18 @@ const funarg = { }; function height(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create(l, x, d, r) { const hl = height(l); const hr = height(r); - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -141,7 +143,8 @@ function create(l, x, d, r) { } function singleton(x, d) { - return /* Node */{ + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: d, @@ -151,32 +154,35 @@ function singleton(x, d) { } function bal(l, x, d, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const ld = l.d; - const lv = l.v; - const ll = l.l; - if (height(ll) >= height(lr)) { - return create(ll, lv, ld, create(lr, x, d, r)); - } - if (lr) { - return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const lr = l.r; + const ld = l.d; + const lv = l.v; + const ll = l.l; + if (height(ll) >= height(lr)) { + return create(ll, lv, ld, create(lr, x, d, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, ld, lr.l), lr.v, lr.d, create(lr.r, x, d, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: d, @@ -184,22 +190,22 @@ function bal(l, x, d, r) { h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rd = r.d; - const rv = r.v; - const rl = r.l; - if (height(rr) >= height(rl)) { - return create(create(l, x, d, rl), rv, rd, rr); - } - if (rl) { - return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" }); } + const rr = r.r; + const rd = r.d; + const rv = r.v; + const rl = r.l; + if (height(rr) >= height(rl)) { + return create(create(l, x, d, rl), rv, rd, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, x, d, rl.l), rl.v, rl.d, create(rl.r, rv, rd, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Map.bal" @@ -207,16 +213,17 @@ function bal(l, x, d, r) { } function is_empty(param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } } function add(x, data, m) { - if (!m) { - return /* Node */{ + if (/* tag */typeof m === "number" || typeof m === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, d: data, @@ -233,7 +240,8 @@ function add(x, data, m) { if (d === data) { return m; } else { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: x, d: data, @@ -261,63 +269,63 @@ function add(x, data, m) { function find(x, _param) { while(true) { const param = _param; - if (param) { - const c = Curry._2(funarg.compare, x, param.v); - if (c === 0) { - return param.d; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const c = Curry._2(funarg.compare, x, param.v); + if (c === 0) { + return param.d; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } function find_first(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _d0 = param.d; - let _param$1 = param.l; - while(true) { - const param$1 = _param$1; - const d0 = _d0; - const v0 = _v0; - if (!param$1) { - return [ - v0, - d0 - ]; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.l; - _d0 = param$1.d; - _v0 = v$1; - continue ; - } - _param$1 = param$1.r; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _d0 = param.d; + let _param$1 = param.l; + while(true) { + const param$1 = _param$1; + const d0 = _d0; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return [ + v0, + d0 + ]; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.l; + _d0 = param$1.d; + _v0 = v$1; continue ; - }; - } - _param = param.r; - continue ; + } + _param$1 = param$1.r; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.r; + continue ; }; } function find_first_opt(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -329,7 +337,7 @@ function find_first_opt(f, _param) { const param$1 = _param$1; const d0 = _d0; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return [ v0, d0 @@ -354,46 +362,46 @@ function find_first_opt(f, _param) { function find_last(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _d0 = param.d; - let _param$1 = param.r; - while(true) { - const param$1 = _param$1; - const d0 = _d0; - const v0 = _v0; - if (!param$1) { - return [ - v0, - d0 - ]; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.r; - _d0 = param$1.d; - _v0 = v$1; - continue ; - } - _param$1 = param$1.l; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _d0 = param.d; + let _param$1 = param.r; + while(true) { + const param$1 = _param$1; + const d0 = _d0; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return [ + v0, + d0 + ]; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.r; + _d0 = param$1.d; + _v0 = v$1; continue ; - }; - } - _param = param.l; - continue ; + } + _param$1 = param$1.l; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.l; + continue ; }; } function find_last_opt(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -405,7 +413,7 @@ function find_last_opt(f, _param) { const param$1 = _param$1; const d0 = _d0; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return [ v0, d0 @@ -430,7 +438,7 @@ function find_last_opt(f, _param) { function find_opt(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const c = Curry._2(funarg.compare, x, param.v); @@ -445,7 +453,7 @@ function find_opt(x, _param) { function mem(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(funarg.compare, x, param.v); @@ -460,31 +468,31 @@ function mem(x, _param) { function min_binding(_param) { while(true) { const param = _param; - if (param) { - const l = param.l; - if (!l) { - return [ - param.v, - param.d - ]; - } - _param = l; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return [ + param.v, + param.d + ]; + } + _param = l; + continue ; }; } function min_binding_opt(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const l = param.l; - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return [ param.v, param.d @@ -498,29 +506,31 @@ function min_binding_opt(_param) { function max_binding(_param) { while(true) { const param = _param; - if (param) { - if (!param.r) { - return [ - param.v, - param.d - ]; - } - _param = param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return [ + param.v, + param.d + ]; + } + _param = param.r; + continue ; }; } function max_binding_opt(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } - if (!param.r) { + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { return [ param.v, param.d @@ -532,25 +542,25 @@ function max_binding_opt(_param) { } function remove_min_binding(param) { - if (param) { - const l = param.l; - if (l) { - return bal(remove_min_binding(l), param.v, param.d, param.r); - } else { - return param.r; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Invalid_argument", { + MEL_EXN_ID: "Invalid_argument", + _1: "Map.remove_min_elt" + }); + } + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param.r; + } else { + return bal(remove_min_binding(l), param.v, param.d, param.r); } - throw new Caml_js_exceptions.MelangeError("Invalid_argument", { - MEL_EXN_ID: "Invalid_argument", - _1: "Map.remove_min_elt" - }); } function merge(t1, t2) { - if (!t1) { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; } - if (!t2) { + if (/* tag */typeof t2 === "number" || typeof t2 === "string") { return t1; } const match = min_binding(t2); @@ -558,7 +568,7 @@ function merge(t1, t2) { } function remove(x, m) { - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return /* Empty */0; } const r = m.r; @@ -586,56 +596,58 @@ function remove(x, m) { } function update(x, f, m) { - if (m) { - const r = m.r; - const d = m.d; - const v = m.v; - const l = m.l; - const c = Curry._2(funarg.compare, x, v); - if (c === 0) { - const data = Curry._1(f, Caml_option.some(d)); - if (data === undefined) { - return merge(l, r); - } - const data$1 = Caml_option.valFromOption(data); - if (d === data$1) { - return m; - } else { - return /* Node */{ - l: l, - v: x, - d: data$1, - r: r, - h: m.h - }; - } + if (/* tag */typeof m === "number" || typeof m === "string") { + const data = Curry._1(f, undefined); + if (data !== undefined) { + return { + TAG: /* Node */0, + l: /* Empty */0, + v: x, + d: Caml_option.valFromOption(data), + r: /* Empty */0, + h: 1 + }; + } else { + return /* Empty */0; } - if (c < 0) { - const ll = update(x, f, l); - if (l === ll) { - return m; - } else { - return bal(ll, v, d, r); - } + } + const r = m.r; + const d = m.d; + const v = m.v; + const l = m.l; + const c = Curry._2(funarg.compare, x, v); + if (c === 0) { + const data$1 = Curry._1(f, Caml_option.some(d)); + if (data$1 === undefined) { + return merge(l, r); } - const rr = update(x, f, r); - if (r === rr) { + const data$2 = Caml_option.valFromOption(data$1); + if (d === data$2) { return m; } else { - return bal(l, v, d, rr); + return { + TAG: /* Node */0, + l: l, + v: x, + d: data$2, + r: r, + h: m.h + }; } } - const data$2 = Curry._1(f, undefined); - if (data$2 !== undefined) { - return /* Node */{ - l: /* Empty */0, - v: x, - d: Caml_option.valFromOption(data$2), - r: /* Empty */0, - h: 1 - }; + if (c < 0) { + const ll = update(x, f, l); + if (l === ll) { + return m; + } else { + return bal(ll, v, d, r); + } + } + const rr = update(x, f, r); + if (r === rr) { + return m; } else { - return /* Empty */0; + return bal(l, v, d, rr); } } @@ -659,7 +671,7 @@ function add_to_list(x, data, m) { function iter(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } iter(f, param.l); @@ -670,13 +682,14 @@ function iter(f, _param) { } function map(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const l$p = map(f, param.l); const d$p = Curry._1(f, param.d); const r$p = map(f, param.r); - return /* Node */{ + return { + TAG: /* Node */0, l: l$p, v: param.v, d: d$p, @@ -686,14 +699,15 @@ function map(f, param) { } function mapi(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param.v; const l$p = mapi(f, param.l); const d$p = Curry._2(f, v, param.d); const r$p = mapi(f, param.r); - return /* Node */{ + return { + TAG: /* Node */0, l: l$p, v: v, d: d$p, @@ -706,7 +720,7 @@ function fold(f, _m, _accu) { while(true) { const accu = _accu; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return accu; } _accu = Curry._3(f, m.v, m.d, fold(f, m.l, accu)); @@ -718,7 +732,7 @@ function fold(f, _m, _accu) { function for_all(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; } if (!Curry._2(p, param.v, param.d)) { @@ -735,7 +749,7 @@ function for_all(p, _param) { function exists(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } if (Curry._2(p, param.v, param.d)) { @@ -750,30 +764,30 @@ function exists(p, _param) { } function add_min_binding(k, x, param) { - if (param) { - return bal(add_min_binding(k, x, param.l), param.v, param.d, param.r); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(k, x); + } else { + return bal(add_min_binding(k, x, param.l), param.v, param.d, param.r); } } function add_max_binding(k, x, param) { - if (param) { - return bal(param.l, param.v, param.d, add_max_binding(k, x, param.r)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(k, x); + } else { + return bal(param.l, param.v, param.d, add_max_binding(k, x, param.r)); } } function join(l, v, d, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_binding(v, d, r); } - if (!r) { + const lh = l.h; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_binding(v, d, l); } const rh = r.h; - const lh = l.h; if (lh > (rh + 2 | 0)) { return bal(l.l, l.v, l.d, join(l.r, v, d, r)); } else if (rh > (lh + 2 | 0)) { @@ -784,10 +798,10 @@ function join(l, v, d, r) { } function concat(t1, t2) { - if (!t1) { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; } - if (!t2) { + if (/* tag */typeof t2 === "number" || typeof t2 === "string") { return t1; } const match = min_binding(t2); @@ -803,7 +817,7 @@ function concat_or_join(t1, v, d, t2) { } function split$1(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, undefined, @@ -839,42 +853,45 @@ function split$1(x, param) { } function merge$1(f, s1, s2) { - if (s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + return /* Empty */0; + } + + } else { const v1 = s1.v; if (s1.h >= height(s2)) { const match = split$1(v1, s2); return concat_or_join(merge$1(f, s1.l, match[0]), v1, Curry._3(f, v1, Caml_option.some(s1.d), match[1]), merge$1(f, s1.r, match[2])); } - } else if (!s2) { - return /* Empty */0; } - if (s2) { - const v2 = s2.v; - const match$1 = split$1(v2, s1); - return concat_or_join(merge$1(f, match$1[0], s2.l), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2.d)), merge$1(f, match$1[2], s2.r)); + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { + throw new Caml_js_exceptions.MelangeError("Assert_failure", { + MEL_EXN_ID: "Assert_failure", + _1: [ + "jscomp/stdlib/map.ml", + 408, + 10 + ] + }); } - throw new Caml_js_exceptions.MelangeError("Assert_failure", { - MEL_EXN_ID: "Assert_failure", - _1: [ - "jscomp/stdlib/map.ml", - 408, - 10 - ] - }); + const v2 = s2.v; + const match$1 = split$1(v2, s1); + return concat_or_join(merge$1(f, match$1[0], s2.l), v2, Curry._3(f, v2, match$1[1], Caml_option.some(s2.d)), merge$1(f, match$1[2], s2.r)); } function union(f, s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return s2; } - if (!s2) { + const d1 = s1.d; + const v1 = s1.v; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const d2 = s2.d; const v2 = s2.v; - const d1 = s1.d; - const v1 = s1.v; if (s1.h >= s2.h) { const match = split$1(v1, s2); const d2$1 = match[1]; @@ -898,7 +915,7 @@ function union(f, s1, s2) { } function filter(p, m) { - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return /* Empty */0; } const r = m.r; @@ -920,7 +937,7 @@ function filter(p, m) { } function filter_map(f, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return /* Empty */0; } const v = param.v; @@ -935,7 +952,7 @@ function filter_map(f, param) { } function partition(p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, /* Empty */0 @@ -967,10 +984,11 @@ function cons_enum(_m, _e) { while(true) { const e = _e; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: m.v, _1: m.d, _2: m.r, @@ -987,14 +1005,14 @@ function compare$1(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return -1; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 0; + } else { + return -1; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 1; } const c = Curry._2(funarg.compare, e1._0, e2._0); @@ -1017,14 +1035,14 @@ function equal(cmp, m1, m2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return false; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return true; + } else { + return false; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return false; } if (Curry._2(funarg.compare, e1._0, e2._0) !== 0) { @@ -1040,10 +1058,10 @@ function equal(cmp, m1, m2) { } function cardinal(param) { - if (param) { - return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; } } @@ -1051,7 +1069,7 @@ function bindings_aux(_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param.l; @@ -1087,11 +1105,12 @@ function of_seq(i) { } function seq_of_enum_(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = cons_enum(c._2, c._3); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: [ c._0, c._1 @@ -1113,10 +1132,11 @@ function snoc_enum(_s, _e) { while(true) { const e = _e; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: s.v, _1: s.d, _2: s.l, @@ -1128,11 +1148,12 @@ function snoc_enum(_s, _e) { } function rev_seq_of_enum_(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = snoc_enum(c._2, c._3); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: [ c._0, c._1 @@ -1155,7 +1176,7 @@ function to_seq_from(low, m) { while(true) { const c = _c; const m = _m; - if (!m) { + if (/* tag */typeof m === "number" || typeof m === "string") { return c; } const r = m.r; @@ -1163,7 +1184,8 @@ function to_seq_from(low, m) { const v = m.v; const n = Curry._2(funarg.compare, v, low); if (n === 0) { - return /* More */{ + return { + TAG: /* More */0, _0: v, _1: d, _2: r, @@ -1174,7 +1196,8 @@ function to_seq_from(low, m) { _m = r; continue ; } - _c = /* More */{ + _c = { + TAG: /* More */0, _0: v, _1: d, _2: r, @@ -1240,26 +1263,28 @@ function compute_update_sequences(all_tickers) { Stdlib__List.fold_left((function (counter, ticker) { const loop = function (counter, ticker) { const rank = ticker.rank; - if (typeof rank !== "number") { + if (!/* tag */(typeof rank === "number" || typeof rank === "string")) { return counter; } - if (rank) { + if (rank !== /* Uninitialized */0) { return counter; } ticker.rank = /* Visited */1; const match = ticker.type_; - if (match) { - const match$1 = match._0; - const counter$1 = loop(counter, match$1.lhs); - const counter$2 = loop(counter$1, match$1.rhs); - const counter$3 = counter$2 + 1 | 0; - ticker.rank = /* Ranked */{ - _0: counter$3 + if (/* tag */typeof match === "number" || typeof match === "string") { + const counter$1 = counter + 1 | 0; + ticker.rank = { + TAG: /* Ranked */0, + _0: counter$1 }; - return counter$3; + return counter$1; } - const counter$4 = counter + 1 | 0; - ticker.rank = /* Ranked */{ + const match$1 = match._0; + const counter$2 = loop(counter, match$1.lhs); + const counter$3 = loop(counter$2, match$1.rhs); + const counter$4 = counter$3 + 1 | 0; + ticker.rank = { + TAG: /* Ranked */0, _0: counter$4 }; return counter$4; @@ -1267,7 +1292,8 @@ function compute_update_sequences(all_tickers) { return loop(counter, ticker); }), 0, all_tickers); const map = Stdlib__List.fold_left((function (map, ticker) { - if (!ticker.type_) { + let tmp = ticker.type_; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { return Curry._3(add, ticker.ticker_name, { hd: ticker, tl: /* [] */0 @@ -1280,22 +1306,22 @@ function compute_update_sequences(all_tickers) { const up = _up; const type_ = ticker.type_; const ticker_name = ticker.ticker_name; - if (type_) { - const match = type_._0; - const map$1 = loop({ - hd: ticker, - tl: up - }, map, match.lhs); - _ticker = match.rhs; - _map = map$1; - _up = { - hd: ticker, - tl: up - }; - continue ; + if (/* tag */typeof type_ === "number" || typeof type_ === "string") { + const l = Curry._2(find, ticker_name, map); + return Curry._3(add, ticker_name, Stdlib.$at(up, l), map); } - const l = Curry._2(find, ticker_name, map); - return Curry._3(add, ticker_name, Stdlib.$at(up, l), map); + const match = type_._0; + const map$1 = loop({ + hd: ticker, + tl: up + }, map, match.lhs); + _ticker = match.rhs; + _map = map$1; + _up = { + hd: ticker, + tl: up + }; + continue ; }; }; return loop(/* [] */0, map, ticker); @@ -1303,20 +1329,33 @@ function compute_update_sequences(all_tickers) { return Curry._3(fold, (function (k, l, map) { const l$1 = Stdlib__List.sort_uniq((function (lhs, rhs) { const x = lhs.rank; - if (typeof x === "number") { + if (/* tag */typeof x === "number" || typeof x === "string") { + if (x === /* Uninitialized */0) { + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "All nodes should be ranked" + }); + } throw new Caml_js_exceptions.MelangeError("Failure", { MEL_EXN_ID: "Failure", _1: "All nodes should be ranked" }); - } - const y = rhs.rank; - if (typeof y === "number") { + } else { + const y = rhs.rank; + if (!/* tag */(typeof y === "number" || typeof y === "string")) { + return Caml.caml_int_compare(x._0, y._0); + } + if (y === /* Uninitialized */0) { + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "All nodes should be ranked" + }); + } throw new Caml_js_exceptions.MelangeError("Failure", { MEL_EXN_ID: "Failure", _1: "All nodes should be ranked" }); } - return Caml.caml_int_compare(x._0, y._0); }), l); return Curry._3(add, k, l$1, map); }), map, map); @@ -1326,24 +1365,23 @@ function process_quote(ticker_map, new_ticker, new_value) { const update_sequence = Curry._2(find, new_ticker, ticker_map); Stdlib__List.iter((function (ticker) { const match = ticker.type_; - if (match) { - const match$1 = match._0; - const match$2 = match$1.lhs.value; - const match$3 = match$1.rhs.value; - const value = match$2 !== undefined && match$3 !== undefined ? ( - match$1.op ? match$2 - match$3 : match$2 + match$3 - ) : undefined; - ticker.value = value; - return ; - } - if (ticker.ticker_name === new_ticker) { - ticker.value = new_value; - return ; + if (/* tag */typeof match === "number" || typeof match === "string") { + if (ticker.ticker_name === new_ticker) { + ticker.value = new_value; + return ; + } + throw new Caml_js_exceptions.MelangeError("Failure", { + MEL_EXN_ID: "Failure", + _1: "Only single Market ticker should be udpated upon a new quote" + }); } - throw new Caml_js_exceptions.MelangeError("Failure", { - MEL_EXN_ID: "Failure", - _1: "Only single Market ticker should be udpated upon a new quote" - }); + const match$1 = match._0; + const match$2 = match$1.lhs.value; + const match$3 = match$1.rhs.value; + const value = match$2 !== undefined && match$3 !== undefined ? ( + match$1.op === /* PLUS */0 ? match$2 + match$3 : match$2 - match$3 + ) : undefined; + ticker.value = value; }), update_sequence); } @@ -1355,7 +1393,8 @@ function process_input_line(ticker_map, all_tickers, line) { value: undefined, rank: /* Uninitialized */0, ticker_name: ticker_name, - type_: /* Binary_op */{ + type_: { + TAG: /* Binary_op */0, _0: { op: op, rhs: rhs$1, diff --git a/jscomp/test/dist/jscomp/test/topsort_test.js b/jscomp/test/dist/jscomp/test/topsort_test.js index 8c1d9f8980..5f911b5d5f 100644 --- a/jscomp/test/dist/jscomp/test/topsort_test.js +++ b/jscomp/test/dist/jscomp/test/topsort_test.js @@ -449,17 +449,20 @@ const funarg = { }; function height(param) { - if (param) { - return param.h; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return param.h; } } function create(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; - return /* Node */{ + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; + return { + TAG: /* Node */0, l: l, v: v, r: r, @@ -468,52 +471,55 @@ function create(l, v, r) { } function bal(l, v, r) { - const hl = l ? l.h : 0; - const hr = r ? r.h : 0; + let hl; + hl = /* tag */typeof l === "number" || typeof l === "string" ? 0 : l.h; + let hr; + hr = /* tag */typeof r === "number" || typeof r === "string" ? 0 : r.h; if (hl > (hr + 2 | 0)) { - if (l) { - const lr = l.r; - const lv = l.v; - const ll = l.l; - if (height(ll) >= height(lr)) { - return create(ll, lv, create(lr, v, r)); - } - if (lr) { - return create(create(ll, lv, lr.l), lr.v, create(lr.r, v, r)); - } + if (/* tag */typeof l === "number" || typeof l === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const lr = l.r; + const lv = l.v; + const ll = l.l; + if (height(ll) >= height(lr)) { + return create(ll, lv, create(lr, v, r)); + } + if (!/* tag */(typeof lr === "number" || typeof lr === "string")) { + return create(create(ll, lv, lr.l), lr.v, create(lr.r, v, r)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } if (hr <= (hl + 2 | 0)) { - return /* Node */{ + return { + TAG: /* Node */0, l: l, v: v, r: r, h: hl >= hr ? hl + 1 | 0 : hr + 1 | 0 }; } - if (r) { - const rr = r.r; - const rv = r.v; - const rl = r.l; - if (height(rr) >= height(rl)) { - return create(create(l, v, rl), rv, rr); - } - if (rl) { - return create(create(l, v, rl.l), rl.v, create(rl.r, rv, rr)); - } + if (/* tag */typeof r === "number" || typeof r === "string") { throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" }); } + const rr = r.r; + const rv = r.v; + const rl = r.l; + if (height(rr) >= height(rl)) { + return create(create(l, v, rl), rv, rr); + } + if (!/* tag */(typeof rl === "number" || typeof rl === "string")) { + return create(create(l, v, rl.l), rl.v, create(rl.r, rv, rr)); + } throw new Caml_js_exceptions.MelangeError("Invalid_argument", { MEL_EXN_ID: "Invalid_argument", _1: "Set.bal" @@ -521,8 +527,9 @@ function bal(l, v, r) { } function add(x, t) { - if (!t) { - return /* Node */{ + if (/* tag */typeof t === "number" || typeof t === "string") { + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -553,7 +560,8 @@ function add(x, t) { } function singleton(x) { - return /* Node */{ + return { + TAG: /* Node */0, l: /* Empty */0, v: x, r: /* Empty */0, @@ -562,30 +570,30 @@ function singleton(x) { } function add_min_element(x, param) { - if (param) { - return bal(add_min_element(x, param.l), param.v, param.r); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(x); + } else { + return bal(add_min_element(x, param.l), param.v, param.r); } } function add_max_element(x, param) { - if (param) { - return bal(param.l, param.v, add_max_element(x, param.r)); - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return singleton(x); + } else { + return bal(param.l, param.v, add_max_element(x, param.r)); } } function join(l, v, r) { - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return add_min_element(v, r); } - if (!r) { + const lh = l.h; + if (/* tag */typeof r === "number" || typeof r === "string") { return add_max_element(v, l); } const rh = r.h; - const lh = l.h; if (lh > (rh + 2 | 0)) { return bal(l.l, l.v, join(l.r, v, r)); } else if (rh > (lh + 2 | 0)) { @@ -598,28 +606,28 @@ function join(l, v, r) { function min_elt(_param) { while(true) { const param = _param; - if (param) { - const l = param.l; - if (!l) { - return param.v; - } - _param = l; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param.v; + } + _param = l; + continue ; }; } function min_elt_opt(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const l = param.l; - if (!l) { + if (/* tag */typeof l === "number" || typeof l === "string") { return Caml_option.some(param.v); } _param = l; @@ -630,26 +638,28 @@ function min_elt_opt(_param) { function max_elt(_param) { while(true) { const param = _param; - if (param) { - if (!param.r) { - return param.v; - } - _param = param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return param.v; + } + _param = param.r; + continue ; }; } function max_elt_opt(_param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } - if (!param.r) { + let tmp = param.r; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { return Caml_option.some(param.v); } _param = param.r; @@ -658,34 +668,32 @@ function max_elt_opt(_param) { } function remove_min_elt(param) { - if (param) { - const l = param.l; - if (l) { - return bal(remove_min_elt(l), param.v, param.r); - } else { - return param.r; - } + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError("Invalid_argument", { + MEL_EXN_ID: "Invalid_argument", + _1: "Set.remove_min_elt" + }); + } + const l = param.l; + if (/* tag */typeof l === "number" || typeof l === "string") { + return param.r; + } else { + return bal(remove_min_elt(l), param.v, param.r); } - throw new Caml_js_exceptions.MelangeError("Invalid_argument", { - MEL_EXN_ID: "Invalid_argument", - _1: "Set.remove_min_elt" - }); } function concat(t1, t2) { - if (t1) { - if (t2) { - return join(t1, min_elt(t2), remove_min_elt(t2)); - } else { - return t1; - } - } else { + if (/* tag */typeof t1 === "number" || typeof t1 === "string") { return t2; + } else if (/* tag */typeof t2 === "number" || typeof t2 === "string") { + return t1; + } else { + return join(t1, min_elt(t2), remove_min_elt(t2)); } } function split(x, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, false, @@ -720,17 +728,17 @@ function split(x, param) { } function is_empty(param) { - if (param) { - return false; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; + } else { + return false; } } function mem(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } const c = Curry._2(funarg.compare, x, param.v); @@ -743,7 +751,7 @@ function mem(x, _param) { } function remove(x, t) { - if (!t) { + if (/* tag */typeof t === "number" || typeof t === "string") { return /* Empty */0; } const r = t.r; @@ -751,14 +759,12 @@ function remove(x, t) { const l = t.l; const c = Curry._2(funarg.compare, x, v); if (c === 0) { - if (l) { - if (r) { - return bal(l, min_elt(r), remove_min_elt(r)); - } else { - return l; - } - } else { + if (/* tag */typeof l === "number" || typeof l === "string") { return r; + } else if (/* tag */typeof r === "number" || typeof r === "string") { + return l; + } else { + return bal(l, min_elt(r), remove_min_elt(r)); } } if (c < 0) { @@ -778,16 +784,16 @@ function remove(x, t) { } function union(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return s2; } - if (!s2) { + const h1 = s1.h; + const v1 = s1.v; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const h2 = s2.h; const v2 = s2.v; - const h1 = s1.h; - const v1 = s1.v; if (h1 >= h2) { if (h2 === 1) { return add(v2, s1); @@ -803,10 +809,10 @@ function union(s1, s2) { } function inter(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return /* Empty */0; } - if (!s2) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return /* Empty */0; } const r1 = s1.r; @@ -822,8 +828,9 @@ function inter(s1, s2) { } function split_bis(x, param) { - if (!param) { - return /* NotFound */{ + if (/* tag */typeof param === "number" || typeof param === "string") { + return { + TAG: /* NotFound */0, _0: /* Empty */0, _1: (function (param) { return /* Empty */0; @@ -839,11 +846,12 @@ function split_bis(x, param) { } if (c < 0) { const match = split_bis(x, l); - if (!match) { + if (/* tag */typeof match === "number" || typeof match === "string") { return /* Found */0; } const rl = match._1; - return /* NotFound */{ + return { + TAG: /* NotFound */0, _0: match._0, _1: (function (param) { return join(Curry._1(rl, undefined), v, r); @@ -851,13 +859,14 @@ function split_bis(x, param) { }; } const match$1 = split_bis(x, r); - if (match$1) { - return /* NotFound */{ + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { + return /* Found */0; + } else { + return { + TAG: /* NotFound */0, _0: join(l, v, match$1._0), _1: match$1._1 }; - } else { - return /* Found */0; } } @@ -865,17 +874,17 @@ function disjoint(_s1, _s2) { while(true) { const s2 = _s2; const s1 = _s1; - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return true; } - if (!s2) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return true; } if (s1 === s2) { return false; } const match = split_bis(s1.v, s2); - if (!match) { + if (/* tag */typeof match === "number" || typeof match === "string") { return false; } if (!disjoint(s1.l, match._0)) { @@ -888,10 +897,10 @@ function disjoint(_s1, _s2) { } function diff(s1, s2) { - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return /* Empty */0; } - if (!s2) { + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return s1; } const r1 = s1.r; @@ -910,10 +919,11 @@ function cons_enum(_s, _e) { while(true) { const e = _e; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: s.v, _1: s.r, _2: e @@ -929,14 +939,14 @@ function compare(s1, s2) { while(true) { const e2 = _e2; const e1 = _e1; - if (!e1) { - if (e2) { - return -1; - } else { + if (/* tag */typeof e1 === "number" || typeof e1 === "string") { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 0; + } else { + return -1; } } - if (!e2) { + if (/* tag */typeof e2 === "number" || typeof e2 === "string") { return 1; } const c = Curry._2(funarg.compare, e1._0, e2._0); @@ -957,17 +967,17 @@ function subset(_s1, _s2) { while(true) { const s2 = _s2; const s1 = _s1; - if (!s1) { + if (/* tag */typeof s1 === "number" || typeof s1 === "string") { return true; } - if (!s2) { + const r1 = s1.r; + const v1 = s1.v; + const l1 = s1.l; + if (/* tag */typeof s2 === "number" || typeof s2 === "string") { return false; } const r2 = s2.r; const l2 = s2.l; - const r1 = s1.r; - const v1 = s1.v; - const l1 = s1.l; const c = Curry._2(funarg.compare, v1, s2.v); if (c === 0) { if (!subset(l1, l2)) { @@ -978,7 +988,8 @@ function subset(_s1, _s2) { continue ; } if (c < 0) { - if (!subset(/* Node */{ + if (!subset({ + TAG: /* Node */0, l: l1, v: v1, r: /* Empty */0, @@ -989,7 +1000,8 @@ function subset(_s1, _s2) { _s1 = r1; continue ; } - if (!subset(/* Node */{ + if (!subset({ + TAG: /* Node */0, l: /* Empty */0, v: v1, r: r1, @@ -1005,7 +1017,7 @@ function subset(_s1, _s2) { function iter(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } iter(f, param.l); @@ -1019,7 +1031,7 @@ function fold(f, _s, _accu) { while(true) { const accu = _accu; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return accu; } _accu = Curry._2(f, s.v, fold(f, s.l, accu)); @@ -1031,7 +1043,7 @@ function fold(f, _s, _accu) { function for_all(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return true; } if (!Curry._1(p, param.v)) { @@ -1048,7 +1060,7 @@ function for_all(p, _param) { function exists(p, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return false; } if (Curry._1(p, param.v)) { @@ -1063,7 +1075,7 @@ function exists(p, _param) { } function filter(p, t) { - if (!t) { + if (/* tag */typeof t === "number" || typeof t === "string") { return /* Empty */0; } const r = t.r; @@ -1084,7 +1096,7 @@ function filter(p, t) { } function partition(p, param) { - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return [ /* Empty */0, /* Empty */0 @@ -1112,10 +1124,10 @@ function partition(p, param) { } function cardinal(param) { - if (param) { - return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; - } else { + if (/* tag */typeof param === "number" || typeof param === "string") { return 0; + } else { + return (cardinal(param.l) + 1 | 0) + cardinal(param.r) | 0; } } @@ -1123,7 +1135,7 @@ function elements_aux(_accu, _param) { while(true) { const param = _param; const accu = _accu; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return accu; } _param = param.l; @@ -1142,58 +1154,58 @@ function elements(s) { function find(x, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - const c = Curry._2(funarg.compare, x, v); - if (c === 0) { - return v; - } - _param = c < 0 ? param.l : param.r; - continue ; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + const v = param.v; + const c = Curry._2(funarg.compare, x, v); + if (c === 0) { + return v; + } + _param = c < 0 ? param.l : param.r; + continue ; }; } function find_first(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _param$1 = param.l; - while(true) { - const param$1 = _param$1; - const v0 = _v0; - if (!param$1) { - return v0; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.l; - _v0 = v$1; - continue ; - } - _param$1 = param$1.r; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _param$1 = param.l; + while(true) { + const param$1 = _param$1; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return v0; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.l; + _v0 = v$1; continue ; - }; - } - _param = param.r; - continue ; + } + _param$1 = param$1.r; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.r; + continue ; }; } function find_first_opt(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -1203,7 +1215,7 @@ function find_first_opt(f, _param) { while(true) { const param$1 = _param$1; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return Caml_option.some(v0); } const v$1 = param$1.v; @@ -1224,40 +1236,40 @@ function find_first_opt(f, _param) { function find_last(f, _param) { while(true) { const param = _param; - if (param) { - const v = param.v; - if (Curry._1(f, v)) { - let _v0 = v; - let _param$1 = param.r; - while(true) { - const param$1 = _param$1; - const v0 = _v0; - if (!param$1) { - return v0; - } - const v$1 = param$1.v; - if (Curry._1(f, v$1)) { - _param$1 = param$1.r; - _v0 = v$1; - continue ; - } - _param$1 = param$1.l; + if (/* tag */typeof param === "number" || typeof param === "string") { + throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { + MEL_EXN_ID: Stdlib.Not_found + }); + } + const v = param.v; + if (Curry._1(f, v)) { + let _v0 = v; + let _param$1 = param.r; + while(true) { + const param$1 = _param$1; + const v0 = _v0; + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { + return v0; + } + const v$1 = param$1.v; + if (Curry._1(f, v$1)) { + _param$1 = param$1.r; + _v0 = v$1; continue ; - }; - } - _param = param.l; - continue ; + } + _param$1 = param$1.l; + continue ; + }; } - throw new Caml_js_exceptions.MelangeError(Stdlib.Not_found, { - MEL_EXN_ID: Stdlib.Not_found - }); + _param = param.l; + continue ; }; } function find_last_opt(f, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -1267,7 +1279,7 @@ function find_last_opt(f, _param) { while(true) { const param$1 = _param$1; const v0 = _v0; - if (!param$1) { + if (/* tag */typeof param$1 === "number" || typeof param$1 === "string") { return Caml_option.some(v0); } const v$1 = param$1.v; @@ -1288,7 +1300,7 @@ function find_last_opt(f, _param) { function find_opt(x, _param) { while(true) { const param = _param; - if (!param) { + if (/* tag */typeof param === "number" || typeof param === "string") { return ; } const v = param.v; @@ -1310,7 +1322,7 @@ function try_join(l, v, r) { } function map(f, t) { - if (!t) { + if (/* tag */typeof t === "number" || typeof t === "string") { return /* Empty */0; } const r = t.r; @@ -1327,7 +1339,7 @@ function map(f, t) { } function filter_map(f, t) { - if (!t) { + if (/* tag */typeof t === "number" || typeof t === "string") { return /* Empty */0; } const r = t.r; @@ -1337,14 +1349,12 @@ function filter_map(f, t) { const v$p = Curry._1(f, v); const r$p = filter_map(f, r); if (v$p === undefined) { - if (l$p) { - if (r$p) { - return try_join(l$p, min_elt(r$p), remove_min_elt(r$p)); - } else { - return l$p; - } - } else { + if (/* tag */typeof l$p === "number" || typeof l$p === "string") { return r$p; + } else if (/* tag */typeof r$p === "number" || typeof r$p === "string") { + return l$p; + } else { + return try_join(l$p, min_elt(r$p), remove_min_elt(r$p)); } } const v$p$1 = Caml_option.valFromOption(v$p); @@ -1389,7 +1399,8 @@ function of_list(l) { case 1 : if (l) { return [ - /* Node */{ + { + TAG: /* Node */0, l: /* Empty */0, v: l.hd, r: /* Empty */0, @@ -1404,8 +1415,10 @@ function of_list(l) { const match = l.tl; if (match) { return [ - /* Node */{ - l: /* Node */{ + { + TAG: /* Node */0, + l: { + TAG: /* Node */0, l: /* Empty */0, v: l.hd, r: /* Empty */0, @@ -1428,15 +1441,18 @@ function of_list(l) { const match$2 = match$1.tl; if (match$2) { return [ - /* Node */{ - l: /* Node */{ + { + TAG: /* Node */0, + l: { + TAG: /* Node */0, l: /* Empty */0, v: l.hd, r: /* Empty */0, h: 1 }, v: match$1.hd, - r: /* Node */{ + r: { + TAG: /* Node */0, l: /* Empty */0, v: match$2.hd, r: /* Empty */0, @@ -1494,11 +1510,12 @@ function of_seq(i) { } function seq_of_enum_(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = cons_enum(c._1, c._2); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: c._0, _1: (function (param) { return seq_of_enum_(partial_arg, param); @@ -1517,10 +1534,11 @@ function snoc_enum(_s, _e) { while(true) { const e = _e; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return e; } - _e = /* More */{ + _e = { + TAG: /* More */0, _0: s.v, _1: s.l, _2: e @@ -1531,11 +1549,12 @@ function snoc_enum(_s, _e) { } function rev_seq_of_enum_(c, param) { - if (!c) { + if (/* tag */typeof c === "number" || typeof c === "string") { return /* Nil */0; } const partial_arg = snoc_enum(c._1, c._2); - return /* Cons */{ + return { + TAG: /* Cons */0, _0: c._0, _1: (function (param) { return rev_seq_of_enum_(partial_arg, param); @@ -1555,14 +1574,15 @@ function to_seq_from(low, s) { while(true) { const c = _c; const s = _s; - if (!s) { + if (/* tag */typeof s === "number" || typeof s === "string") { return c; } const r = s.r; const v = s.v; const n = Curry._2(funarg.compare, v, low); if (n === 0) { - return /* More */{ + return { + TAG: /* More */0, _0: v, _1: r, _2: c @@ -1572,7 +1592,8 @@ function to_seq_from(low, s) { _s = r; continue ; } - _c = /* More */{ + _c = { + TAG: /* More */0, _0: v, _1: r, _2: c diff --git a/jscomp/test/dist/jscomp/test/tscanf_test.js b/jscomp/test/dist/jscomp/test/tscanf_test.js index 5aa830ee5e..aae946b20e 100644 --- a/jscomp/test/dist/jscomp/test/tscanf_test.js +++ b/jscomp/test/dist/jscomp/test/tscanf_test.js @@ -45,38 +45,44 @@ function id(x) { } function test0(param) { - return ((((Curry._2(Stdlib__Scanf.sscanf("", /* Format */{ + return ((((Curry._2(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" - }), id, 1) + Curry._2(Stdlib__Scanf.sscanf("", /* Format */{ + }), id, 1) + Curry._2(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, _1: /* End_of_format */0 }, _1: " " - }), id, 2) | 0) + Curry._2(Stdlib__Scanf.sscanf(" ", /* Format */{ + }), id, 2) | 0) + Curry._2(Stdlib__Scanf.sscanf(" ", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, _1: /* End_of_format */0 }, _1: " " - }), id, 3) | 0) + Curry._2(Stdlib__Scanf.sscanf("\t", /* Format */{ + }), id, 3) | 0) + Curry._2(Stdlib__Scanf.sscanf("\t", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, _1: /* End_of_format */0 }, _1: " " - }), id, 4) | 0) + Curry._2(Stdlib__Scanf.sscanf("\n", /* Format */{ + }), id, 4) | 0) + Curry._2(Stdlib__Scanf.sscanf("\n", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, _1: /* End_of_format */0 }, _1: " " - }), id, 5) | 0) + Curry._1(Stdlib__Scanf.sscanf("\n\t 6", /* Format */{ + }), id, 5) | 0) + Curry._1(Stdlib__Scanf.sscanf("\n\t 6", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -95,7 +101,8 @@ function test0(param) { test("File \"jscomp/test/tscanf_test.ml\", line 42, characters 5-12", test0(undefined) === 21); function test1(param) { - return (((Curry._1(Stdlib__Scanf.sscanf("1", /* Format */{ + return (((Curry._1(Stdlib__Scanf.sscanf("1", { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -104,7 +111,8 @@ function test1(param) { _3: /* End_of_format */0 }, _1: "%d" - }), id) + Curry._1(Stdlib__Scanf.sscanf(" 2", /* Format */{ + }), id) + Curry._1(Stdlib__Scanf.sscanf(" 2", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -117,7 +125,8 @@ function test1(param) { } }, _1: " %d" - }), id) | 0) + Curry._1(Stdlib__Scanf.sscanf(" -2", /* Format */{ + }), id) | 0) + Curry._1(Stdlib__Scanf.sscanf(" -2", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -130,7 +139,8 @@ function test1(param) { } }, _1: " %d" - }), id) | 0) + Curry._1(Stdlib__Scanf.sscanf(" +2", /* Format */{ + }), id) | 0) + Curry._1(Stdlib__Scanf.sscanf(" +2", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -143,7 +153,8 @@ function test1(param) { } }, _1: " %d" - }), id) | 0) + Curry._1(Stdlib__Scanf.sscanf(" 2a ", /* Format */{ + }), id) | 0) + Curry._1(Stdlib__Scanf.sscanf(" 2a ", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -166,7 +177,8 @@ function test1(param) { test("File \"jscomp/test/tscanf_test.ml\", line 54, characters 5-12", test1(undefined) === 5); function test2(param) { - return (Curry._1(Stdlib__Scanf.sscanf("123", /* Format */{ + return (Curry._1(Stdlib__Scanf.sscanf("123", { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -179,7 +191,8 @@ function test2(param) { _3: /* End_of_format */0 }, _1: "%2i" - }), id) + Curry._1(Stdlib__Scanf.sscanf("245", /* Format */{ + }), id) + Curry._1(Stdlib__Scanf.sscanf("245", { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -188,7 +201,8 @@ function test2(param) { _3: /* End_of_format */0 }, _1: "%d" - }), id) | 0) + Curry._1(Stdlib__Scanf.sscanf(" 2a ", /* Format */{ + }), id) | 0) + Curry._1(Stdlib__Scanf.sscanf(" 2a ", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -215,7 +229,8 @@ function test2(param) { test("File \"jscomp/test/tscanf_test.ml\", line 63, characters 5-12", test2(undefined) === 259); function test3(param) { - return ((Curry._1(Stdlib__Scanf.sscanf("0xff", /* Format */{ + return ((Curry._1(Stdlib__Scanf.sscanf("0xff", { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -228,7 +243,8 @@ function test3(param) { _3: /* End_of_format */0 }, _1: "%3i" - }), id) + Curry._1(Stdlib__Scanf.sscanf("0XEF", /* Format */{ + }), id) + Curry._1(Stdlib__Scanf.sscanf("0XEF", { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -241,7 +257,8 @@ function test3(param) { _3: /* End_of_format */0 }, _1: "%3i" - }), id) | 0) + Curry._1(Stdlib__Scanf.sscanf("x=-245", /* Format */{ + }), id) | 0) + Curry._1(Stdlib__Scanf.sscanf("x=-245", { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " x = ", @@ -254,7 +271,8 @@ function test3(param) { } }, _1: " x = %d" - }), id) | 0) + Curry._1(Stdlib__Scanf.sscanf(" 2a ", /* Format */{ + }), id) | 0) + Curry._1(Stdlib__Scanf.sscanf(" 2a ", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -281,7 +299,8 @@ function test3(param) { test("File \"jscomp/test/tscanf_test.ml\", line 73, characters 5-12", test3(undefined) === -214); function test4(param) { - if (Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("1"), /* Format */{ + if (Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("1"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -295,7 +314,8 @@ function test4(param) { _1: "%f" }), (function (b0) { return b0 === 1.0; - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("-1"), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("-1"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -309,7 +329,8 @@ function test4(param) { _1: "%f" }), (function (b0) { return b0 === -1.0; - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("+1"), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("+1"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -323,7 +344,8 @@ function test4(param) { _1: "%f" }), (function (b0) { return b0 === 1.0; - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("1."), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("1."), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -337,7 +359,8 @@ function test4(param) { _1: "%f" }), (function (b0) { return b0 === 1.0; - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string(".1"), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string(".1"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -351,7 +374,8 @@ function test4(param) { _1: "%f" }), (function (b0) { return b0 === 0.1; - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("-.1"), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("-.1"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -365,7 +389,8 @@ function test4(param) { _1: "%f" }), (function (b0) { return b0 === -0.1; - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("+.1"), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("+.1"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -379,7 +404,8 @@ function test4(param) { _1: "%f" }), (function (b0) { return b0 === 0.1; - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("+1."), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("+1."), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -393,7 +419,8 @@ function test4(param) { _1: "%f" }), (function (b0) { return b0 === 1.0; - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("-1."), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("-1."), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -407,7 +434,8 @@ function test4(param) { _1: "%f" }), (function (b0) { return b0 === -1.0; - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("0 1. 1.3"), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("0 1. 1.3"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -447,7 +475,8 @@ function test4(param) { _1: "%f %f %f" }), (function (b0, b1, b2) { return b0 === 0.0 && b1 === 1.0 ? b2 === 1.3 : false; - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("0.113"), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("0.113"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -465,7 +494,8 @@ function test4(param) { _1: "%4f" }), (function (b0) { return b0 === 0.11; - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("0.113"), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("0.113"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -483,7 +513,8 @@ function test4(param) { _1: "%5f" }), (function (b0) { return b0 === 0.113; - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("000.113"), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("000.113"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -501,7 +532,8 @@ function test4(param) { _1: "%15f" }), (function (b0) { return b0 === 0.113; - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("+000.113"), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("+000.113"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -520,7 +552,8 @@ function test4(param) { }), (function (b0) { return b0 === 0.113; }))) { - return Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("-000.113"), /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("-000.113"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -547,7 +580,8 @@ function test4(param) { test("File \"jscomp/test/tscanf_test.ml\", line 110, characters 5-12", test4(undefined)); function test5(param) { - if (Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("1e1"), /* Format */{ + if (Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("1e1"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -561,7 +595,8 @@ function test5(param) { _1: "%e" }), (function (b) { return b === 10.0; - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("1e+1"), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("1e+1"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -575,7 +610,8 @@ function test5(param) { _1: "%e" }), (function (b) { return b === 10.0; - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("10e-1"), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("10e-1"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -589,7 +625,8 @@ function test5(param) { _1: "%e" }), (function (b) { return b === 1.0; - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("10.e-1"), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("10.e-1"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -603,7 +640,8 @@ function test5(param) { _1: "%e" }), (function (b) { return b === 1.0; - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("1e1 1.e+1 1.3e-1"), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("1e1 1.e+1 1.3e-1"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -644,7 +682,8 @@ function test5(param) { }), (function (b1, b2, b3) { return b1 === 10.0 && b2 === b1 ? b3 === 0.13 : false; }))) { - return Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("1 1.1 0e+1 1.3e-1"), /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("1 1.1 0e+1 1.3e-1"), { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -710,7 +749,8 @@ function test5(param) { test("File \"jscomp/test/tscanf_test.ml\", line 133, characters 5-12", test5(undefined)); function test6(param) { - if (Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("truetrue"), /* Format */{ + if (Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("truetrue"), { + TAG: /* Format */0, _0: { TAG: /* Bool */9, _0: /* No_padding */0, @@ -729,7 +769,8 @@ function test6(param) { true, true ]); - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("truefalse"), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("truefalse"), { + TAG: /* Format */0, _0: { TAG: /* Bool */9, _0: /* No_padding */0, @@ -748,7 +789,8 @@ function test6(param) { true, false ]); - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("falsetrue"), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("falsetrue"), { + TAG: /* Format */0, _0: { TAG: /* Bool */9, _0: /* No_padding */0, @@ -767,7 +809,8 @@ function test6(param) { false, true ]); - })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("falsefalse"), /* Format */{ + })) && Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("falsefalse"), { + TAG: /* Format */0, _0: { TAG: /* Bool */9, _0: /* No_padding */0, @@ -787,7 +830,8 @@ function test6(param) { false ]); }))) { - return Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("true false"), /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("true false"), { + TAG: /* Format */0, _0: { TAG: /* Bool */9, _0: /* No_padding */0, @@ -819,7 +863,8 @@ function test6(param) { test("File \"jscomp/test/tscanf_test.ml\", line 150, characters 5-12", test6(undefined)); function test7(param) { - if (Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("'a' '\n' '\t' '\0' ' '"), /* Format */{ + if (Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("'a' '\n' '\t' '\0' ' '"), { + TAG: /* Format */0, _0: { TAG: /* Caml_char */1, _0: { @@ -856,7 +901,8 @@ function test7(param) { }), (function (c1, c2, c3, c4, c5) { return c1 === /* 'a' */97 && c2 === /* '\n' */10 && c3 === /* '\t' */9 && c4 === /* '\000' */0 ? c5 === /* ' ' */32 : false; }))) { - return Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("a \n \t \0 b"), /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(Stdlib__Scanf.Scanning.from_string("a \n \t \0 b"), { + TAG: /* Format */0, _0: { TAG: /* Char */0, _0: { @@ -895,7 +941,8 @@ function test7(param) { test("File \"jscomp/test/tscanf_test.ml\", line 168, characters 5-12", test7(undefined)); function verify_read(c) { - const s = Curry._1(Stdlib__Printf.sprintf(/* Format */{ + const s = Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Caml_char */1, _0: /* End_of_format */0 @@ -903,7 +950,8 @@ function verify_read(c) { _1: "%C" }), c); const ib = Stdlib__Scanf.Scanning.from_string(s); - if (Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + if (Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Caml_char */1, _0: /* End_of_format */0 @@ -935,7 +983,8 @@ function test8(param) { test("File \"jscomp/test/tscanf_test.ml\", line 183, characters 5-12", verify_scan_Chars(undefined) === undefined); function unit(fmt, s) { - const ib = Stdlib__Scanf.Scanning.from_string(Curry._1(Stdlib__Printf.sprintf(/* Format */{ + const ib = Stdlib__Scanf.Scanning.from_string(Curry._1(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Caml_string */3, _0: /* No_padding */0, @@ -952,7 +1001,8 @@ function test_fmt(fmt, s) { const test9_string = "\xef\xbb\xbf"; -const partial_arg = /* Format */{ +const partial_arg = { + TAG: /* Format */0, _0: { TAG: /* Caml_string */3, _0: /* No_padding */0, @@ -966,7 +1016,8 @@ function test_S(param) { } function test9(param) { - if (test_S("poi") && test_S("a\"b") && test_S("a\nb") && test_S("a\nb") && test_S("a\\\nb \\\nc\n\\\nb") && test_S("a\\\n\\\n\\\nb \\\nc\n\\\nb") && test_S("\xef") && test_S("\\xef") && Curry._1(Stdlib__Scanf.sscanf("\"\\xef\"", /* Format */{ + if (test_S("poi") && test_S("a\"b") && test_S("a\nb") && test_S("a\nb") && test_S("a\\\nb \\\nc\n\\\nb") && test_S("a\\\n\\\n\\\nb \\\nc\n\\\nb") && test_S("\xef") && test_S("\\xef") && Curry._1(Stdlib__Scanf.sscanf("\"\\xef\"", { + TAG: /* Format */0, _0: { TAG: /* Caml_string */3, _0: /* No_padding */0, @@ -975,7 +1026,8 @@ function test9(param) { _1: "%S" }), (function (s) { return s; - })) === "\xef" && Curry._1(Stdlib__Scanf.sscanf("\"\\xef\\xbb\\xbf\"", /* Format */{ + })) === "\xef" && Curry._1(Stdlib__Scanf.sscanf("\"\\xef\\xbb\\xbf\"", { + TAG: /* Format */0, _0: { TAG: /* Caml_string */3, _0: /* No_padding */0, @@ -984,7 +1036,8 @@ function test9(param) { _1: "%S" }), (function (s) { return s; - })) === test9_string && Curry._1(Stdlib__Scanf.sscanf("\"\\xef\\xbb\\xbf\"", /* Format */{ + })) === test9_string && Curry._1(Stdlib__Scanf.sscanf("\"\\xef\\xbb\\xbf\"", { + TAG: /* Format */0, _0: { TAG: /* Caml_string */3, _0: /* No_padding */0, @@ -993,7 +1046,8 @@ function test9(param) { _1: "%S" }), (function (s) { return s; - })) === "\xef\xbb\xbf" && Curry._1(Stdlib__Scanf.sscanf("\"\xef\xbb\xbf\"", /* Format */{ + })) === "\xef\xbb\xbf" && Curry._1(Stdlib__Scanf.sscanf("\"\xef\xbb\xbf\"", { + TAG: /* Format */0, _0: { TAG: /* Caml_string */3, _0: /* No_padding */0, @@ -1002,7 +1056,8 @@ function test9(param) { _1: "%S" }), (function (s) { return s; - })) === test9_string && Curry._1(Stdlib__Scanf.sscanf("\"\\\\xef\\\\xbb\\\\xbf\"", /* Format */{ + })) === test9_string && Curry._1(Stdlib__Scanf.sscanf("\"\\\\xef\\\\xbb\\\\xbf\"", { + TAG: /* Format */0, _0: { TAG: /* Caml_string */3, _0: /* No_padding */0, @@ -1012,7 +1067,8 @@ function test9(param) { }), (function (s) { return s; })) === "\\xef\\xbb\\xbf") { - return Curry._1(Stdlib__Scanf.sscanf("\" \"", /* Format */{ + return Curry._1(Stdlib__Scanf.sscanf("\" \"", { + TAG: /* Format */0, _0: { TAG: /* Caml_string */3, _0: /* No_padding */0, @@ -1032,7 +1088,8 @@ test("File \"jscomp/test/tscanf_test.ml\", line 230, characters 5-12", test9(und function test10(param) { const unit = function (s) { const ib = Stdlib__Scanf.Scanning.from_string(s); - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Caml_string */3, _0: /* No_padding */0, @@ -1041,7 +1098,8 @@ function test10(param) { _1: "%S" }), id); }; - const res = Curry._1(Stdlib__Scanf.sscanf("Une chaine: \"celle-ci\" et \"celle-la\"!", /* Format */{ + const res = Curry._1(Stdlib__Scanf.sscanf("Une chaine: \"celle-ci\" et \"celle-la\"!", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1101,7 +1159,8 @@ function test10(param) { test("File \"jscomp/test/tscanf_test.ml\", line 254, characters 5-12", test10(undefined)); function test11(param) { - if (Curry._1(Stdlib__Scanf.sscanf("Pierre\tWeis\t70", /* Format */{ + if (Curry._1(Stdlib__Scanf.sscanf("Pierre\tWeis\t70", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1126,7 +1185,8 @@ function test11(param) { _1: "%s %s %s" }), (function (prenom, nom, poids) { return prenom === "Pierre" && nom === "Weis" ? Caml_format.caml_int_of_string(poids) === 70 : false; - })) && Curry._1(Stdlib__Scanf.sscanf("Jean-Luc\tde Leage\t68", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("Jean-Luc\tde Leage\t68", { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -1156,7 +1216,8 @@ function test11(param) { }), (function (prenom, nom, poids) { return prenom === "Jean-Luc" && nom === "de Leage" ? poids === 68 : false; }))) { - return Curry._1(Stdlib__Scanf.sscanf("Daniel\tde Rauglaudre\t66", /* Format */{ + return Curry._1(Stdlib__Scanf.sscanf("Daniel\tde Rauglaudre\t66", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1208,7 +1269,8 @@ function test11(param) { } function test110(param) { - if (Curry._2(Stdlib__Scanf.sscanf("", /* Format */{ + if (Curry._2(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -1217,7 +1279,8 @@ function test110(param) { _1: " " }), (function (x) { return x; - }), "") === "" && Curry._1(Stdlib__Scanf.sscanf("", /* Format */{ + }), "") === "" && Curry._1(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1226,7 +1289,8 @@ function test110(param) { _1: "%s" }), (function (x) { return x === ""; - })) && Curry._1(Stdlib__Scanf.sscanf("", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1239,7 +1303,8 @@ function test110(param) { _1: "%s%s" }), (function (x, y) { return x === "" ? y === "" : false; - })) && Curry._1(Stdlib__Scanf.sscanf("", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1252,7 +1317,8 @@ function test110(param) { _1: "%s " }), (function (x) { return x === ""; - })) && Curry._1(Stdlib__Scanf.sscanf("", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -1265,7 +1331,8 @@ function test110(param) { _1: " %s" }), (function (x) { return x === ""; - })) && Curry._1(Stdlib__Scanf.sscanf("", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -1282,7 +1349,8 @@ function test110(param) { _1: " %s " }), (function (x) { return x === ""; - })) && Curry._1(Stdlib__Scanf.sscanf("", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -1292,7 +1360,8 @@ function test110(param) { _1: "%[^\n]" }), (function (x) { return x === ""; - })) && Curry._1(Stdlib__Scanf.sscanf("", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -1306,7 +1375,8 @@ function test110(param) { _1: "%[^\n] " }), (function (x) { return x === ""; - })) && Curry._1(Stdlib__Scanf.sscanf(" ", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf(" ", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1315,7 +1385,8 @@ function test110(param) { _1: "%s" }), (function (x) { return x === ""; - })) && Curry._1(Stdlib__Scanf.sscanf(" ", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf(" ", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1328,7 +1399,8 @@ function test110(param) { _1: "%s%s" }), (function (x, y) { return x === "" ? y === "" : false; - })) && Curry._1(Stdlib__Scanf.sscanf(" ", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf(" ", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -1345,7 +1417,8 @@ function test110(param) { _1: " %s " }), (function (x) { return x === ""; - })) && Curry._1(Stdlib__Scanf.sscanf(" ", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf(" ", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -1366,7 +1439,8 @@ function test110(param) { _1: " %s %s" }), (function (x, y) { return x === "" ? x === y : false; - })) && Curry._1(Stdlib__Scanf.sscanf(" ", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf(" ", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -1392,7 +1466,8 @@ function test110(param) { _1: " %s@ %s" }), (function (x, y) { return x === "" ? x === y : false; - })) && Curry._1(Stdlib__Scanf.sscanf(" poi !", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf(" poi !", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -1423,7 +1498,8 @@ function test110(param) { }), (function (x, y) { return x === "poi" ? y === "!" : false; }))) { - return Curry._1(Stdlib__Scanf.sscanf(" poi !", /* Format */{ + return Curry._1(Stdlib__Scanf.sscanf(" poi !", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -1460,7 +1536,8 @@ function test110(param) { } function test111(param) { - return Curry._1(Stdlib__Scanf.sscanf("", /* Format */{ + return Curry._1(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -1484,7 +1561,8 @@ function ib(param) { } function f(ib) { - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " [", @@ -1492,7 +1570,8 @@ function f(ib) { }, _1: " [" }), undefined); - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -1510,7 +1589,8 @@ function f(ib) { }, _1: " %i;" }), (function (i) { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -1528,7 +1608,8 @@ function f(ib) { }, _1: " %i;" }), (function (j) { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -1546,7 +1627,8 @@ function f(ib) { }, _1: " %i;" }), (function (k) { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -1564,7 +1646,8 @@ function f(ib) { }, _1: " %i;" }), (function (l) { - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " ]", @@ -1611,7 +1694,8 @@ test("File \"jscomp/test/tscanf_test.ml\", line 311, characters 5-12", test12(un function scan_elems(ib, accu) { try { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -1641,7 +1725,8 @@ function scan_elems(ib, accu) { } function g(ib) { - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "[ ", @@ -1671,7 +1756,8 @@ function test13(param) { test("File \"jscomp/test/tscanf_test.ml\", line 324, characters 5-12", test13(undefined)); function scan_int_list(ib) { - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "[ ", @@ -1680,7 +1766,8 @@ function scan_int_list(ib) { _1: "[ " }), undefined); const accu = scan_elems(ib, /* [] */0); - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " ]", @@ -1710,7 +1797,8 @@ function test14(param) { test("File \"jscomp/test/tscanf_test.ml\", line 337, characters 5-12", test14(undefined)); function scan_elems$1(ib, accu) { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -1751,7 +1839,8 @@ function scan_elems$1(ib, accu) { } function scan_int_list$1(ib) { - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "[ ", @@ -1782,7 +1871,8 @@ test("File \"jscomp/test/tscanf_test.ml\", line 357, characters 5-12", test15(un function scan_elems$2(ib, accu) { try { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char */0, _0: { @@ -1837,7 +1927,8 @@ function scan_elems$2(ib, accu) { catch (raw_exn){ const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); if (exn.MEL_EXN_ID === Stdlib__Scanf.Scan_failure) { - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ']' */93, @@ -1901,7 +1992,8 @@ function test16(param) { test("File \"jscomp/test/tscanf_test.ml\", line 383, characters 5-12", test16(undefined)); function scan_elems$3(ib, accu) { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -1941,7 +2033,8 @@ function scan_elems$3(ib, accu) { } function scan_int_list$2(ib) { - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " [", @@ -1999,7 +2092,8 @@ function test17(param) { test("File \"jscomp/test/tscanf_test.ml\", line 406, characters 5-12", test17(undefined)); function scan_rest(ib, accu) { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -2015,7 +2109,8 @@ function scan_rest(ib, accu) { _1: " %c " }), (function (c) { if (c === 59) { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -2027,7 +2122,8 @@ function scan_rest(ib, accu) { if (param === "]") { return accu; } else { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -2064,7 +2160,8 @@ function scan_rest(ib, accu) { } function scan_elems$4(ib, accu) { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -2086,7 +2183,8 @@ function scan_elems$4(ib, accu) { }); } if (Caml_obj.caml_equal(accu, /* [] */0)) { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -2098,7 +2196,8 @@ function scan_elems$4(ib, accu) { if (param === "]") { return accu; } else { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -2197,7 +2296,8 @@ function test21(param) { test21(undefined); function scan_rest$1(ib, accu) { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -2209,7 +2309,8 @@ function scan_rest$1(ib, accu) { if (param === "]") { return accu; } else { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -2231,7 +2332,8 @@ function scan_rest$1(ib, accu) { hd: i, tl: accu }; - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: 1, @@ -2246,7 +2348,8 @@ function scan_rest$1(ib, accu) { case "]" : return accu$1; default: - const s = Stdlib__Printf.sprintf(/* Format */{ + const s = Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "scan_int_list", @@ -2266,7 +2369,8 @@ function scan_rest$1(ib, accu) { } function scan_int_list$4(ib) { - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " [ ", @@ -2338,7 +2442,8 @@ function scan_elems$5(ib, scan_elem, accu) { } function scan_list(scan_elem, ib) { - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "[ ", @@ -2347,7 +2452,8 @@ function scan_list(scan_elem, ib) { _1: "[ " }), undefined); const accu = scan_elems$5(ib, scan_elem, /* [] */0); - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " ]", @@ -2359,7 +2465,8 @@ function scan_list(scan_elem, ib) { } function scan_int_elem(ib) { - return Stdlib__Scanf.bscanf(ib, /* Format */{ + return Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -2444,7 +2551,8 @@ function test27(param) { test24(undefined) && test25(undefined) && test26(undefined) && test27(undefined); function scan_string_elem(ib) { - return Stdlib__Scanf.bscanf(ib, /* Format */{ + return Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " \"", @@ -2475,7 +2583,8 @@ function scan_string_elem(ib) { } function scan_String_elem(ib) { - return Stdlib__Scanf.bscanf(ib, /* Format */{ + return Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -2583,7 +2692,8 @@ function scan_elems$6(ib, scan_elem, accu) { } function scan_list$1(scan_elem, ib) { - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "[ ", @@ -2592,7 +2702,8 @@ function scan_list$1(scan_elem, ib) { _1: "[ " }), undefined); const accu = scan_elems$6(ib, scan_elem, /* [] */0); - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " ]", @@ -2604,7 +2715,8 @@ function scan_list$1(scan_elem, ib) { } function scan_int_elem$1(ib, f, ek) { - return Curry._1(Stdlib__Scanf.kscanf(ib, ek, /* Format */{ + return Curry._1(Stdlib__Scanf.kscanf(ib, ek, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -2667,7 +2779,8 @@ function test29(param) { test("File \"jscomp/test/tscanf_test.ml\", line 639, characters 5-12", test29(undefined)); function scan_string_elem$1(ib, f, ek) { - return Curry._1(Stdlib__Scanf.kscanf(ib, ek, /* Format */{ + return Curry._1(Stdlib__Scanf.kscanf(ib, ek, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -2739,7 +2852,8 @@ function scan_elems$7(ib, scan_elem, accu) { }; return Curry._1(Stdlib__Scanf.kscanf(ib, (function (ib, exc) { return accu$1; - }), /* Format */{ + }), { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -2764,7 +2878,8 @@ function scan_elems$7(ib, scan_elem, accu) { } function scan_list$2(scan_elem, ib) { - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "[ ", @@ -2773,7 +2888,8 @@ function scan_list$2(scan_elem, ib) { _1: "[ " }), undefined); const accu = scan_elems$7(ib, scan_elem, /* [] */0); - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " ]", @@ -2784,7 +2900,8 @@ function scan_list$2(scan_elem, ib) { return Stdlib__List.rev(accu); } -const partial_arg$1 = /* Format */{ +const partial_arg$1 = { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -2807,7 +2924,8 @@ function scan_int_list$6(param) { return scan_list$2(partial_arg$2, param); } -const partial_arg$3 = /* Format */{ +const partial_arg$3 = { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -2910,7 +3028,8 @@ function scan_elems$8(ib, scan_elem_fmt, accu) { hd: i, tl: accu }; - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -2937,7 +3056,8 @@ function scan_elems$8(ib, scan_elem_fmt, accu) { } function scan_list$3(scan_elem_fmt, ib) { - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "[ ", @@ -2946,7 +3066,8 @@ function scan_list$3(scan_elem_fmt, ib) { _1: "[ " }), undefined); const accu = scan_elems$8(ib, scan_elem_fmt, /* [] */0); - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " ]", @@ -2957,7 +3078,8 @@ function scan_list$3(scan_elem_fmt, ib) { return Stdlib__List.rev(accu); } -const partial_arg$5 = /* Format */{ +const partial_arg$5 = { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -2972,7 +3094,8 @@ function scan_int_list$7(param) { return scan_list$3(partial_arg$5, param); } -const partial_arg$6 = /* Format */{ +const partial_arg$6 = { + TAG: /* Format */0, _0: { TAG: /* Caml_string */3, _0: /* No_padding */0, @@ -3062,7 +3185,8 @@ test("File \"jscomp/test/tscanf_test.ml\", line 787, characters 5-12", test34(un function scan_elems$9(scan_elem, accu, ib) { return Curry._2(Stdlib__Scanf.kscanf(ib, (function (ib, exc) { return accu; - }), /* Format */{ + }), { + TAG: /* Format */0, _0: { TAG: /* Reader */19, _0: /* End_of_format */0 @@ -3074,7 +3198,8 @@ function scan_elems$9(scan_elem, accu, ib) { hd: elem, tl: accu }; - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -3104,7 +3229,8 @@ function scan_elems$9(scan_elem, accu, ib) { } function scan_list$4(scan_elem, ib) { - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "[ ", @@ -3113,7 +3239,8 @@ function scan_list$4(scan_elem, ib) { _1: "[ " }), undefined); const accu = scan_elems$9(scan_elem, /* [] */0, ib); - Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " ]", @@ -3125,7 +3252,8 @@ function scan_list$4(scan_elem, ib) { } function scan_float(ib) { - return Stdlib__Scanf.bscanf(ib, /* Format */{ + return Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Float */8, _0: [ @@ -3142,7 +3270,8 @@ function scan_float(ib) { function scan_int_list$8(param) { return scan_list$4((function (ib) { - return Stdlib__Scanf.bscanf(ib, /* Format */{ + return Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -3157,7 +3286,8 @@ function scan_int_list$8(param) { function scan_string_list$2(param) { return scan_list$4((function (ib) { - return Stdlib__Scanf.bscanf(ib, /* Format */{ + return Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Caml_string */3, _0: /* No_padding */0, @@ -3170,7 +3300,8 @@ function scan_string_list$2(param) { function scan_bool_list(param) { return scan_list$4((function (ib) { - return Stdlib__Scanf.bscanf(ib, /* Format */{ + return Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Bool */9, _0: /* No_padding */0, @@ -3183,7 +3314,8 @@ function scan_bool_list(param) { function scan_char_list(param) { return scan_list$4((function (ib) { - return Stdlib__Scanf.bscanf(ib, /* Format */{ + return Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Caml_char */1, _0: /* End_of_format */0 @@ -3248,7 +3380,8 @@ function scan_float_list_list$1(ib, k) { } function test35(param) { - if (Curry._1(Stdlib__Scanf.sscanf("", /* Format */{ + if (Curry._1(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: { TAG: /* Scan_get_counter */21, _0: /* Token_counter */2, @@ -3257,7 +3390,8 @@ function test35(param) { _1: "%N" }), (function (x) { return x; - })) === 0 && Curry._1(Stdlib__Scanf.sscanf("456", /* Format */{ + })) === 0 && Curry._1(Stdlib__Scanf.sscanf("456", { + TAG: /* Format */0, _0: { TAG: /* Scan_get_counter */21, _0: /* Token_counter */2, @@ -3266,7 +3400,8 @@ function test35(param) { _1: "%N" }), (function (x) { return x; - })) === 0 && Caml_obj.caml_equal(Curry._1(Stdlib__Scanf.sscanf("456", /* Format */{ + })) === 0 && Caml_obj.caml_equal(Curry._1(Stdlib__Scanf.sscanf("456", { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -3288,7 +3423,8 @@ function test35(param) { 456, 1 ])) { - return Caml_obj.caml_equal(Curry._1(Stdlib__Scanf.sscanf(" ", /* Format */{ + return Caml_obj.caml_equal(Curry._1(Stdlib__Scanf.sscanf(" ", { + TAG: /* Format */0, _0: { TAG: /* Scan_get_counter */21, _0: /* Token_counter */2, @@ -3324,7 +3460,8 @@ test("File \"jscomp/test/tscanf_test.ml\", line 940, characters 5-12", test340(u function read_elems(read_elem, accu, ib) { return Curry._2(Stdlib__Scanf.kscanf(ib, (function (ib, exc) { return accu; - }), /* Format */{ + }), { + TAG: /* Format */0, _0: { TAG: /* Reader */19, _0: { @@ -3358,7 +3495,8 @@ function read_elems(read_elem, accu, ib) { } function read_list(read_elem, ib) { - return Curry._2(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._2(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "[ ", @@ -3390,7 +3528,8 @@ function scan_List(fmt) { } function test36(param) { - if (Curry._1(Stdlib__Scanf.sscanf("", /* Format */{ + if (Curry._1(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: { TAG: /* Scan_get_counter */21, _0: /* Char_counter */1, @@ -3399,7 +3538,8 @@ function test36(param) { _1: "%n" }), (function (x) { return x; - })) === 0 && Curry._1(Stdlib__Scanf.sscanf("456", /* Format */{ + })) === 0 && Curry._1(Stdlib__Scanf.sscanf("456", { + TAG: /* Format */0, _0: { TAG: /* Scan_get_counter */21, _0: /* Char_counter */1, @@ -3408,7 +3548,8 @@ function test36(param) { _1: "%n" }), (function (x) { return x; - })) === 0 && Caml_obj.caml_equal(Curry._1(Stdlib__Scanf.sscanf("456", /* Format */{ + })) === 0 && Caml_obj.caml_equal(Curry._1(Stdlib__Scanf.sscanf("456", { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -3430,7 +3571,8 @@ function test36(param) { 456, 3 ])) { - return Caml_obj.caml_equal(Curry._1(Stdlib__Scanf.sscanf(" ", /* Format */{ + return Caml_obj.caml_equal(Curry._1(Stdlib__Scanf.sscanf(" ", { + TAG: /* Format */0, _0: { TAG: /* Scan_get_counter */21, _0: /* Char_counter */1, @@ -3464,16 +3606,19 @@ function test36(param) { test("File \"jscomp/test/tscanf_test.ml\", line 995, characters 5-12", test36(undefined)); function test37(param) { - if (Curry._1(Stdlib__Scanf.sscanf("", /* Format */{ + if (Curry._1(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" - }), true) && Curry._2(Stdlib__Scanf.sscanf("", /* Format */{ + }), true) && Curry._2(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" }), (function (x) { return x; }), 1) === 1) { - return Curry._2(Stdlib__Scanf.sscanf("123", /* Format */{ + return Curry._2(Stdlib__Scanf.sscanf("123", { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" }), (function (x) { @@ -3487,7 +3632,8 @@ function test37(param) { test("File \"jscomp/test/tscanf_test.ml\", line 1005, characters 5-12", test37(undefined)); function test38(param) { - if (Curry._1(Stdlib__Scanf.sscanf("a", /* Format */{ + if (Curry._1(Stdlib__Scanf.sscanf("a", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* 'a' */97, @@ -3497,7 +3643,8 @@ function test38(param) { } }, _1: "a%!" - }), true) && Curry._1(Stdlib__Scanf.sscanf("a", /* Format */{ + }), true) && Curry._1(Stdlib__Scanf.sscanf("a", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* 'a' */97, @@ -3510,7 +3657,8 @@ function test38(param) { } }, _1: "a%!%!" - }), true) && Curry._1(Stdlib__Scanf.sscanf(" a", /* Format */{ + }), true) && Curry._1(Stdlib__Scanf.sscanf(" a", { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: " a", @@ -3520,7 +3668,8 @@ function test38(param) { } }, _1: " a%!" - }), true) && Curry._1(Stdlib__Scanf.sscanf("a ", /* Format */{ + }), true) && Curry._1(Stdlib__Scanf.sscanf("a ", { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "a ", @@ -3530,13 +3679,15 @@ function test38(param) { } }, _1: "a %!" - }), true) && Curry._1(Stdlib__Scanf.sscanf("", /* Format */{ + }), true) && Curry._1(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: { TAG: /* Flush */10, _0: /* End_of_format */0 }, _1: "%!" - }), true) && Curry._1(Stdlib__Scanf.sscanf(" ", /* Format */{ + }), true) && Curry._1(Stdlib__Scanf.sscanf(" ", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -3546,7 +3697,8 @@ function test38(param) { } }, _1: " %!" - }), true) && Curry._1(Stdlib__Scanf.sscanf("", /* Format */{ + }), true) && Curry._1(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -3557,7 +3709,8 @@ function test38(param) { }, _1: " %!" }), true)) { - return Curry._1(Stdlib__Scanf.sscanf("", /* Format */{ + return Curry._1(Stdlib__Scanf.sscanf("", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -3598,7 +3751,8 @@ test("File \"jscomp/test/tscanf_test.ml\", line 1036, characters 5-12", test39(u function test40(param) { const ib = Stdlib__Scanf.Scanning.from_string("cba"); - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -3626,7 +3780,8 @@ test("File \"jscomp/test/tscanf_test.ml\", line 1046, characters 5-12", test40(u function test41(param) { const ib = Stdlib__Scanf.Scanning.from_string("cba"); - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -3656,7 +3811,8 @@ test("File \"jscomp/test/tscanf_test.ml\", line 1055, characters 5-12", test41(u function test42(param) { const s = "defcbaaghi"; const ib = Stdlib__Scanf.Scanning.from_string(s); - if (!Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + if (!Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -3686,7 +3842,8 @@ function test42(param) { return false; } const ib$1 = Stdlib__Scanf.Scanning.from_string(s); - return Curry._1(Stdlib__Scanf.bscanf(ib$1, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib$1, { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -3710,7 +3867,8 @@ test("File \"jscomp/test/tscanf_test.ml\", line 1067, characters 5-12", test42(u const ib$1 = Stdlib__Scanf.Scanning.from_string(""); function test43(param) { - return Curry._1(Stdlib__Scanf.bscanf(ib$1, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib$1, { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -3728,7 +3886,8 @@ function test43(param) { } function test44(param) { - return Curry._1(Stdlib__Scanf.bscanf(ib$1, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib$1, { + TAG: /* Format */0, _0: { TAG: /* Flush */10, _0: { @@ -3753,7 +3912,8 @@ Testing.test_raises_this_exc({ function test45(param) { const ib = Stdlib__Scanf.Scanning.from_string("12.2"); - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -3789,7 +3949,8 @@ function test45(param) { test("File \"jscomp/test/tscanf_test.ml\", line 1090, characters 5-12", test45(undefined)); function test46(param) { - return Curry._3(Stdlib__Printf.sprintf(/* Format */{ + return Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -3814,7 +3975,8 @@ function test46(param) { } }, _1: "%i %(%s%)." - }), 1, /* Format */{ + }), 1, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "spells one, ", @@ -3829,7 +3991,8 @@ function test46(param) { } function test47(param) { - return Curry._3(Stdlib__Printf.sprintf(/* Format */{ + return Curry._3(Stdlib__Printf.sprintf({ + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -3862,7 +4025,8 @@ function test47(param) { } }, _1: "%i %{%s%}, %s." - }), 1, /* Format */{ + }), 1, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "spells one ", @@ -3884,7 +4048,8 @@ function test48(param) { const test_meta_read = function (s, fmt, efmt) { return Caml_obj.caml_equal(Stdlib__Scanf.format_from_string(s, fmt), efmt); }; - const fmt = /* Format */{ + const fmt = { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -3897,7 +4062,8 @@ function test48(param) { if (!test_meta_read("%i", fmt, fmt)) { return false; } - if (!test_meta_read("%i", /* Format */{ + if (!test_meta_read("%i", { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -3906,7 +4072,8 @@ function test48(param) { _3: /* End_of_format */0 }, _1: "%d" - }, /* Format */{ + }, { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -3918,7 +4085,8 @@ function test48(param) { })) { return false; } - if (!Curry._1(Stdlib__Scanf.sscanf("12 \"%i\"89 ", /* Format */{ + if (!Curry._1(Stdlib__Scanf.sscanf("12 \"%i\"89 ", { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -3951,7 +4119,8 @@ function test48(param) { }, _1: "%i %{%d%}%s %!" }), (function (i, f, s) { - if (i === 12 && Caml_obj.caml_equal(f, /* Format */{ + if (i === 12 && Caml_obj.caml_equal(f, { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -3969,7 +4138,8 @@ function test48(param) { return false; } const k = function (s) { - return Curry._1(Stdlib__Scanf.sscanf(s, /* Format */{ + return Curry._1(Stdlib__Scanf.sscanf(s, { + TAG: /* Format */0, _0: { TAG: /* Format_subst */14, _0: undefined, @@ -3997,7 +4167,8 @@ function test48(param) { return false; } const h = function (s) { - return Curry._1(Stdlib__Scanf.sscanf(s, /* Format */{ + return Curry._1(Stdlib__Scanf.sscanf(s, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Read integers with ", @@ -4029,7 +4200,8 @@ function test48(param) { return false; } const i = function (s) { - return Curry._1(Stdlib__Scanf.sscanf(s, /* Format */{ + return Curry._1(Stdlib__Scanf.sscanf(s, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "with ", @@ -4079,7 +4251,8 @@ function test48(param) { return false; } const j = function (s) { - return Curry._1(Stdlib__Scanf.sscanf(s, /* Format */{ + return Curry._1(Stdlib__Scanf.sscanf(s, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "with ", @@ -4126,7 +4299,8 @@ function test48(param) { test("File \"jscomp/test/tscanf_test.ml\", line 1157, characters 5-12", test48(undefined)); function test49(param) { - if (Curry._1(Stdlib__Scanf.sscanf("as", /* Format */{ + if (Curry._1(Stdlib__Scanf.sscanf("as", { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -4136,7 +4310,8 @@ function test49(param) { _1: "%[\\]" }), (function (s) { return s === ""; - })) && Curry._1(Stdlib__Scanf.sscanf("as", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("as", { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -4150,7 +4325,8 @@ function test49(param) { _1: "%[\\]%s" }), (function (s, t) { return s === "" ? t === "as" : false; - })) && Curry._1(Stdlib__Scanf.sscanf("as", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("as", { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -4167,7 +4343,8 @@ function test49(param) { _1: "%[\\]%s%!" }), (function (s, t) { return s === "" ? t === "as" : false; - })) && Curry._1(Stdlib__Scanf.sscanf("as", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("as", { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -4177,7 +4354,8 @@ function test49(param) { _1: "%[a..z]" }), (function (s) { return s === "a"; - })) && Curry._1(Stdlib__Scanf.sscanf("as", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("as", { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -4187,7 +4365,8 @@ function test49(param) { _1: "%[a-z]" }), (function (s) { return s === "as"; - })) && Curry._1(Stdlib__Scanf.sscanf("as", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("as", { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -4201,7 +4380,8 @@ function test49(param) { _1: "%[a..z]%s" }), (function (s, t) { return s === "a" ? t === "s" : false; - })) && Curry._1(Stdlib__Scanf.sscanf("as", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("as", { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -4215,7 +4395,8 @@ function test49(param) { _1: "%[a-z]%s" }), (function (s, t) { return s === "as" ? t === "" : false; - })) && Curry._1(Stdlib__Scanf.sscanf("-as", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("-as", { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -4225,7 +4406,8 @@ function test49(param) { _1: "%[-a-z]" }), (function (s) { return s === "-as"; - })) && Curry._1(Stdlib__Scanf.sscanf("-as", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("-as", { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -4242,7 +4424,8 @@ function test49(param) { _1: "%[-a-z]@s" }), (function (s) { return s === "-a"; - })) && Curry._1(Stdlib__Scanf.sscanf("-as", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("-as", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '-' */45, @@ -4263,7 +4446,8 @@ function test49(param) { _1: "-%[a]@s" }), (function (s) { return s === "a"; - })) && Curry._1(Stdlib__Scanf.sscanf("-asb", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("-asb", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '-' */45, @@ -4292,7 +4476,8 @@ function test49(param) { }), (function (s) { return s === "a"; }))) { - return Curry._1(Stdlib__Scanf.sscanf("-asb", /* Format */{ + return Curry._1(Stdlib__Scanf.sscanf("-asb", { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* '-' */45, @@ -4353,7 +4538,8 @@ function send_int(ob, i) { } function writer(ib, ob) { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4370,7 +4556,8 @@ function writer(ib, ob) { send_string(ob, "Hello World!"); return reader(ib, ob); case "stop" : - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -4400,7 +4587,8 @@ function reader(ib, ob) { send_string(ob, "start"); return writer(ib, ob); } else { - return Curry._1(Stdlib__Scanf.bscanf(ib, /* Format */{ + return Curry._1(Stdlib__Scanf.bscanf(ib, { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -4445,14 +4633,16 @@ function test50(param) { test("File \"jscomp/test/tscanf_test.ml\", line 1228, characters 5-12", go(undefined) === 100); function test51(param) { - if (Curry._1(Stdlib__Scanf.sscanf("Hello", /* Format */{ + if (Curry._1(Stdlib__Scanf.sscanf("Hello", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, _1: /* End_of_format */0 }, _1: "%s" - }), id) === "Hello" && Curry._1(Stdlib__Scanf.sscanf("Hello\n", /* Format */{ + }), id) === "Hello" && Curry._1(Stdlib__Scanf.sscanf("Hello\n", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4463,7 +4653,8 @@ function test51(param) { } }, _1: "%s\n" - }), id) === "Hello" && Curry._1(Stdlib__Scanf.sscanf("Hello\n", /* Format */{ + }), id) === "Hello" && Curry._1(Stdlib__Scanf.sscanf("Hello\n", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4480,7 +4671,8 @@ function test51(param) { _1: "%s%s\n" }), (function (s1, s2) { return s1 === "Hello" ? s2 === "" : false; - })) && Curry._1(Stdlib__Scanf.sscanf("Hello\nWorld", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("Hello\nWorld", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4500,7 +4692,8 @@ function test51(param) { _1: "%s\n%s%!" }), (function (s1, s2) { return s1 === "Hello" ? s2 === "World" : false; - })) && Curry._1(Stdlib__Scanf.sscanf("Hello\nWorld!", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("Hello\nWorld!", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4517,7 +4710,8 @@ function test51(param) { _1: "%s\n%s" }), (function (s1, s2) { return s1 === "Hello" ? s2 === "World!" : false; - })) && Curry._1(Stdlib__Scanf.sscanf("Hello\n", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("Hello\n", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4535,7 +4729,8 @@ function test51(param) { }), (function (s1, s2) { return s1 === "Hello" ? s2 === "" : false; }))) { - return Curry._1(Stdlib__Scanf.sscanf("Hello \n", /* Format */{ + return Curry._1(Stdlib__Scanf.sscanf("Hello \n", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4565,7 +4760,8 @@ function test51(param) { test("File \"jscomp/test/tscanf_test.ml\", line 1248, characters 5-12", test51(undefined)); function test52(param) { - if (Curry._1(Stdlib__Scanf.sscanf("Hello\n", /* Format */{ + if (Curry._1(Stdlib__Scanf.sscanf("Hello\n", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4576,7 +4772,8 @@ function test52(param) { } }, _1: "%s@\n" - }), id) === "Hello" && Curry._1(Stdlib__Scanf.sscanf("Hello", /* Format */{ + }), id) === "Hello" && Curry._1(Stdlib__Scanf.sscanf("Hello", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4587,7 +4784,8 @@ function test52(param) { } }, _1: "%s@\n" - }), id) === "Hello" && Curry._1(Stdlib__Scanf.sscanf("Hello", /* Format */{ + }), id) === "Hello" && Curry._1(Stdlib__Scanf.sscanf("Hello", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4604,7 +4802,8 @@ function test52(param) { _1: "%s%s@\n" }), (function (s1, s2) { return s1 === "Hello" ? s2 === "" : false; - })) && Curry._1(Stdlib__Scanf.sscanf("Hello\nWorld", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("Hello\nWorld", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4624,7 +4823,8 @@ function test52(param) { _1: "%s@\n%s%!" }), (function (s1, s2) { return s1 === "Hello" ? s2 === "World" : false; - })) && Curry._1(Stdlib__Scanf.sscanf("Hello\nWorld!", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("Hello\nWorld!", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4645,7 +4845,8 @@ function test52(param) { _1: "%s@\n%s@\n" }), (function (s1, s2) { return s1 === "Hello" ? s2 === "World!" : false; - })) && Curry._1(Stdlib__Scanf.sscanf("Hello\n", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("Hello\n", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4662,7 +4863,8 @@ function test52(param) { _1: "%s@\n%s" }), (function (s1, s2) { return s1 === "Hello" ? s2 === "" : false; - })) && Curry._1(Stdlib__Scanf.sscanf("Hello \n", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("Hello \n", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4679,7 +4881,8 @@ function test52(param) { _1: "%s%s@\n" }), (function (s1, s2) { return s1 === "Hello" ? s2 === " " : false; - })) && Curry._1(Stdlib__Scanf.sscanf("Hello \n", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("Hello \n", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4704,7 +4907,8 @@ function test52(param) { _1: "%s%s%_1[ ]\n" }), (function (s1, s2) { return s1 === "Hello" ? s2 === "" : false; - })) && Curry._1(Stdlib__Scanf.sscanf("Hello \n", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("Hello \n", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4729,7 +4933,8 @@ function test52(param) { _1: "%s%_1[ ]%s\n" }), (function (s1, s2) { return s1 === "Hello" ? s2 === "" : false; - })) && Curry._1(Stdlib__Scanf.sscanf("Hello\nWorld", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("Hello\nWorld", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4749,7 +4954,8 @@ function test52(param) { _1: "%s\n%s%!" }), (function (s1, s2) { return s1 === "Hello" ? s2 === "World" : false; - })) && Curry._1(Stdlib__Scanf.sscanf("Hello\nWorld!", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("Hello\nWorld!", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4769,7 +4975,8 @@ function test52(param) { _1: "%s\n%s%!" }), (function (s1, s2) { return s1 === "Hello" ? s2 === "World!" : false; - })) && Curry._1(Stdlib__Scanf.sscanf("Hello\nWorld!", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("Hello\nWorld!", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4796,7 +5003,8 @@ function test52(param) { _1: "%s\n%s@!%!" }), (function (s1, s2) { return s1 === "Hello" ? s2 === "World" : false; - })) && Curry._1(Stdlib__Scanf.sscanf("Hello{foo}", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("Hello{foo}", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4804,7 +5012,8 @@ function test52(param) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_tag */0, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -4820,7 +5029,8 @@ function test52(param) { }), (function (s1, s2) { return s1 === "Hello" ? s2 === "foo}" : false; }))) { - return Curry._1(Stdlib__Scanf.sscanf("Hello[foo]", /* Format */{ + return Curry._1(Stdlib__Scanf.sscanf("Hello[foo]", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -4828,7 +5038,8 @@ function test52(param) { TAG: /* Formatting_gen */18, _0: { TAG: /* Open_box */1, - _0: /* Format */{ + _0: { + TAG: /* Format */0, _0: /* End_of_format */0, _1: "" } @@ -4856,7 +5067,8 @@ function test52(param) { test("File \"jscomp/test/tscanf_test.ml\", line 1286, characters 5-12", test52(undefined)); function test53(param) { - if (Curry._1(Stdlib__Scanf.sscanf("123", /* Format */{ + if (Curry._1(Stdlib__Scanf.sscanf("123", { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -4865,7 +5077,8 @@ function test53(param) { _3: /* End_of_format */0 }, _1: "%d" - }), id) === 123 && Curry._1(Stdlib__Scanf.sscanf("124", /* Format */{ + }), id) === 123 && Curry._1(Stdlib__Scanf.sscanf("124", { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -4876,7 +5089,8 @@ function test53(param) { _1: "%d" }), (function (i) { return (i - 1 | 0) === 123; - })) && Curry._1(Stdlib__Scanf.sscanf("123", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("123", { + TAG: /* Format */0, _0: { TAG: /* Int32 */5, _0: /* Int_d */0, @@ -4885,7 +5099,8 @@ function test53(param) { _3: /* End_of_format */0 }, _1: "%ld" - }), id) === 123 && Curry._1(Stdlib__Scanf.sscanf("124", /* Format */{ + }), id) === 123 && Curry._1(Stdlib__Scanf.sscanf("124", { + TAG: /* Format */0, _0: { TAG: /* Int32 */5, _0: /* Int_d */0, @@ -4896,7 +5111,8 @@ function test53(param) { _1: "%ld" }), (function (i) { return (i + 1 | 0) === 125; - })) && Caml.i64_eq(Curry._1(Stdlib__Scanf.sscanf("123", /* Format */{ + })) && Caml.i64_eq(Curry._1(Stdlib__Scanf.sscanf("123", { + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_d */0, @@ -4909,7 +5125,8 @@ function test53(param) { 0, 123 ])) { - return Curry._1(Stdlib__Scanf.sscanf("124", /* Format */{ + return Curry._1(Stdlib__Scanf.sscanf("124", { + TAG: /* Format */0, _0: { TAG: /* Int64 */7, _0: /* Int_d */0, @@ -4933,7 +5150,8 @@ test("File \"jscomp/test/tscanf_test.ml\", line 1301, characters 5-12", test53(u function test56(param) { const g = function (s) { - return Curry._1(Stdlib__Scanf.sscanf(s, /* Format */{ + return Curry._1(Stdlib__Scanf.sscanf(s, { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -4975,7 +5193,8 @@ function test57(param) { const test_format_scan = function (s, fmt, efmt) { return Caml_obj.caml_equal(Stdlib__Scanf.format_from_string(s, fmt), efmt); }; - if (test_format_scan(" %i ", /* Format */{ + if (test_format_scan(" %i ", { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -4984,7 +5203,8 @@ function test57(param) { _3: /* End_of_format */0 }, _1: "%i" - }, /* Format */{ + }, { + TAG: /* Format */0, _0: { TAG: /* Char_literal */12, _0: /* ' ' */32, @@ -5001,7 +5221,8 @@ function test57(param) { } }, _1: " %i " - }) && test_format_scan("%i", /* Format */{ + }) && test_format_scan("%i", { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_d */0, @@ -5010,7 +5231,8 @@ function test57(param) { _3: /* End_of_format */0 }, _1: "%d" - }, /* Format */{ + }, { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -5019,7 +5241,8 @@ function test57(param) { _3: /* End_of_format */0 }, _1: "%i" - }) && test_format_scan("Read an int %i then a string %s.", /* Format */{ + }) && test_format_scan("Read an int %i then a string %s.", { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Spec", @@ -5044,7 +5267,8 @@ function test57(param) { } }, _1: "Spec%difi%scation" - }, /* Format */{ + }, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Read an int ", @@ -5069,7 +5293,8 @@ function test57(param) { } }, _1: "Read an int %i then a string %s." - }) && test_format_scan("Read an int %i then a string \"%s\".", /* Format */{ + }) && test_format_scan("Read an int %i then a string \"%s\".", { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Spec", @@ -5094,7 +5319,8 @@ function test57(param) { } }, _1: "Spec%difi%Scation" - }, /* Format */{ + }, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Read an int ", @@ -5119,7 +5345,8 @@ function test57(param) { } }, _1: "Read an int %i then a string \"%s\"." - }) && test_format_scan("Read an int %i then a string \"%s\".", /* Format */{ + }) && test_format_scan("Read an int %i then a string \"%s\".", { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Spec", @@ -5144,7 +5371,8 @@ function test57(param) { } }, _1: "Spec%difi%scation" - }, /* Format */{ + }, { + TAG: /* Format */0, _0: { TAG: /* String_literal */11, _0: "Read an int ", @@ -5170,7 +5398,8 @@ function test57(param) { }, _1: "Read an int %i then a string \"%s\"." })) { - return Curry._1(Stdlib__Scanf.sscanf("12 \"%i\"89 ", /* Format */{ + return Curry._1(Stdlib__Scanf.sscanf("12 \"%i\"89 ", { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -5203,7 +5432,8 @@ function test57(param) { }, _1: "%i %{%d%}%s %!" }), (function (i, f, s) { - if (i === 12 && Caml_obj.caml_equal(f, /* Format */{ + if (i === 12 && Caml_obj.caml_equal(f, { + TAG: /* Format */0, _0: { TAG: /* Int */4, _0: /* Int_i */3, @@ -5226,7 +5456,8 @@ function test57(param) { test("File \"jscomp/test/tscanf_test.ml\", line 1357, characters 5-12", test57(undefined)); function test58(param) { - if (Curry._1(Stdlib__Scanf.sscanf("string1%string2", /* Format */{ + if (Curry._1(Stdlib__Scanf.sscanf("string1%string2", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -5241,7 +5472,8 @@ function test58(param) { } }, _1: "%s@%%s" - }), id) === "string1" && Curry._1(Stdlib__Scanf.sscanf("string1%string2", /* Format */{ + }), id) === "string1" && Curry._1(Stdlib__Scanf.sscanf("string1%string2", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: /* No_padding */0, @@ -5258,7 +5490,8 @@ function test58(param) { _1: "%s@%%%s" }), (function (prim0, prim1) { return prim0 + prim1; - })) === "string1string2" && Curry._1(Stdlib__Scanf.sscanf("string1@string2", /* Format */{ + })) === "string1string2" && Curry._1(Stdlib__Scanf.sscanf("string1@string2", { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -5277,7 +5510,8 @@ function test58(param) { }), (function (prim0, prim1) { return prim0 + prim1; })) === "string1string2") { - return Curry._1(Stdlib__Scanf.sscanf("string1@%string2", /* Format */{ + return Curry._1(Stdlib__Scanf.sscanf("string1@%string2", { + TAG: /* Format */0, _0: { TAG: /* Scan_char_set */20, _0: undefined, @@ -5310,7 +5544,8 @@ test("File \"jscomp/test/tscanf_test.ml\", line 1367, characters 5-12", test58(u test("File \"jscomp/test/tscanf_test.ml\", line 1371, characters 14-21", true); function test60(param) { - if (Curry._1(Stdlib__Scanf.sscanf("abc", /* Format */{ + if (Curry._1(Stdlib__Scanf.sscanf("abc", { + TAG: /* Format */0, _0: { TAG: /* Scan_next_char */22, _0: { @@ -5328,7 +5563,8 @@ function test60(param) { _1: "%0c%0c%c%n" }), (function (c1, c2, c3, n) { return c1 === /* 'a' */97 && c2 === /* 'a' */97 && c3 === /* 'a' */97 ? n === 1 : false; - })) && Curry._1(Stdlib__Scanf.sscanf("abc", /* Format */{ + })) && Curry._1(Stdlib__Scanf.sscanf("abc", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: { @@ -5346,7 +5582,8 @@ function test60(param) { }), (function (s1, s2) { return s1 === "" ? s2 === "abc" : false; }))) { - return Curry._1(Stdlib__Scanf.sscanf("abc", /* Format */{ + return Curry._1(Stdlib__Scanf.sscanf("abc", { + TAG: /* Format */0, _0: { TAG: /* String */2, _0: { diff --git a/jscomp/test/dist/jscomp/test/typeof_test.js b/jscomp/test/dist/jscomp/test/typeof_test.js index 84cabb3bb1..e24f0385d0 100644 --- a/jscomp/test/dist/jscomp/test/typeof_test.js +++ b/jscomp/test/dist/jscomp/test/typeof_test.js @@ -6,7 +6,7 @@ const Mt = require("./mt.js"); function string_or_number(x) { const ty = Js__Js_types.classify(x); - if (typeof ty === "number") { + if (/* tag */typeof ty === "number" || typeof ty === "string") { switch (ty) { case /* JSFalse */0 : case /* JSTrue */1 : @@ -15,7 +15,7 @@ function string_or_number(x) { return false; } } else { - switch (ty.TAG | 0) { + switch (ty.TAG) { case /* JSNumber */0 : console.log(ty._0 + 3); return true; diff --git a/jscomp/test/dist/jscomp/test/variant.js b/jscomp/test/dist/jscomp/test/variant.js index 08f35d0712..22cd515c6a 100644 --- a/jscomp/test/dist/jscomp/test/variant.js +++ b/jscomp/test/dist/jscomp/test/variant.js @@ -8,14 +8,14 @@ const Curry = require("melange.js/curry.js"); const Stdlib = require("melange/stdlib.js"); function foo(n) { - if (typeof n === "number") { + if (/* tag */typeof n === "number" || typeof n === "string") { if (n === /* A1 */0) { return 1; } else { return 2; } } - switch (n.TAG | 0) { + switch (n.TAG) { case /* B */0 : return n._0; case /* C */1 : @@ -28,7 +28,7 @@ function foo(n) { } function fooA1(param) { - if (typeof param === "number" && !param) { + if (/* tag */(typeof param === "number" || typeof param === "string") && param === /* A1 */0) { return 1; } else { return 42; @@ -36,7 +36,7 @@ function fooA1(param) { } function fooC(param) { - if (typeof param === "number" || param.TAG !== /* C */1) { + if (/* tag */typeof param === "number" || typeof param === "string" || param.TAG !== /* C */1) { return 42; } else { return param._0 + param._1 | 0; @@ -89,7 +89,7 @@ function rollback_path(subst, p) { catch (raw_exn){ const exn = Caml_js_exceptions.internalToOCamlException(raw_exn); if (exn.MEL_EXN_ID === Stdlib.Not_found) { - switch (p.TAG | 0) { + switch (p.TAG) { case /* Pdot */1 : return "Pdot"; case /* Pident */0 : From 081d80c9101e760c2c12278ce742640dda87557d Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 29 Sep 2024 22:28:17 +0100 Subject: [PATCH 11/19] remove `comment` from `Const_string` --- jscomp/common/external_ffi_types.ml | 2 +- jscomp/common/lam_constant.ml | 6 +++--- jscomp/common/lam_constant.mli | 2 +- jscomp/core/lam.ml | 15 ++++++--------- jscomp/core/lam_compile_const.ml | 4 ++-- jscomp/core/lam_constant_convert.ml | 7 +++---- jscomp/core/lam_convert.cppo.ml | 4 ++-- jscomp/core/lam_pass_lets_dce.cppo.ml | 14 +++++++------- 8 files changed, 25 insertions(+), 29 deletions(-) diff --git a/jscomp/common/external_ffi_types.ml b/jscomp/common/external_ffi_types.ml index dde5f39629..fcabc4de4d 100644 --- a/jscomp/common/external_ffi_types.ml +++ b/jscomp/common/external_ffi_types.ml @@ -213,7 +213,7 @@ let inline_string_primitive (s : string) (op : string option) : string list = | Some op -> Utf8_string.is_unicode_string op | None -> false in - Const_string { s; unicode; comment = None } + Const_string { s; unicode } in [ ""; to_string (Ffi_inline_const lam) ] diff --git a/jscomp/common/lam_constant.ml b/jscomp/common/lam_constant.ml index 83921d54d1..b71d1ad74d 100644 --- a/jscomp/common/lam_constant.ml +++ b/jscomp/common/lam_constant.ml @@ -57,7 +57,7 @@ type t = | Const_js_false | Const_int of { i : int32; comment : pointer_info } | Const_char of char - | Const_string of { s : string; unicode : bool; comment : pointer_info } + | Const_string of { s : string; unicode : bool } | Const_float of string | Const_int64 of int64 | Const_pointer of string @@ -78,9 +78,9 @@ let rec eq_approx (x : t) (y : t) = | Const_js_false -> y = Const_js_false | Const_int ix -> ( match y with Const_int iy -> ix.i = iy.i | _ -> false) | Const_char ix -> ( match y with Const_char iy -> ix = iy | _ -> false) - | Const_string { s = sx; unicode = ux; comment = _ } -> ( + | Const_string { s = sx; unicode = ux } -> ( match y with - | Const_string { s = sy; unicode = uy; comment = _ } -> sx = sy && ux = uy + | Const_string { s = sy; unicode = uy } -> sx = sy && ux = uy | _ -> false) | Const_float ix -> ( match y with Const_float iy -> ix = iy | _ -> false) | Const_int64 ix -> ( match y with Const_int64 iy -> ix = iy | _ -> false) diff --git a/jscomp/common/lam_constant.mli b/jscomp/common/lam_constant.mli index 482e68f336..4501ed54c4 100644 --- a/jscomp/common/lam_constant.mli +++ b/jscomp/common/lam_constant.mli @@ -45,7 +45,7 @@ type t = | Const_js_false | Const_int of { i : int32; comment : pointer_info } | Const_char of char - | Const_string of { s : string; unicode : bool; comment : pointer_info } + | Const_string of { s : string; unicode : bool } | Const_float of string | Const_int64 of int64 | Const_pointer of string diff --git a/jscomp/core/lam.ml b/jscomp/core/lam.ml index 22ad0e4d36..bec0e244a6 100644 --- a/jscomp/core/lam.ml +++ b/jscomp/core/lam.ml @@ -458,7 +458,7 @@ let switch lam (lam_switch : lambda_switch) : t = let stringswitch (lam : t) cases default : t = match lam with - | Lconst (Const_string { s; unicode = false; comment = _ }) -> ( + | Lconst (Const_string { s; unicode = false }) -> ( match List.assoc s cases with | v -> v | exception Not_found -> Option.get default) @@ -519,10 +519,7 @@ module Lift = struct Lconst ((Const_nativeint b)) *) let int64 b : t = Lconst (Const_int64 b) - - let string s : t = - Lconst (Const_string { s; unicode = false; comment = None }) - + let string s : t = Lconst (Const_string { s; unicode = false }) let char b : t = Lconst (Const_char b) end @@ -538,7 +535,7 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t = Lift.int (Int32.of_float (float_of_string a)) (* | Pnegfloat -> Lift.float (-. a) *) (* | Pabsfloat -> Lift.float (abs_float a) *) - | Pstringlength, Const_string { s; unicode = false; comment = _ } -> + | Pstringlength, Const_string { s; unicode = false } -> Lift.int (Int32.of_int (String.length s)) (* | Pnegbint Pnativeint, ( (Const_nativeint i)) *) (* -> *) @@ -611,11 +608,11 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t = | Psequor, Const_js_false, Const_js_true -> true_ | Psequor, Const_js_false, Const_js_false -> false_ | ( Pstringadd, - Const_string { s = a; unicode = false; comment = _ }, - Const_string { s = b; unicode = false; comment = _ } ) -> + Const_string { s = a; unicode = false }, + Const_string { s = b; unicode = false } ) -> Lift.string (a ^ b) | ( (Pstringrefs | Pstringrefu), - Const_string { s = a; unicode = false; comment = _ }, + Const_string { s = a; unicode = false }, Const_int { i = b; _ } ) -> ( try Lift.char (String.get a (Int32.to_int b)) with _ -> default ()) | _ -> default ()) diff --git a/jscomp/core/lam_compile_const.ml b/jscomp/core/lam_compile_const.ml index bd43a08d82..a2083aafe4 100644 --- a/jscomp/core/lam_compile_const.ml +++ b/jscomp/core/lam_compile_const.ml @@ -75,8 +75,8 @@ and translate (x : Lam.Constant.t) : J.expression = Js_long.of_const i (* https://github.com/google/closure-library/blob/master/closure%2Fgoog%2Fmath%2Flong.js *) | Const_float f -> E.float f (* TODO: preserve float *) - | Const_string { s; unicode = false; comment = _ } -> E.str s - | Const_string { s; unicode = true; comment = _ } -> E.unicode s + | Const_string { s; unicode = false } -> E.str s + | Const_string { s; unicode = true } -> E.unicode s | Const_pointer name -> E.str name | Const_block (tag, tag_info, xs) -> Js_of_lam_block.make_block NA tag_info (E.small_int tag) diff --git a/jscomp/core/lam_constant_convert.ml b/jscomp/core/lam_constant_convert.ml index e8d5cd2480..73cf48f09c 100644 --- a/jscomp/core/lam_constant_convert.ml +++ b/jscomp/core/lam_constant_convert.ml @@ -69,13 +69,13 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam.Constant.t = | Some opt -> Melange_ffi.Utf8_string.is_unicode_string opt | _ -> false in - Const_string { s; unicode; comment = None } + Const_string { s; unicode } | Const_base (Const_float i, _) -> Const_float i | Const_base (Const_int32 i, _) -> Const_int { i; comment = None } | Const_base (Const_int64 i, _) -> Const_int64 i | Const_base (Const_nativeint _, _) -> assert false | Const_float_array s -> Const_float_array s - | Const_immstring s -> Const_string { s; unicode = false; comment = None } + | Const_immstring s -> Const_string { s; unicode = false } | Const_block (i, t, xs) -> ( match t with | Blk_some_not_nested -> Const_some (convert_constant (List.hd xs)) @@ -103,8 +103,7 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam.Constant.t = ( i, t, [ - Const_string { s; unicode = false; comment = None }; - convert_constant value; + Const_string { s; unicode = false }; convert_constant value; ] ) | _ -> assert false) | Blk_record s -> diff --git a/jscomp/core/lam_convert.cppo.ml b/jscomp/core/lam_convert.cppo.ml index 9c4f54dc4b..339cb10ba8 100644 --- a/jscomp/core/lam_convert.cppo.ml +++ b/jscomp/core/lam_convert.cppo.ml @@ -252,7 +252,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t = ~args: [ Lam.const - (Const_string { s; unicode = false; comment = None }); + (Const_string { s; unicode = false }); value; ] loc @@ -746,7 +746,7 @@ let convert (exports : Ident.Set.t) (lam : Lambda.lambda) : let args = List.map ~f:(convert_aux ~dynamic_import) args in if Ident.is_predef id then Lam.const - (Const_string { s = Ident.name id; unicode = false; comment = None }) + (Const_string { s = Ident.name id; unicode = false }) else ( may_depend may_depends (Lam_module_ident.of_ml ~dynamic_import id); assert (args = []); diff --git a/jscomp/core/lam_pass_lets_dce.cppo.ml b/jscomp/core/lam_pass_lets_dce.cppo.ml index 5f72e326cf..8c5a4647f9 100644 --- a/jscomp/core/lam_pass_lets_dce.cppo.ml +++ b/jscomp/core/lam_pass_lets_dce.cppo.ml @@ -67,7 +67,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t = *) -> Ident.Hash.add subst v (simplif l1); simplif l2 - | _, Lconst (Const_string { s; unicode = false; comment = _ }) -> + | _, Lconst (Const_string { s; unicode = false }) -> (* only "" added for later inlining *) Ident.Hash.add string_table v s; Lam.let_ Alias v l1 (simplif l2) @@ -118,7 +118,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t = | _ -> ( let l1 = simplif l1 in match l1 with - | Lconst (Const_string { s; unicode = false; comment = _ }) -> + | Lconst (Const_string { s; unicode = false }) -> Ident.Hash.add string_table v s; (* we need move [simplif lbody] later, since adding Hash does have side effect *) Lam.let_ Alias v l1 (simplif lbody) @@ -136,7 +136,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t = let l1 = simplif l1 in match (kind, l1) with - | Strict, Lconst (Const_string { s; unicode = false; comment = _ }) -> + | Strict, Lconst (Const_string { s; unicode = false }) -> Ident.Hash.add string_table v s; Lam.let_ Alias v l1 (simplif l2) | _ -> @@ -177,7 +177,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t = let r' = simplif r in let opt_l = match l' with - | Lconst (Const_string { s = ls; unicode = false; comment = _ }) -> Some ls + | Lconst (Const_string { s = ls; unicode = false }) -> Some ls | Lvar i -> Ident.Hash.find_opt string_table i | _ -> None in @@ -186,14 +186,14 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t = | Some l_s -> ( let opt_r = match r' with - | Lconst (Const_string { s = rs; unicode = false; comment = _ }) -> Some rs + | Lconst (Const_string { s = rs; unicode = false }) -> Some rs | Lvar i -> Ident.Hash.find_opt string_table i | _ -> None in match opt_r with | None -> Lam.prim ~primitive:Pstringadd ~args:[ l'; r' ] loc | Some r_s -> - Lam.const (Const_string { s = l_s ^ r_s; unicode = false; comment = None }))) + Lam.const (Const_string { s = l_s ^ r_s; unicode = false }))) | Lprim { primitive = (Pstringrefu | Pstringrefs) as primitive; @@ -205,7 +205,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t = let r' = simplif r in let opt_l = match l' with - | Lconst (Const_string { s = ls; unicode = false; comment = _ }) -> Some ls + | Lconst (Const_string { s = ls; unicode = false }) -> Some ls | Lvar i -> Ident.Hash.find_opt string_table i | _ -> None in From 928fd511db17330e21eddd5c5fcde4a2fe0cf0fb Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Mon, 30 Sep 2024 00:32:59 +0100 Subject: [PATCH 12/19] remove attributes from Pt_constructor --- jscomp/common/lam_constant.ml | 7 +------ jscomp/common/lam_constant.mli | 7 +------ jscomp/core/lam_constant_convert.ml | 7 +------ 3 files changed, 3 insertions(+), 18 deletions(-) diff --git a/jscomp/common/lam_constant.ml b/jscomp/common/lam_constant.ml index b71d1ad74d..f46950ea43 100644 --- a/jscomp/common/lam_constant.ml +++ b/jscomp/common/lam_constant.ml @@ -26,12 +26,7 @@ open Import type pointer_info = | None - | Pt_constructor of { - name : Lambda.cstr_name; - const : int; - non_const : int; - attributes : Parsetree.attributes; - } + | Pt_constructor of { name : Lambda.cstr_name; const : int; non_const : int } | Pt_assertfalse | Some of string diff --git a/jscomp/common/lam_constant.mli b/jscomp/common/lam_constant.mli index 4501ed54c4..555e1860ff 100644 --- a/jscomp/common/lam_constant.mli +++ b/jscomp/common/lam_constant.mli @@ -26,12 +26,7 @@ open Import type pointer_info = | None - | Pt_constructor of { - name : Lambda.cstr_name; - const : int; - non_const : int; - attributes : Parsetree.attributes; - } + | Pt_constructor of { name : Lambda.cstr_name; const : int; non_const : int } | Pt_assertfalse | Some of string diff --git a/jscomp/core/lam_constant_convert.ml b/jscomp/core/lam_constant_convert.ml index 73cf48f09c..6cc235680d 100644 --- a/jscomp/core/lam_constant_convert.ml +++ b/jscomp/core/lam_constant_convert.ml @@ -50,12 +50,7 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam.Constant.t = i = Int32.of_int i; comment = Pt_constructor - { - name = modifier ~name attributes; - const; - non_const; - attributes; - }; + { name = modifier ~name attributes; const; non_const }; } | Pt_constructor_access { cstr_name } -> Const_pointer From 771827277fbbcc5ae0f5e43f228d778ca827154e Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Mon, 30 Sep 2024 00:34:17 +0100 Subject: [PATCH 13/19] demonstrate bug compiling empty list with `[@mel.as]` --- test/blackbox-tests/mel-as-variants-lists.t | 75 +++++++++++++++++++++ test/blackbox-tests/variants-as-strings.t | 28 -------- 2 files changed, 75 insertions(+), 28 deletions(-) create mode 100644 test/blackbox-tests/mel-as-variants-lists.t diff --git a/test/blackbox-tests/mel-as-variants-lists.t b/test/blackbox-tests/mel-as-variants-lists.t new file mode 100644 index 0000000000..cbc9144240 --- /dev/null +++ b/test/blackbox-tests/mel-as-variants-lists.t @@ -0,0 +1,75 @@ + + $ . ./setup.sh + $ cat > dune-project < (lang dune 3.9) + > (using melange 0.1) + > EOF + + $ cat > dune < (melange.emit + > (target js-out) + > (preprocess (pps melange.ppx)) + > (emit_stdlib false)) + > EOF + + $ cat > x.ml < type (_, _) x = + > | [] : ('a, 'a) x + > | ( :: ) : 'a * ('ty, 'v) x -> ('a -> 'ty, 'v) x + > let rec f : type a b. (a, string ref) x -> string = + > fun x -> match x with [] -> "empty" | _ :: xs -> f xs + > EOF + + $ dune build @melange + $ cat ./_build/default/js-out/x.js + // Generated by Melange + 'use strict'; + + + function f(_x) { + while(true) { + const x = _x; + if (!x) { + return "empty"; + } + _x = x.tl; + continue ; + }; + } + + exports.f = f; + /* No side effect */ + + $ cat > x.ml < type (_, _) x = + > | [] : ('a, 'a) x [@mel.as "lol"] + > | ( :: ) : 'a * ('ty, 'v) x -> ('a -> 'ty, 'v) x + > + > let x : _ x = [] + > + > let rec f : type a b. (a, string ref) x -> string = + > fun x -> match x with [] -> "empty" | _ :: xs -> f xs + > EOF + + $ dune build @melange + $ cat ./_build/default/js-out/x.js + // Generated by Melange + 'use strict'; + + + function f(_x) { + while(true) { + const x = _x; + if (!x) { + return "empty"; + } + _x = x.tl; + continue ; + }; + } + + const x = /* [] */"lol"; + + exports.x = x; + exports.f = f; + /* No side effect */ diff --git a/test/blackbox-tests/variants-as-strings.t b/test/blackbox-tests/variants-as-strings.t index 524bebe484..26fb7bb8a4 100644 --- a/test/blackbox-tests/variants-as-strings.t +++ b/test/blackbox-tests/variants-as-strings.t @@ -51,34 +51,6 @@ exports.g = g; /* No side effect */ - $ cat > x.ml < type (_, _) x = - > | [] : ('a, 'a) x - > | ( :: ) : 'a * ('ty, 'v) x -> ('a -> 'ty, 'v) x - > let rec f : type a b. (a, string ref) x -> string = - > fun x -> match x with [] -> "empty" | _ :: xs -> f xs - > EOF - - $ dune build @melange - $ cat ./_build/default/js-out/x.js - // Generated by Melange - 'use strict'; - - - function f(_x) { - while(true) { - const x = _x; - if (!x) { - return "empty"; - } - _x = x.tl; - continue ; - }; - } - - exports.f = f; - /* No side effect */ - $ cat > x.ml < type x = A [@mel.as "A"] | B > let f x = match x with A -> "a" | B -> "b" From 1b9ee565830ddd06303aa3e887bcc40debed5aef Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Mon, 30 Sep 2024 00:36:35 +0100 Subject: [PATCH 14/19] fix: don't compile `[]` to a string --- jscomp/core/lam_constant_convert.ml | 10 ++++++---- test/blackbox-tests/mel-as-variants-lists.t | 2 +- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/jscomp/core/lam_constant_convert.ml b/jscomp/core/lam_constant_convert.ml index 6cc235680d..9171577f7e 100644 --- a/jscomp/core/lam_constant_convert.ml +++ b/jscomp/core/lam_constant_convert.ml @@ -25,10 +25,12 @@ open Import let modifier ~name attributes = - match Record_attributes_check.find_mel_as_name attributes with - | Some (String s) -> { Lambda.name; as_modifier = Some (String s) } - | Some (Int modifier) -> { name; as_modifier = Some (Int modifier) } - | None -> { name; as_modifier = None } + if name = "[]" then { Lambda.name; as_modifier = None } + else + match Record_attributes_check.find_mel_as_name attributes with + | Some (String s) -> { Lambda.name; as_modifier = Some (String s) } + | Some (Int modifier) -> { name; as_modifier = Some (Int modifier) } + | None -> { name; as_modifier = None } let rec convert_constant (const : Lambda.structured_constant) : Lam.Constant.t = match const with diff --git a/test/blackbox-tests/mel-as-variants-lists.t b/test/blackbox-tests/mel-as-variants-lists.t index cbc9144240..599e9ac8c3 100644 --- a/test/blackbox-tests/mel-as-variants-lists.t +++ b/test/blackbox-tests/mel-as-variants-lists.t @@ -68,7 +68,7 @@ }; } - const x = /* [] */"lol"; + const x = /* [] */0; exports.x = x; exports.f = f; From 2e32ef91e92b725e4e075623ee9ecc54d767993e Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Mon, 30 Sep 2024 00:37:57 +0100 Subject: [PATCH 15/19] chore: update submodule --- flake.lock | 19 +++++++++---------- flake.nix | 2 +- vendor/melange-compiler-libs | 2 +- 3 files changed, 11 insertions(+), 12 deletions(-) diff --git a/flake.lock b/flake.lock index 38f8609133..55f3605b03 100644 --- a/flake.lock +++ b/flake.lock @@ -28,16 +28,15 @@ ] }, "locked": { - "lastModified": 1727270848, + "lastModified": 1727645950, "narHash": "sha256-xJmVyAQ4FQyPojnUiuGpwfCTpVnTEO4jhxGIMDys4Ps=", "owner": "melange-re", "repo": "melange-compiler-libs", - "rev": "7170f7d2c8cead7d18c4872de661426a73aac6ce", + "rev": "bd6a2fb5ec54936ba7aa789965f2af1d0f1e1bf4", "type": "github" }, "original": { "owner": "melange-re", - "ref": "anmonteiro/mel-as-variants", "repo": "melange-compiler-libs", "type": "github" } @@ -65,11 +64,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1727565345, - "narHash": "sha256-Jiga8utNl57DxigI2/vyhQwKVpmfthf9TNTXCDu5uhw=", + "lastModified": 1727644383, + "narHash": "sha256-5zVGeKR/NEazNsjwlIgoxjHzvf1W0O7V5DFAc97sLek=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "c175754cfb3e8c2fdc2bb7a6b989426313f0665c", + "rev": "9eb3220e9898a1209d824aafebb3f7b10cf89cd6", "type": "github" }, "original": { @@ -80,17 +79,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1727506465, - "narHash": "sha256-3kTzEJ3X+RmNB9hamk+HnRj4MVLuZ2nzGaT1IeKuHZg=", + "lastModified": 1727631725, + "narHash": "sha256-3BhOfmcg9Pxjm/kU+IVYe76CvHL6zArK9ktlCJeP06E=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "0c839cfcda894af2030d5731414542a92a7af207", + "rev": "b5c4f45cfcaa5a44632c7119922987e131249cd2", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "0c839cfcda894af2030d5731414542a92a7af207", + "rev": "b5c4f45cfcaa5a44632c7119922987e131249cd2", "type": "github" } }, diff --git a/flake.nix b/flake.nix index 2942f4791b..6c2896b172 100644 --- a/flake.nix +++ b/flake.nix @@ -11,7 +11,7 @@ melange-compiler-libs = { # this changes rarely, and it's better than having to rely on nix's poor # support for submodules - url = "github:melange-re/melange-compiler-libs/anmonteiro/mel-as-variants"; + url = "github:melange-re/melange-compiler-libs"; inputs.flake-utils.follows = "flake-utils"; inputs.nixpkgs.follows = "nixpkgs"; }; diff --git a/vendor/melange-compiler-libs b/vendor/melange-compiler-libs index 7170f7d2c8..bd6a2fb5ec 160000 --- a/vendor/melange-compiler-libs +++ b/vendor/melange-compiler-libs @@ -1 +1 @@ -Subproject commit 7170f7d2c8cead7d18c4872de661426a73aac6ce +Subproject commit bd6a2fb5ec54936ba7aa789965f2af1d0f1e1bf4 From 5a0fa84185194a78baeb0a9bcf5b76dd1978ebf0 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Mon, 30 Sep 2024 00:41:43 +0100 Subject: [PATCH 16/19] show that `[@mel.as ".."]` in `(::)` has no effect --- test/blackbox-tests/mel-as-variants-lists.t | 41 +++++++++++++++++++++ 1 file changed, 41 insertions(+) diff --git a/test/blackbox-tests/mel-as-variants-lists.t b/test/blackbox-tests/mel-as-variants-lists.t index 599e9ac8c3..03fc8d40b0 100644 --- a/test/blackbox-tests/mel-as-variants-lists.t +++ b/test/blackbox-tests/mel-as-variants-lists.t @@ -73,3 +73,44 @@ exports.x = x; exports.f = f; /* No side effect */ + + $ cat > x.ml < type (_, _) x = + > | [] : ('a, 'a) x [@mel.as "lol"] + > | ( :: ) : 'a * ('ty, 'v) x -> ('a -> 'ty, 'v) x [@mel.as "different"] + > + > let x : _ x = [] + > let y : _ x = [ 2 ] + > + > let rec f : type a b. (a, string ref) x -> string = + > fun x -> match x with [] -> "empty" | _ :: xs -> f xs + > EOF + + $ dune build @melange + $ cat ./_build/default/js-out/x.js + // Generated by Melange + 'use strict'; + + + function f(_x) { + while(true) { + const x = _x; + if (!x) { + return "empty"; + } + _x = x.tl; + continue ; + }; + } + + const x = /* [] */0; + + const y = { + hd: 2, + tl: /* [] */0 + }; + + exports.x = x; + exports.y = y; + exports.f = f; + /* No side effect */ From d9ec75a990fb47836a4002a06fb147cf9890887a Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Mon, 30 Sep 2024 00:42:31 +0100 Subject: [PATCH 17/19] test: runtime test and snapshot for `[@mel.as ".."]` --- .../test/dist/jscomp/test/mel_ast_variants.js | 182 ++++++++++++++++++ jscomp/test/mel_ast_variants.ml | 96 +++++++++ 2 files changed, 278 insertions(+) create mode 100644 jscomp/test/dist/jscomp/test/mel_ast_variants.js create mode 100644 jscomp/test/mel_ast_variants.ml diff --git a/jscomp/test/dist/jscomp/test/mel_ast_variants.js b/jscomp/test/dist/jscomp/test/mel_ast_variants.js new file mode 100644 index 0000000000..fd814a351b --- /dev/null +++ b/jscomp/test/dist/jscomp/test/mel_ast_variants.js @@ -0,0 +1,182 @@ +// Generated by Melange +'use strict'; + + +function toEnum(x) { + switch (x) { + case /* A */0 : + return 0; + case /* B */1 : + return 1; + case /* C */2 : + return 2; + case /* D */3 : + return 3; + case /* E */4 : + return 4; + + } +} + +function toString(x) { + switch (x) { + case /* A */0 : + return "A"; + case /* B */1 : + return "B"; + case /* C */2 : + return "C"; + case /* D */3 : + return "D"; + case /* E */4 : + return "E"; + + } +} + +function bar(x) { + switch (x) { + case /* A */0 : + case /* E */4 : + return 10; + default: + return 0; + } +} + +function and_(x, y) { + if (x === /* True */0 && y === /* True */0) { + return /* True */0; + } else { + return /* False */1; + } +} + +function id(x) { + if (x === /* True */0) { + return /* True */0; + } else { + return /* False */1; + } +} + +function not_(x) { + if (x === /* True */0) { + return /* False */1; + } else { + return /* True */0; + } +} + +function st(state) { + if (/* tag */typeof state === "number" || typeof state === "string") { + return 0; + } else { + return 23; + } +} + +function showToJs(x) { + if (/* tag */(typeof x === "number" || typeof x === "string") && x === /* No */0) { + return false; + } else { + return true; + } +} + +function third(l) { + if (!l) { + return false; + } + const match = l.hd; + if (match[0] !== 1 || match[1] !== 2 || match[2] !== 3 || l.tl) { + return false; + } else { + return true; + } +} + +function third2(l) { + if (/* tag */typeof l === "number" || typeof l === "string") { + return false; + } + if (l._0 !== 1) { + return false; + } + const match = l._1; + if (/* tag */typeof match === "number" || typeof match === "string") { + return false; + } + if (match._0 !== 2) { + return false; + } + const match$1 = match._1; + if (/* tag */typeof match$1 === "number" || typeof match$1 === "string") { + return false; + } + if (match$1._0 !== 3) { + return false; + } + let tmp = match$1._1; + if (/* tag */typeof tmp === "number" || typeof tmp === "string") { + return true; + } else { + return false; + } +} + +function foo(x) { + if (/* tag */typeof x === "number" || typeof x === "string") { + switch (x) { + case /* A */"dd" : + return 1; + case /* B */12 : + return 2; + case /* C */2 : + return 3; + + } + } else { + switch (x.TAG) { + case /* D */"qq" : + return 4; + case /* E */42 : + return 5; + case /* F */2 : + return 6; + + } + } +} + +const CustomizeTags_d = { + TAG: /* D */"qq", + _0: 42 +}; + +const CustomizeTags_e = { + TAG: /* E */42, + _0: 0 +}; + +const CustomizeTags = { + foo: foo, + a: /* A */"dd", + b: /* B */12, + c: /* C */2, + d: CustomizeTags_d, + e: CustomizeTags_e +}; + +exports.toEnum = toEnum; +exports.toString = toString; +exports.bar = bar; +exports.and_ = and_; +exports.id = id; +exports.not_ = not_; +exports.st = st; +exports.showToJs = showToJs; +exports.third = third; +exports.third2 = third2; +exports.CustomizeTags = CustomizeTags; +/* No side effect */ diff --git a/jscomp/test/mel_ast_variants.ml b/jscomp/test/mel_ast_variants.ml new file mode 100644 index 0000000000..3bb520fbf7 --- /dev/null +++ b/jscomp/test/mel_ast_variants.ml @@ -0,0 +1,96 @@ +type t = A | B | C | D | E + +let toEnum x = + match x with + | A -> 0 + | B -> 1 + | C -> 2 + | D -> 3 + | E -> 4 + +let toString x = + match x with + | A -> "A" + | B -> "B" + | C -> "C" + | D -> "D" + | E -> "E" + +let bar x = + match x with + | A -> 10 + | B | C | D -> 0 + | E -> 10 + +type b = True | False + +let and_ x y = + match (x, y) with + | (True, False) -> False + | (False, True) -> False + | (False, False) -> False + | (True, True) -> True + +let id x = + match x with + | True -> True + | False -> False + +let not_ x = + match x with + | True -> False + | False -> True + +type state = + | Empty + | Int1 of int + | Int2 of int +let st state = + match state with + | Empty -> 0 + | Int2 intValue + | Int1 intValue -> 23 + +type show = No | After of int | Yes + +let showToJs x = + match x with + | Yes | After _ -> true + | No -> false + +let third l = + match l with + | [1, 2, 3] -> true + | _ -> false + +type lst = Empty | Cons of int * lst + +let third2 l = + match l with + | Cons(1, Cons(2, Cons(3, Empty))) -> true + | _ -> false + +module CustomizeTags = struct + type t = + | A [@mel.as "dd"] + | B [@mel.as 12] + | C + | D of int [@mel.as "qq"] + | E of int [@mel.as 42] + | F of string + + let foo x = + match x with + | A -> 1 + | B -> 2 + | C -> 3 + | D(_) -> 4 + | E(_) -> 5 + | F(_) -> 6 + + let a = A + let b = B + let c = C + let d = D(42) + let e = E(0) +end From 492a06c3562a307f4d5b401fe34303487df9055e Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Thu, 3 Oct 2024 08:20:55 -0700 Subject: [PATCH 18/19] update flakes --- flake.lock | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/flake.lock b/flake.lock index 55f3605b03..f3295a9068 100644 --- a/flake.lock +++ b/flake.lock @@ -64,11 +64,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1727644383, - "narHash": "sha256-5zVGeKR/NEazNsjwlIgoxjHzvf1W0O7V5DFAc97sLek=", + "lastModified": 1727925592, + "narHash": "sha256-oAw/EkdsEwmr6cHP7I/yf2t0pcJLUrZ6EQUHqCGSV1U=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "9eb3220e9898a1209d824aafebb3f7b10cf89cd6", + "rev": "9025b11d490991bd3ac499013c447d099d8403ce", "type": "github" }, "original": { @@ -79,17 +79,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1727631725, - "narHash": "sha256-3BhOfmcg9Pxjm/kU+IVYe76CvHL6zArK9ktlCJeP06E=", + "lastModified": 1727881951, + "narHash": "sha256-sEtvFBr/Qml+A/22AJgv/cb032WTabqneyd1iWA/yv0=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "b5c4f45cfcaa5a44632c7119922987e131249cd2", + "rev": "0cb8a47c862b6b0d4387bfd491574424eb252658", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "b5c4f45cfcaa5a44632c7119922987e131249cd2", + "rev": "0cb8a47c862b6b0d4387bfd491574424eb252658", "type": "github" } }, From 4628536ab289b4a72b27fba03784e427a4a26e28 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Thu, 3 Oct 2024 13:42:53 -0700 Subject: [PATCH 19/19] add option test --- flake.lock | 14 ++-- test/blackbox-tests/mel-as-variants-option.t | 73 ++++++++++++++++++++ 2 files changed, 80 insertions(+), 7 deletions(-) create mode 100644 test/blackbox-tests/mel-as-variants-option.t diff --git a/flake.lock b/flake.lock index f3295a9068..ce632f4e89 100644 --- a/flake.lock +++ b/flake.lock @@ -64,11 +64,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1727925592, - "narHash": "sha256-oAw/EkdsEwmr6cHP7I/yf2t0pcJLUrZ6EQUHqCGSV1U=", + "lastModified": 1727987141, + "narHash": "sha256-wJLCtS1HhFhTBqN0+F2Wrcq/ilsbDvjzFTqejVN7xfg=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "9025b11d490991bd3ac499013c447d099d8403ce", + "rev": "614db0fa6bc7ee19b844f39ac944cebd45b38f4f", "type": "github" }, "original": { @@ -79,17 +79,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1727881951, - "narHash": "sha256-sEtvFBr/Qml+A/22AJgv/cb032WTabqneyd1iWA/yv0=", + "lastModified": 1727968508, + "narHash": "sha256-2rDTgqMf84us7lARphOGRxnr5Q4nJ0RAQsCKYWeRsmI=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "0cb8a47c862b6b0d4387bfd491574424eb252658", + "rev": "e873268a358f13746037e5ae3e88aa7aa626b9cf", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "0cb8a47c862b6b0d4387bfd491574424eb252658", + "rev": "e873268a358f13746037e5ae3e88aa7aa626b9cf", "type": "github" } }, diff --git a/test/blackbox-tests/mel-as-variants-option.t b/test/blackbox-tests/mel-as-variants-option.t new file mode 100644 index 0000000000..c658f1be1b --- /dev/null +++ b/test/blackbox-tests/mel-as-variants-option.t @@ -0,0 +1,73 @@ + + $ . ./setup.sh + $ cat > dune-project < (lang dune 3.9) + > (using melange 0.1) + > EOF + + $ cat > dune < (melange.emit + > (target js-out) + > (preprocess (pps melange.ppx)) + > (emit_stdlib false)) + > EOF + + $ cat > x.ml < type 'a x = Some of 'a | None + > let x : _ x = None + > let y : _ x = Some 42 + > let f : type a. a x -> unit = + > fun x -> match x with None -> () | Some x -> Js.log2 "some" x + > EOF + + $ dune build @melange + $ cat ./_build/default/js-out/x.js + // Generated by Melange + 'use strict'; + + const Caml_option = require("melange.js/caml_option.js"); + + function f(x) { + if (x !== undefined) { + console.log("some", Caml_option.valFromOption(x)); + return ; + } + + } + + let x; + + const y = 42; + + exports.x = x; + exports.y = y; + exports.f = f; + /* No side effect */ + + $ cat > x.ml < type 'a x = Some of 'a [@mel.as "This_is_ignored"] | None + > let x: _ x = Some 42 + > let f : type a. a x -> unit = + > fun x -> match x with None -> () | Some x -> Js.log2 "some" x + > EOF + + $ dune build @melange + $ cat ./_build/default/js-out/x.js + // Generated by Melange + 'use strict'; + + const Caml_option = require("melange.js/caml_option.js"); + + function f(x) { + if (x !== undefined) { + console.log("some", Caml_option.valFromOption(x)); + return ; + } + + } + + const x = 42; + + exports.x = x; + exports.f = f; + /* No side effect */