From 8173fe61184e599d19670ab1ad1defe366ed3784 Mon Sep 17 00:00:00 2001 From: Dmitry Zakharov Date: Sat, 17 Aug 2024 19:53:13 +0400 Subject: [PATCH] Remove backend for lazy --- jscomp/core/js_dump.ml | 2 +- jscomp/core/js_exp_make.ml | 2 +- jscomp/core/lam_constant_convert.ml | 2 +- jscomp/core/lam_convert.ml | 29 +---------- jscomp/ml/lambda.ml | 3 -- jscomp/ml/lambda.mli | 3 +- jscomp/ml/printlambda.ml | 1 - jscomp/ml/printtyped.ml | 3 -- jscomp/ml/rec_check.ml | 6 +-- jscomp/ml/tast_mapper.ml | 2 - jscomp/ml/translcore.ml | 5 -- jscomp/ml/typecore.ml | 15 +----- jscomp/ml/typedtree.ml | 1 - jscomp/ml/typedtree.mli | 1 - jscomp/ml/typedtreeIter.ml | 1 - jscomp/ml/typedtreeMap.ml | 1 - jscomp/ml/typeopt.ml | 77 ----------------------------- jscomp/ml/typeopt.mli | 12 ----- jscomp/ml/untypeast.ml | 1 - 19 files changed, 8 insertions(+), 159 deletions(-) diff --git a/jscomp/core/js_dump.ml b/jscomp/core/js_dump.ml index a09885ae2f..74caf68d7e 100644 --- a/jscomp/core/js_dump.ml +++ b/jscomp/core/js_dump.ml @@ -823,7 +823,7 @@ and expression_desc cxt ~(level : int) f x : cxt = ( _, _, _, - (Blk_module_export _ | Blk_some | Blk_some_not_nested | Blk_lazy_general) + (Blk_module_export _ | Blk_some | Blk_some_not_nested) ) -> assert false | Caml_block (el, mutable_flag, _tag, Blk_tuple) -> diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index 229a99337b..c3b68ed12d 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -254,7 +254,7 @@ let dummy_obj ?comment (info : Lam_tag_info.t) : t = { comment; expression_desc = Object [] } | Blk_tuple | Blk_module_export _ -> { comment; expression_desc = Array ([], Mutable) } - | Blk_some | Blk_some_not_nested | Blk_lazy_general -> assert false + | Blk_some | Blk_some_not_nested -> assert false (* TODO: complete pure ... diff --git a/jscomp/core/lam_constant_convert.ml b/jscomp/core/lam_constant_convert.ml index 91e2201a1d..435301e97c 100644 --- a/jscomp/core/lam_constant_convert.ml +++ b/jscomp/core/lam_constant_convert.ml @@ -83,4 +83,4 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t = in Const_block (tag, t, [ tag_val; convert_constant value ]) | _ -> assert false) - | Blk_lazy_general -> assert false) + ) diff --git a/jscomp/core/lam_convert.ml b/jscomp/core/lam_convert.ml index 442dfe4ab1..1bb705a661 100644 --- a/jscomp/core/lam_convert.ml +++ b/jscomp/core/lam_convert.ml @@ -34,14 +34,6 @@ let lam_extension_id = fun loc (head : Lam.t) -> prim ~primitive:lam_caml_id ~args:[ head ] loc -let lazy_block_info : Lam_tag_info.t = - Blk_record - { - fields = [| Literals.lazy_done; Literals.lazy_val |]; - mutable_flag = Mutable; - record_repr = Record_regular; - } - (** A conservative approach to avoid packing exceptions for lambda expression like {[ try { ... }catch(id){body} @@ -195,26 +187,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t = ~args:[ Lam.const tag_val; value ] loc | _ -> assert false) - | Blk_lazy_general -> ( - match args with - | [ ((Lvar _ | Lconst _ | Lfunction _) as result) ] -> - let args = [ Lam.const Const_js_true; result ] in - prim - ~primitive:(Pmakeblock (tag, lazy_block_info, Mutable)) - ~args loc - | [ computation ] -> - let args = - [ - Lam.const Const_js_false; - (* FIXME: arity 0 does not get proper supported*) - Lam.function_ ~arity:0 ~params:[] ~body:computation - ~attr:Lambda.default_function_attribute; - ] - in - prim - ~primitive:(Pmakeblock (tag, lazy_block_info, Mutable)) - ~args loc - | _ -> assert false)) + ) | Pfield (id, info) -> prim ~primitive:(Pfield (id, info)) ~args loc | Psetfield (id, info) -> prim ~primitive:(Psetfield (id, info)) ~args loc | Pduprecord -> prim ~primitive:Pduprecord ~args loc diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index 8b7489402f..0e2c5ec234 100644 --- a/jscomp/ml/lambda.ml +++ b/jscomp/ml/lambda.ml @@ -52,7 +52,6 @@ type tag_info = | Blk_some | Blk_some_not_nested (* ['a option] where ['a] can not inhabit a non-like value *) | Blk_record_ext of { fields : string array; mutable_flag : Asttypes.mutable_flag} - | Blk_lazy_general let tag_of_tag_info (tag : tag_info ) = match tag with @@ -66,7 +65,6 @@ let tag_of_tag_info (tag : tag_info ) = | Blk_extension | Blk_some (* tag not make sense *) | Blk_some_not_nested (* tag not make sense *) - | Blk_lazy_general (* tag not make sense 248 *) | Blk_record_ext _ (* similar to Blk_extension*) -> 0 @@ -75,7 +73,6 @@ let mutable_flag_of_tag_info (tag : tag_info) = | Blk_record_inlined {mutable_flag} | Blk_record {mutable_flag} | Blk_record_ext {mutable_flag} -> mutable_flag - | Blk_lazy_general -> Mutable | Blk_tuple | Blk_constructor _ | Blk_poly_var _ diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index 87125870c5..57c0879c18 100644 --- a/jscomp/ml/lambda.mli +++ b/jscomp/ml/lambda.mli @@ -60,8 +60,7 @@ type tag_info = | Blk_some | Blk_some_not_nested (* ['a option] where ['a] can not inhabit a non-like value *) - | Blk_record_ext of {fields : string array; mutable_flag : mutable_flag} - | Blk_lazy_general + | Blk_record_ext of {fields : string array; mutable_flag : mutable_flag} val find_name : Parsetree.attribute -> Asttypes.label option diff --git a/jscomp/ml/printlambda.ml b/jscomp/ml/printlambda.ml index 4dc4e7705e..475966b9df 100644 --- a/jscomp/ml/printlambda.ml +++ b/jscomp/ml/printlambda.ml @@ -115,7 +115,6 @@ let print_taginfo ppf = function | Blk_module ss -> fprintf ppf "[%s]" (String.concat ";" ss) | Blk_some -> fprintf ppf "some" | Blk_some_not_nested -> fprintf ppf "some_not_nested" - | Blk_lazy_general -> fprintf ppf "lazy_general" | Blk_module_export _ -> fprintf ppf "module/exports" | Blk_record_inlined {fields = ss } -> fprintf ppf "[%s]" (String.concat ";" (Array.to_list ss) ) diff --git a/jscomp/ml/printtyped.ml b/jscomp/ml/printtyped.ml index 5b514ac36e..e9d07c976e 100644 --- a/jscomp/ml/printtyped.ml +++ b/jscomp/ml/printtyped.ml @@ -386,9 +386,6 @@ and expression i ppf x = | Texp_assert (e) -> line i ppf "Texp_assert"; expression i ppf e; - | Texp_lazy (e) -> - line i ppf "Texp_lazy"; - expression i ppf e; | Texp_object () -> () | Texp_pack me -> diff --git a/jscomp/ml/rec_check.ml b/jscomp/ml/rec_check.ml index a31f7f555a..6342ea84f4 100644 --- a/jscomp/ml/rec_check.ml +++ b/jscomp/ml/rec_check.ml @@ -191,7 +191,7 @@ let rec classify_expression : Typedtree.expression -> sd = | Texp_ident _ | Texp_for _ | Texp_constant _ | Texp_new _ | Texp_instvar _ | Texp_tuple _ | Texp_array _ | Texp_construct _ | Texp_variant _ | Texp_record _ | Texp_setfield _ | Texp_while _ | Texp_setinstvar _ - | Texp_pack _ | Texp_object _ | Texp_function _ | Texp_lazy _ + | Texp_pack _ | Texp_object _ | Texp_function _ | Texp_unreachable | Texp_extension_constructor _ -> Static | Texp_apply ({ exp_desc = Texp_ident (_, _, vd) }, _) when is_ref vd -> @@ -292,10 +292,6 @@ let rec expression : Env.env -> Typedtree.expression -> Use.t = | Texp_override () -> assert false | Texp_function { cases } -> Use.delay (list (case ~scrutinee:Use.empty) env cases) - | Texp_lazy e -> ( - match Typeopt.classify_lazy_argument e with - | `Constant_or_function | `Identifier _ | `Float -> expression env e - | `Other -> Use.delay (expression env e)) | Texp_unreachable -> Use.empty | Texp_extension_constructor _ -> Use.empty diff --git a/jscomp/ml/tast_mapper.ml b/jscomp/ml/tast_mapper.ml index 76c2e72fc2..0ed530927d 100644 --- a/jscomp/ml/tast_mapper.ml +++ b/jscomp/ml/tast_mapper.ml @@ -305,8 +305,6 @@ let expr sub x = ) | Texp_assert exp -> Texp_assert (sub.expr sub exp) - | Texp_lazy exp -> - Texp_lazy (sub.expr sub exp) | Texp_object () -> Texp_object () | Texp_pack mexpr -> diff --git a/jscomp/ml/translcore.ml b/jscomp/ml/translcore.ml index d73468ced0..d770b74d0f 100644 --- a/jscomp/ml/translcore.ml +++ b/jscomp/ml/translcore.ml @@ -996,11 +996,6 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda = | Texp_assert cond -> if !Clflags.noassert then lambda_unit else Lifthenelse (transl_exp cond, lambda_unit, assert_failed e) - | Texp_lazy e -> - (* when e needs no computation (constants, identifiers, ...), we - optimize the translation just as Lazy.lazy_from_val would - do *) - Lprim (Pmakeblock Blk_lazy_general, [ transl_exp e ], e.exp_loc) | Texp_object () -> assert false | Texp_unreachable -> raise (Error (e.exp_loc, Unreachable_reached)) diff --git a/jscomp/ml/typecore.ml b/jscomp/ml/typecore.ml index fc502f263e..42c208dfcb 100644 --- a/jscomp/ml/typecore.ml +++ b/jscomp/ml/typecore.ml @@ -1607,7 +1607,6 @@ let rec is_nonexpansive exp = | Texp_new _ -> assert false (* Note: nonexpansive only means no _observable_ side effects *) - | Texp_lazy e -> is_nonexpansive e | Texp_object () -> assert false | Texp_letmodule (_, _, mexp, e) -> @@ -2710,18 +2709,8 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg=Rejected) env sexp ty exp_attributes = sexp.pexp_attributes; exp_env = env; } - | Pexp_lazy e -> - let ty = newgenvar () in - let to_unify = Predef.type_lazy_t ty in - unify_exp_types loc env to_unify ty_expected; - let arg = type_expect env e ty in - re { - exp_desc = Texp_lazy arg; - exp_loc = loc; exp_extra = []; - exp_type = instance env ty_expected; - exp_attributes = sexp.pexp_attributes; - exp_env = env; - } + | Pexp_lazy _ -> + assert false | Pexp_object _ -> assert false | Pexp_poly(sbody, sty) -> let ty, cty = diff --git a/jscomp/ml/typedtree.ml b/jscomp/ml/typedtree.ml index 3cc1b9bbc4..07ee68b935 100644 --- a/jscomp/ml/typedtree.ml +++ b/jscomp/ml/typedtree.ml @@ -109,7 +109,6 @@ and expression_desc = | Texp_letmodule of Ident.t * string loc * module_expr * expression | Texp_letexception of extension_constructor * expression | Texp_assert of expression - | Texp_lazy of expression | Texp_object of unit | Texp_pack of module_expr | Texp_unreachable diff --git a/jscomp/ml/typedtree.mli b/jscomp/ml/typedtree.mli index 60eea19bc4..e28cdf3039 100644 --- a/jscomp/ml/typedtree.mli +++ b/jscomp/ml/typedtree.mli @@ -223,7 +223,6 @@ and expression_desc = | Texp_letmodule of Ident.t * string loc * module_expr * expression | Texp_letexception of extension_constructor * expression | Texp_assert of expression - | Texp_lazy of expression | Texp_object of unit | Texp_pack of module_expr | Texp_unreachable diff --git a/jscomp/ml/typedtreeIter.ml b/jscomp/ml/typedtreeIter.ml index 5c5c0de70e..0b6b0edf42 100644 --- a/jscomp/ml/typedtreeIter.ml +++ b/jscomp/ml/typedtreeIter.ml @@ -325,7 +325,6 @@ module MakeIterator(Iter : IteratorArgument) : sig iter_extension_constructor cd; iter_expression exp | Texp_assert exp -> iter_expression exp - | Texp_lazy exp -> iter_expression exp | Texp_object () -> () | Texp_pack (mexpr) -> diff --git a/jscomp/ml/typedtreeMap.ml b/jscomp/ml/typedtreeMap.ml index 9899275b97..b0eed3d8bf 100644 --- a/jscomp/ml/typedtreeMap.ml +++ b/jscomp/ml/typedtreeMap.ml @@ -342,7 +342,6 @@ module MakeMap(Map : MapArgument) = struct map_expression exp ) | Texp_assert exp -> Texp_assert (map_expression exp) - | Texp_lazy exp -> Texp_lazy (map_expression exp) | Texp_object () -> Texp_object () | Texp_pack (mexpr) -> diff --git a/jscomp/ml/typeopt.ml b/jscomp/ml/typeopt.ml index 565cc3b799..4867448338 100644 --- a/jscomp/ml/typeopt.ml +++ b/jscomp/ml/typeopt.ml @@ -17,7 +17,6 @@ open Types -open Asttypes open Typedtree open Lambda @@ -122,79 +121,3 @@ let maybe_pointer_type env ty = Immediate let maybe_pointer exp = maybe_pointer_type exp.exp_env exp.exp_type - -type classification = - | Int - | Float - | Lazy - | Addr (* anything except a float or a lazy *) - | Any - -let classify env ty = - let ty = scrape_ty env ty in - if maybe_pointer_type env ty = Immediate then Int - else match ty.desc with - | Tvar _ | Tunivar _ -> - Any - | Tconstr (p, _args, _abbrev) -> - if Path.same p Predef.path_float then Float - else if Path.same p Predef.path_lazy_t then Lazy - else if Path.same p Predef.path_string - || Path.same p Predef.path_bytes - || Path.same p Predef.path_array - || Path.same p Predef.path_int64 then Addr - else begin - try - match (Env.find_type p env).type_kind with - | Type_abstract -> - Any - | Type_record _ | Type_variant _ | Type_open -> - Addr - with Not_found -> - (* This can happen due to e.g. missing -I options, - causing some .cmi files to be unavailable. - Maybe we should emit a warning. *) - Any - end - | Tarrow _ | Ttuple _ | Tpackage _ | Tobject _ | Tnil | Tvariant _ -> - Addr - | Tlink _ | Tsubst _ | Tpoly _ | Tfield _ -> - assert false - - - - - - - -(** Whether a forward block is needed for a lazy thunk on a value, i.e. - if the value can be represented as a float/forward/lazy *) -let lazy_val_requires_forward env ty = - match classify env ty with - | Any | Lazy -> true - | Float (*-> Config.flat_float_array*) - | Addr | Int -> false - -(** The compilation of the expression [lazy e] depends on the form of e: - constants, floats and identifiers are optimized. The optimization must be - taken into account when determining whether a recursive binding is safe. *) -let classify_lazy_argument : Typedtree.expression -> - [`Constant_or_function - |`Float - |`Identifier of [`Forward_value|`Other] - |`Other] = - fun e -> match e.exp_desc with - | Texp_constant - ( Const_int _ | Const_char _ | Const_string _ - | Const_int32 _ | Const_int64 _ | Const_bigint _ ) - | Texp_function _ - | Texp_construct (_, {cstr_arity = 0}, _) -> - `Constant_or_function - | Texp_constant(Const_float _) -> - `Float - | Texp_ident _ when lazy_val_requires_forward e.exp_env e.exp_type -> - `Identifier `Forward_value - | Texp_ident _ -> - `Identifier `Other - | _ -> - `Other diff --git a/jscomp/ml/typeopt.mli b/jscomp/ml/typeopt.mli index d0d5dffcc4..e3a152b7df 100644 --- a/jscomp/ml/typeopt.mli +++ b/jscomp/ml/typeopt.mli @@ -23,19 +23,7 @@ val maybe_pointer_type : Env.t -> Types.type_expr -> Lambda.immediate_or_pointer val maybe_pointer : Typedtree.expression -> Lambda.immediate_or_pointer - - - - - -val classify_lazy_argument : Typedtree.expression -> - [ `Constant_or_function - | `Float - | `Identifier of [`Forward_value | `Other] - | `Other] - val type_cannot_contain_undefined: Types.type_expr -> Env.t -> bool - diff --git a/jscomp/ml/untypeast.ml b/jscomp/ml/untypeast.ml index 74fb0d1dba..29b4faa802 100644 --- a/jscomp/ml/untypeast.ml +++ b/jscomp/ml/untypeast.ml @@ -436,7 +436,6 @@ let expression sub exp = Pexp_letexception (sub.extension_constructor sub ext, sub.expr sub exp) | Texp_assert exp -> Pexp_assert (sub.expr sub exp) - | Texp_lazy exp -> Pexp_lazy (sub.expr sub exp) | Texp_object () -> assert false | Texp_pack (mexpr) ->