diff options
Diffstat (limited to 'bytecomp/lambda.ml')
| -rw-r--r-- | bytecomp/lambda.ml | 38 |
1 files changed, 16 insertions, 22 deletions
diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml index d4cc29a066..2fcbbf11a4 100644 --- a/bytecomp/lambda.ml +++ b/bytecomp/lambda.ml @@ -166,22 +166,6 @@ type inline_attribute = | Never_inline (* [@inline never] *) | Default_inline (* no [@inline] attribute *) -type apply_info = { - apply_loc : Location.t; - apply_should_be_tailcall : bool; (* true if [@tailcall] was specified *) - apply_inlined : inline_attribute; (* specified with [@inlined] attribute *) -} - -let mk_apply_info ?(tailcall=false) ?(inlined_attribute=Default_inline) loc = - {apply_loc=loc; - apply_should_be_tailcall=tailcall; - apply_inlined=inlined_attribute;} - -let no_apply_info = - {apply_loc=Location.none; - apply_should_be_tailcall=false; - apply_inlined=Default_inline;} - type function_kind = Curried | Tupled type let_kind = Strict | Alias | StrictOpt | Variable @@ -197,7 +181,7 @@ type function_attribute = { type lambda = Lvar of Ident.t | Lconst of structured_constant - | Lapply of lambda * lambda list * apply_info + | Lapply of lambda_apply | Lfunction of lfunction | Llet of let_kind * Ident.t * lambda * lambda | Lletrec of (Ident.t * lambda) list * lambda @@ -222,6 +206,13 @@ and lfunction = body: lambda; attr: function_attribute; } (* specified with [@inline] attribute *) +and lambda_apply = + { ap_func : lambda; + ap_args : lambda list; + ap_loc : Location.t; + ap_should_be_tailcall : bool; + ap_inlined : inline_attribute } + and lambda_switch = { sw_numconsts: int; sw_consts: (int * lambda) list; @@ -275,8 +266,10 @@ let make_key e = (* Mutable constants are not shared *) raise Not_simple | Lconst _ -> e - | Lapply (e,es,info) -> - Lapply (tr_rec env e,tr_recs env es,{info with apply_loc=Location.none}) + | Lapply ap -> + Lapply {ap with ap_func = tr_rec env ap.ap_func; + ap_args = tr_recs env ap.ap_args; + ap_loc = Location.none} | Llet (Alias,x,ex,e) -> (* Ignore aliases -> substitute *) let ex = tr_rec env ex in tr_rec (Ident.add x ex env) e @@ -357,7 +350,7 @@ let iter_opt f = function let iter f = function Lvar _ | Lconst _ -> () - | Lapply(fn, args, _) -> + | Lapply{ap_func = fn; ap_args = args} -> f fn; List.iter f args | Lfunction{kind; params; body} -> f body @@ -504,9 +497,10 @@ let subst_lambda s lam = Lvar id as l -> begin try Ident.find_same id s with Not_found -> l end | Lconst sc as l -> l - | Lapply(fn, args, loc) -> Lapply(subst fn, List.map subst args, loc) + | Lapply ap -> + Lapply{ap with ap_func = subst ap.ap_func; ap_args = List.map subst ap.ap_args} | Lfunction{kind; params; body; attr} -> - Lfunction{kind; params; body = subst body; attr} + Lfunction{kind; params; body = subst body; attr} | Llet(str, id, arg, body) -> Llet(str, id, subst arg, subst body) | Lletrec(decl, body) -> Lletrec(List.map subst_decl decl, subst body) | Lprim(p, args) -> Lprim(p, List.map subst args) |