Rename Lambda.apply_position

Author: stedolan

asmcomp/cmm.ml

@@ -148,7 +148,7 @@ type memory_chunk =
   | Double
 
 and operation =
-    Capply of machtype * Lambda.apply_position
+    Capply of machtype * Lambda.region_close
   | Cextcall of string * machtype * exttype list * bool
   | Cload of memory_chunk * Asttypes.mutable_flag
   | Calloc of Lambda.alloc_mode

asmcomp/cmm.mli

@@ -139,7 +139,7 @@ type memory_chunk =
                                           see PR#10433 *)
 
 and operation =
-    Capply of machtype * Lambda.apply_position
+    Capply of machtype * Lambda.region_close
   | Cextcall of string * machtype * exttype list * bool
       (** The [machtype] is the machine type of the result.
           The [exttype list] describes the unboxing types of the arguments.

asmcomp/cmm_helpers.ml

@@ -1846,14 +1846,14 @@ let has_local_allocs e =
 let remove_region_tail e =
   let rec has_tail = function
     | Ctail _
-    | Cop(Capply(_, Apply_tail), _, _) -> raise Exit
+    | Cop(Capply(_, Rc_close_at_apply), _, _) -> raise Exit
     | Cregion _ -> ()
     | e -> ignore (iter_shallow_tail has_tail e)
   in
   let rec remove_tail = function
     | Ctail e -> e
-    | Cop(Capply(mach, Apply_tail), args, dbg) ->
-       Cop(Capply(mach, Apply_nontail), args, dbg)
+    | Cop(Capply(mach, Rc_close_at_apply), args, dbg) ->
+       Cop(Capply(mach, Rc_normal), args, dbg)
     | Cregion _ as e -> e
     | e ->
        map_shallow_tail remove_tail e
@@ -1891,15 +1891,15 @@ let apply_function_body (arity, (mode : Lambda.alloc_mode)) =
   let clos = V.create_local "clos" in
   let rec app_fun clos n =
     if n = arity-1 then
-      Cop(Capply(typ_val, Apply_nontail),
+      Cop(Capply(typ_val, Rc_normal),
           [get_field_gen Asttypes.Mutable (Cvar clos) 0 (dbg ());
            Cvar arg.(n);
            Cvar clos],
           dbg ())
     else begin
       let newclos = V.create_local "clos" in
       Clet(VP.create newclos,
-           Cop(Capply(typ_val, Apply_nontail),
+           Cop(Capply(typ_val, Rc_normal),
                [get_field_gen Asttypes.Mutable (Cvar clos) 0 (dbg ());
                 Cvar arg.(n); Cvar clos], dbg ()),
            app_fun newclos (n+1))
@@ -1914,7 +1914,7 @@ let apply_function_body (arity, (mode : Lambda.alloc_mode)) =
                         Cconst_int(pos_arity_in_closinfo, dbg())], dbg());
                    Cconst_int(arity, dbg())], dbg()),
    dbg (),
-   Cop(Capply(typ_val, Apply_nontail),
+   Cop(Capply(typ_val, Rc_normal),
        get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ())
        :: List.map (fun s -> Cvar s) all_args,
        dbg ()),
