use record for Lprim

Author: Hongbo Zhang

jscomp/lam.ml

@@ -29,14 +29,18 @@ type switch =
     sw_numblocks: int;
     sw_blocks: (int * t) list;
     sw_failaction : t option}
+and prim_info = 
+  { primitive : primitive ; 
+    args : t list ; 
+  }
 and t = 
   | Lvar of Ident.t
   | Lconst of Lambda.structured_constant
   | Lapply of t * t list * Lambda.apply_info
   | Lfunction of int * Lambda.function_kind  * Ident.t list * t
   | Llet of Lambda.let_kind * Ident.t * t * t
   | Lletrec of (Ident.t * t) list * t
-  | Lprim of primitive * t list * int 
+  | Lprim of prim_info
   | Lswitch of t * switch
   | Lstringswitch of t * (string * t) list * t option
   | Lstaticraise of int * t list
@@ -223,8 +227,8 @@ let lift_int32 b : t =
 let lift_int64 b : t =
   Lconst (Const_base (Const_int64 b))
 
-let prim (prim : Prim.t) (ll : t list) len : t = 
-  let default () : t = Lprim(prim,ll, len) in 
+let prim (prim : Prim.t) (ll : t list)  : t = 
+  let default () : t = Lprim { primitive = prim ;args =  ll } in 
   match ll with 
   | [Lconst a] -> 
     begin match prim, a  with 
@@ -366,7 +370,7 @@ let prim (prim : Prim.t) (ll : t list) len : t =
 
 
 let not x : t = 
-  prim Pnot [x] 1 
+  prim Pnot [x] 
 
 
 let rec convert (lam : Lambda.lambda) : t = 
@@ -383,9 +387,9 @@ let rec convert (lam : Lambda.lambda) : t =
   | Lletrec (bindings,body)
     -> 
     Lletrec (List.map (fun (id, e) -> id, convert e) bindings, convert body)
-  | Lprim (prim,args) 
+  | Lprim (primitive,args) 
     -> 
-    Lprim (prim,List.map convert args, List.length args)
+    Lprim {primitive ; args = List.map convert args }
   | Lswitch (e,s) -> 
     Lswitch (convert e, convert_switch s)
   | Lstringswitch (e, cases, default) -> 

jscomp/lam.mli

@@ -31,14 +31,18 @@ type switch  =
     sw_numblocks: int;
     sw_blocks: (int * t) list;
     sw_failaction : t option}
+and prim_info = private
+  { primitive : primitive ; 
+    args : t list ; 
+  }
 and  t =  private
   | Lvar of Ident.t
   | Lconst of Lambda.structured_constant
   | Lapply of t * t list * Lambda.apply_info
   | Lfunction of int (* length *) * Lambda.function_kind * Ident.t list * t
   | Llet of Lambda.let_kind * Ident.t * t * t
   | Lletrec of (Ident.t * t) list * t
-  | Lprim of primitive * t list * int (* length *)
+  | Lprim of prim_info
   | Lswitch of t * switch
   | Lstringswitch of t * (string * t) list * t option
   | Lstaticraise of int * t list
@@ -97,7 +101,7 @@ val send :
   t -> t -> t list -> 
   Location.t -> t 
 
-val prim : Lambda.primitive -> t list -> int -> t
+val prim : Lambda.primitive -> t list ->  t
 
 val staticcatch : 
   t -> int * Ident.t list -> t -> t

jscomp/lam_analysis.ml

@@ -32,7 +32,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
   | Lvar _ 
   | Lconst _ 
   | Lfunction _ -> true
-  | Lprim (primitive, args, _) -> 
+  | Lprim {primitive;  args; _} -> 
     List.for_all no_side_effects args && 
     (
       match primitive with 
@@ -186,11 +186,12 @@ let rec no_side_effects (lam : Lam.t) : bool =
       if it [Not_found], there are no other exceptions 
       can be thrown
   *)
-  | Ltrywith (Lprim(Pccall{prim_name = "caml_sys_getenv"}, 
-                    [Lconst _], _),exn,
-              Lifthenelse(Lprim(_, [Lvar exn1; 
-                                    Lprim(Pgetglobal ({name="Not_found"}),[],_)]
-                               , _),
+  | Ltrywith (Lprim { primitive = Pccall{prim_name = "caml_sys_getenv"};
+                    args = [Lconst _]; _},exn,
+              Lifthenelse(Lprim{args =  
+                                  [Lvar exn1; 
+                                   Lprim {primitive = Pgetglobal ({name="Not_found"}); args = []; _}]
+                               ; _},
                           then_, _)) when Ident.same exn1 exn
     (** we might put this in an optimization pass 
         also make sure when we wrap this in [js] we 
@@ -235,11 +236,13 @@ let rec size (lam : Lam.t) =
     | Lconst c -> size_constant c
     | Llet(_, _, l1, l2) -> 1 + size l1 + size l2 
     | Lletrec _ -> really_big ()
-    | Lprim(Pfield _, [Lprim(Pgetglobal _, [  ], _)], _)
+    | Lprim{primitive = Pfield _; 
+            args =  [Lprim { primitive = Pgetglobal _; args =  [  ];  _}]
+           ;  _}
       -> 1
-    | Lprim (Praise _, [l ], _) 
+    | Lprim {primitive = Praise _; args =  [l ];  _} 
       -> size l
-    | Lprim(_, ll, _) -> size_lams 1 ll
+    | Lprim {args = ll; _} -> size_lams 1 ll
 
     (** complicated 
         1. inline this function
@@ -299,8 +302,9 @@ let rec eq_lambda (l1 : Lam.t) (l2 : Lam.t) =
     id = id1 && List.for_all2 eq_lambda ls ls1 
   | Llet (_,_,_,_), Llet (_,_,_,_) -> false 
   | Lletrec _, Lletrec _ -> false 
-  | Lprim (p,ls,len1), Lprim (p1,ls1,len2) -> 
-    len1 = len2 && eq_primitive p p1 && List.for_all2 eq_lambda ls ls1
+  | Lprim {primitive = p; args = ls; } ,
+    Lprim {primitive = p1; args = ls1} -> 
+    eq_primitive p p1 && List.for_all2 eq_lambda ls ls1
   | Lswitch _, Lswitch _ -> false  
   | Lstringswitch _ , Lstringswitch _ -> false 
   | Lstaticcatch _, Lstaticcatch _ -> false 
@@ -402,7 +406,7 @@ let free_variables (export_idents : Ident_set.t ) (params : stats Ident_map.t )
       iter top  fn; 
       let top = new_env fn top in
       List.iter (iter top ) args  
-    | Lprim(_p, args,_) -> 
+    | Lprim {args ; _} -> 
       (* Check: can top be propoaged for all primitives *)
       List.iter (iter top) args
     | Lfunction(_, _kind, params, body) ->

jscomp/lam_beta_reduce.ml

@@ -115,9 +115,9 @@ let rewrite (map :   (Ident.t, _) Hashtbl.t)
       let l3 = aux l3 in
       Lam.for_ ident (aux  l1)  l2 dir  l3
     | Lconst _ -> lam
-    | Lprim(prim, ll) ->
+    | Lprim {primitive; args } ->
       (* here it makes sure that global vars are not rebound *)      
-      Lam.prim prim (List.map aux  ll)
+      Lam.prim primitive (List.map aux  args)
     | Lapply(fn, args, info) ->
       let fn = aux fn in       
       let args = List.map aux  args in 
@@ -234,13 +234,13 @@ let propogate_beta_reduce
                Hashtbl.add meta.ident_tbl param ident_info 
            end;
            arg 
-         | Lprim (Pgetglobal ident, []) -> 
+         | Lprim {primitive = Pgetglobal ident;  args = [];  _} -> 
            (* It's not completeness, its to make it sound.. *)
            Lam_compile_global.query_lambda ident meta.env 
          (* alias meta param ident (Module (Global ident)) Strict *)
-         | Lprim (Pmakeblock (_, _, Immutable ) , ls) -> 
+         | Lprim {primitive = Pmakeblock (_, _, Immutable) ;args ; _} -> 
            Hashtbl.replace meta.ident_tbl param 
-             (Lam_util.kind_of_lambda_block Normal ls ); (** *)
+             (Lam_util.kind_of_lambda_block Normal args ); (** *)
            arg
          | _ -> arg in
        Lam_util.refine_let param arg l) 
@@ -257,7 +257,7 @@ let propogate_beta_reduce_with_map
          match arg with          
          | Lconst _
          | Lvar _  -> rest_bindings , arg :: acc 
-         | Lprim (Pgetglobal ident, [])
+         | Lprim {primitive = Pgetglobal ident; args = []}
            (* TODO: we can pass Global, but you also need keep track of it*)
            ->
            let p = Ident.rename old_param in 
@@ -292,13 +292,13 @@ let propogate_beta_reduce_with_map
                Hashtbl.add meta.ident_tbl param ident_info 
            end;
            arg 
-         | Lprim (Pgetglobal ident, []) -> 
+         | Lprim {primitive = Pgetglobal ident; args =  []} -> 
            (* It's not completeness, its to make it sound.. *)
            Lam_compile_global.query_lambda ident meta.env 
          (* alias meta param ident (Module (Global ident)) Strict *)
-         | Lprim (Pmakeblock (_, _, Immutable ) , ls) -> 
+         | Lprim {primitive = Pmakeblock (_, _, Immutable ) ; args} -> 
            Hashtbl.replace meta.ident_tbl param 
-             (Lam_util.kind_of_lambda_block Normal ls ); (** *)
+             (Lam_util.kind_of_lambda_block Normal args ); (** *)
            arg
          | _ -> arg in
        Lam_util.refine_let param arg l) 

jscomp/lam_beta_reduce_util.ml

@@ -61,7 +61,7 @@ let simple_beta_reduce params body args =
     | _ :: _ -> raise E.Not_simple_apply 
   in 
   match (body : Lam.t) with 
-  | Lprim ( primitive , args' , _)  (* There is no lambda in primitive *)
+  | Lprim { primitive ; args =  args' ; _}  (* There is no lambda in primitive *)
     -> (* catch a special case of primitives *)
     (* Note in a very special case we can avoid any allocation
        {[
@@ -80,7 +80,7 @@ let simple_beta_reduce params body args =
         Hashtbl.fold (fun _param {lambda; used} code -> 
             if not used then
               Lam.seq lambda code
-            else code) param_hash (Lam.prim primitive us (List.length us)) in 
+            else code) param_hash (Lam.prim primitive us ) in 
       Hashtbl.clear param_hash;
       Some result 
     | exception _ ->