@@ -2007,7 +2007,7 @@ let tuplify_function arity =
    {fun_name;
     fun_args = [VP.create arg, typ_val; VP.create clos, typ_val];
     fun_body =
-      Cop(Capply(typ_val, Apply_nontail),
+      Cop(Capply(typ_val, Rc_normal),
           get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ())
           :: access_components 0 @ [Cvar clos],
           (dbg ()));
@@ -2050,7 +2050,7 @@ let final_curry_function ~nlocal ~arity =
   let last_clos = V.create_local "clos" in
   let rec curry_fun args clos n =
     if n = 0 then
-      Cop(Capply(typ_val, Apply_nontail),
+      Cop(Capply(typ_val, Rc_normal),
           get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ()) ::
             args @ [Cvar last_arg; Cvar clos],
           dbg ())
@@ -2134,7 +2134,7 @@ let rec intermediate_curry_functions ~nlocal ~arity num =
           let direct_args = iter (num+2) in
           let rec iter i args clos =
             if i = 0 then
-              Cop(Capply(typ_val, Apply_nontail),
+              Cop(Capply(typ_val, Rc_normal),
                   (get_field_gen Asttypes.Mutable (Cvar clos) 2 (dbg ()))
                   :: args @ [Cvar clos],
                   dbg ())
@@ -2693,7 +2693,7 @@ let entry_point namelist =
     List.fold_right
       (fun name next ->
         let entry_sym = Compilenv.make_symbol ~unitname:name (Some "entry") in
-        Csequence(Cop(Capply(typ_void, Apply_nontail),
+        Csequence(Cop(Capply(typ_void, Rc_normal),
                          [cconst_symbol entry_sym], dbg ()),
                   Csequence(incr_global_inited (), next)))
       namelist (cconst_int 1) in

asmcomp/selectgen.ml

@@ -1095,7 +1095,7 @@ method emit_tail (env:environment) exp =
   | Cphantom_let (_var, _defining_expr, body) ->
       self#emit_tail env body
   | Cop((Capply(ty, pos)) as op, args, dbg) ->
-      let tail = (pos = Lambda.Apply_tail) in
+      let tail = (pos = Lambda.Rc_close_at_apply) in
       let endregion = env.region_tail in
       begin match self#emit_parts_list env' args with
         None -> ()

bytecomp/bytegen.ml

@@ -685,7 +685,7 @@ let rec comp_expr env exp sz cont =
         ap_loc=loc;
         ap_func=func;
         ap_args=[arg];
-        ap_position=pos;
+        ap_region_close=pos;
         ap_mode=Alloc_heap;
         ap_tailcall=Default_tailcall;
         ap_inlined=Default_inlined;

lambda/lambda.ml

@@ -50,17 +50,17 @@ type alloc_mode =
   | Alloc_heap
   | Alloc_local
 
-type apply_position =
-  | Apply_tail
-  | Apply_nontail
+type region_close =
+  | Rc_normal
+  | Rc_close_at_apply
 
 type primitive =
   | Pidentity
   | Pbytes_to_string
   | Pbytes_of_string
   | Pignore
-  | Prevapply of apply_position
-  | Pdirapply of apply_position
+  | Prevapply of region_close
+  | Pdirapply of region_close
     (* Globals *)
   | Pgetglobal of Ident.t
   | Psetglobal of Ident.t
@@ -356,7 +356,7 @@ type lambda =
   | Lassign of Ident.t * lambda
   | Lsend of
       meth_kind * lambda * lambda * lambda list
-      * apply_position * alloc_mode * scoped_location
+      * region_close * alloc_mode * scoped_location
   | Levent of lambda * lambda_event
   | Lifused of Ident.t * lambda
   | Lregion of lambda
@@ -374,7 +374,7 @@ and lfunction =
 and lambda_apply =
   { ap_func : lambda;
     ap_args : lambda list;
-    ap_position : apply_position;
+    ap_region_close : region_close;
     ap_mode : alloc_mode;
     ap_loc : scoped_location;
     ap_tailcall : tailcall_attribute;
@@ -912,12 +912,12 @@ let duplicate lam =
 let shallow_map ~tail ~non_tail:f = function
   | Lvar _
   | Lconst _ as lam -> lam
-  | Lapply { ap_func; ap_args; ap_position; ap_mode; ap_loc; ap_tailcall;
+  | Lapply { ap_func; ap_args; ap_region_close; ap_mode; ap_loc; ap_tailcall;
              ap_inlined; ap_specialised; ap_probe } ->
       Lapply {
         ap_func = f ap_func;
         ap_args = List.map f ap_args;
-        ap_position;
+        ap_region_close;
         ap_mode;
         ap_loc;
         ap_tailcall;

lambda/lambda.mli

@@ -57,17 +57,18 @@ type alloc_mode =
   | Alloc_heap
   | Alloc_local
 
-type apply_position =
-  | Apply_tail
-  | Apply_nontail
+(* Tail calls can close their enclosing region early *)
+type region_close =
+  | Rc_normal
+  | Rc_close_at_apply
 
 type primitive =
   | Pidentity
   | Pbytes_to_string
   | Pbytes_of_string
   | Pignore
-  | Prevapply of apply_position
-  | Pdirapply of apply_position
+  | Prevapply of region_close
+  | Pdirapply of region_close
     (* Globals *)
   | Pgetglobal of Ident.t
   | Psetglobal of Ident.t
@@ -326,7 +327,7 @@ type lambda =
   | Lfor of Ident.t * lambda * lambda * direction_flag * lambda
   | Lassign of Ident.t * lambda
   | Lsend of meth_kind * lambda * lambda * lambda list
-             * apply_position * alloc_mode * scoped_location
+             * region_close * alloc_mode * scoped_location
   | Levent of lambda * lambda_event
   | Lifused of Ident.t * lambda
   | Lregion of lambda
@@ -346,7 +347,7 @@ and lfunction =
 and lambda_apply =
   { ap_func : lambda;
     ap_args : lambda list;
-    ap_position : apply_position;
+    ap_region_close : region_close;
     ap_mode : alloc_mode;
     ap_loc : scoped_location;
     ap_tailcall : tailcall_attribute;

lambda/matching.ml

@@ -1846,7 +1846,7 @@ let inline_lazy_force_cond arg pos loc =
                       ap_loc = loc;
                       ap_func = force_fun;
                       ap_args = [ varg ];
-                      ap_position = pos;
+                      ap_region_close = pos;
                       ap_mode = Alloc_heap;
                       ap_inlined = Default_inlined;
                       ap_specialised = Default_specialise;
@@ -1882,7 +1882,7 @@ let inline_lazy_force_switch arg pos loc =
                           ap_loc = loc;
                           ap_func = force_fun;
                           ap_args = [ varg ];
-                          ap_position = pos;
+                          ap_region_close = pos;
                           ap_mode = Alloc_heap;
                           ap_inlined = Default_inlined;
                           ap_specialised = Default_specialise;
@@ -1904,7 +1904,7 @@ let inline_lazy_force arg pos loc =
         ap_loc = loc;
         ap_func = Lazy.force code_force_lazy;
         ap_args = [ arg ];
-        ap_position = pos;
+        ap_region_close = pos;
         ap_mode = Alloc_heap;
         ap_inlined = Default_inlined;
         ap_specialised = Default_specialise;
@@ -1922,7 +1922,7 @@ let inline_lazy_force arg pos loc =
 
 let get_expr_args_lazy ~scopes head (arg, _mut) rem =
   let loc = head_loc ~scopes head in
-  (inline_lazy_force arg Apply_nontail loc, Strict) :: rem
+  (inline_lazy_force arg Rc_normal loc, Strict) :: rem
 
 let divide_lazy ~scopes head ctx pm =
   divide_line (Context.specialize head)

lambda/matching.mli

@@ -51,4 +51,4 @@ val expand_stringswitch:
     scoped_location -> lambda -> (string * lambda) list ->
     lambda option -> lambda
 
-val inline_lazy_force : lambda -> apply_position -> scoped_location -> lambda
+val inline_lazy_force : lambda -> region_close -> scoped_location -> lambda

lambda/printlambda.ml

@@ -580,8 +580,8 @@ let apply_probe ppf = function
 let apply_kind name pos mode =
   let name =
     match pos with
-    | Apply_nontail -> name
-    | Apply_tail -> name ^ "tail"
+    | Rc_normal -> name
+    | Rc_close_at_apply -> name ^ "tail"
   in
   name ^ alloc_kind mode
 
@@ -593,7 +593,7 @@ let rec lam ppf = function
   | Lapply ap ->
       let lams ppf largs =
         List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
-      let form = apply_kind "apply" ap.ap_position ap.ap_mode in
+      let form = apply_kind "apply" ap.ap_region_close ap.ap_mode in
       fprintf ppf "@[<2>(%s@ %a%a%a%a%a%a)@]" form
         lam ap.ap_func lams ap.ap_args
         apply_tailcall_attribute ap.ap_tailcall