Merge pull request #4606 from BuckleScript/fix_3961

fix #3961

Author: bobzhang

jscomp/core/lam.ml

@@ -29,11 +29,26 @@ type apply_status =
   | App_infer_full
   | App_uncurry
 
-type function_attribute = 
+
+type inline_attribute = 
   | Always_inline
   | Never_inline
   | Default_inline
 
+type is_a_functor = 
+  | Functor_yes
+  | Functor_no 
+  | Functor_na  
+
+type function_attribute = {
+  inline : inline_attribute;
+  is_a_functor : is_a_functor
+}  
+
+let default_fn_attr : function_attribute = {
+  inline = Default_inline;
+  is_a_functor = Functor_na
+}
 module Types = struct
 
   type lambda_switch =

jscomp/core/lam.mli

@@ -24,11 +24,23 @@
 
 
 
-type function_attribute = 
+type inline_attribute = 
   | Always_inline
   | Never_inline
   | Default_inline  
 
+type is_a_functor = 
+  | Functor_yes
+  | Functor_no 
+  | Functor_na  
+
+type function_attribute = {
+  inline : inline_attribute;
+  is_a_functor : is_a_functor
+}  
+
+val default_fn_attr : function_attribute
+
 type ident = Ident.t
 
 type lambda_switch  =

jscomp/core/lam_analysis.ml

@@ -336,7 +336,7 @@ let destruct_pattern (body : Lam.t) params args =
 let ok_to_inline_fun_when_app 
   (m : Lam.lfunction)
   (args : Lam.t list) =
-  match m.attr with
+  match m.attr.inline with
   | Always_inline -> true
   | Never_inline -> false
   | Default_inline ->

jscomp/core/lam_convert.ml

@@ -295,7 +295,7 @@ let lam_prim ~primitive:( p : Lambda.primitive) ~args loc : Lam.t =
           [ Lam.const Const_js_false ; 
             (* FIXME: arity 0 does not get proper supported*)
             prim ~primitive:(Pjs_fn_make 0) ~args:[Lam.function_ ~arity:1 ~params:[Ident.create "param"] ~body:computation 
-            ~attr:Default_inline] 
+            ~attr:Lam.default_fn_attr] 
             loc             
           ] in 
         prim ~primitive:(Pmakeblock (tag,lazy_block_info,Mutable)) ~args loc  
@@ -441,11 +441,15 @@ let lam_prim ~primitive:( p : Lambda.primitive) ~args loc : Lam.t =
 
 
 let convert_fn_attribute (attr : Lambda.function_attribute) : Lam.function_attribute = 
+  let inline : Lam.inline_attribute = 
     match attr.inline with 
     | Always_inline -> Always_inline
     | Never_inline -> Never_inline
     | Unroll _
-    | Default_inline -> Default_inline
+    | Default_inline -> Default_inline in 
+  let is_a_functor =
+    if attr.is_a_functor then Lam.Functor_yes else Functor_no in     
+  Lam.{inline; is_a_functor}
 
 
 

jscomp/core/lam_eta_conversion.ml

@@ -66,7 +66,7 @@ let transform_under_supply n loc status fn args =
        of an existing function which may cause inconsistency
     *)
     Lam.function_ ~arity:n  ~params:extra_args
-      ~attr:Default_inline
+      ~attr:Lam.default_fn_attr
       ~body:(Lam.apply fn (Ext_list.append args  extra_lambdas) 
                loc 
                status
@@ -75,7 +75,7 @@ let transform_under_supply n loc status fn args =
 
     let rest : Lam.t = 
       Lam.function_ ~arity:n  ~params:extra_args
-        ~attr:Default_inline
+        ~attr:Lam.default_fn_attr
         ~body:(Lam.apply fn (Ext_list.append args  extra_lambdas) 
                  loc 
                  status
@@ -133,7 +133,7 @@ let unsafe_adjust_to_arity loc ~(to_:int) ?(from : int option) (fn : Lam.t) : La
         match fn with 
         | Lfunction{params = [param]; body} -> 
           Lam.function_ ~arity:0 
-            ~attr:Default_inline
+            ~attr:Lam.default_fn_attr
             ~params:[]
             ~body:(
               Lam.let_ Alias param Lam.unit body  
@@ -153,7 +153,7 @@ let unsafe_adjust_to_arity loc ~(to_:int) ?(from : int option) (fn : Lam.t) : La
               Some partial_arg, Lam.var partial_arg in 
 
           let cont = Lam.function_ 
-              ~attr:Default_inline
+              ~attr:Lam.default_fn_attr
               ~arity:0
               ~params:[]
               ~body:(
@@ -172,7 +172,7 @@ let unsafe_adjust_to_arity loc ~(to_:int) ?(from : int option) (fn : Lam.t) : La
              {[ fun x y -> f y ]}
           *)
           let extra_args = Ext_list.init (to_ - from) (fun _ -> Ident.create Literals.param) in 
-          Lam.function_ ~attr:Default_inline
+          Lam.function_ ~attr:Lam.default_fn_attr
             ~arity:to_ 
             ~params:(Ext_list.append params  extra_args )
             ~body:(Lam.apply body (Ext_list.map extra_args Lam.var) loc App_na)
@@ -190,7 +190,7 @@ let unsafe_adjust_to_arity loc ~(to_:int) ?(from : int option) (fn : Lam.t) : La
           in   
           let cont = 
             Lam.function_ 
-              ~arity ~attr:Default_inline
+              ~arity ~attr:Lam.default_fn_attr
 
               ~params:extra_args 
               ~body:(
@@ -218,10 +218,10 @@ let unsafe_adjust_to_arity loc ~(to_:int) ?(from : int option) (fn : Lam.t) : La
             let extra_outer_args, extra_inner_args = Ext_list.split_at params arity in 
             Lam.function_ 
               ~arity 
-              ~attr:Default_inline
+              ~attr:Lam.default_fn_attr
               ~params:extra_outer_args 
               ~body:(
-                Lam.function_ ~arity:(from - to_) ~attr:Default_inline
+                Lam.function_ ~arity:(from - to_) ~attr:Lam.default_fn_attr
                   ~params:extra_inner_args ~body:body)
           | _
             -> 
@@ -238,12 +238,12 @@ let unsafe_adjust_to_arity loc ~(to_:int) ?(from : int option) (fn : Lam.t) : La
                 Some partial_arg, Lam.var partial_arg
             in   
             let cont = 
-              Lam.function_ ~arity:to_ ~params:extra_outer_args ~attr:Default_inline
+              Lam.function_ ~arity:to_ ~params:extra_outer_args ~attr:Lam.default_fn_attr
                 ~body:(
                   let arity = from - to_ in 
                   let extra_inner_args =
                     Ext_list.init arity (fun _ -> Ident.create Literals.param ) in 
-                  Lam.function_ ~arity ~params:extra_inner_args  ~attr:Default_inline
+                  Lam.function_ ~arity ~params:extra_inner_args  ~attr:Lam.default_fn_attr
                     ~body:(Lam.apply new_fn 
                              (Ext_list.map_append extra_outer_args 
                                 (Ext_list.map extra_inner_args Lam.var) 
@@ -269,7 +269,7 @@ let unsafe_adjust_to_arity loc ~(to_:int) ?(from : int option) (fn : Lam.t) : La
             let partial_arg = Ext_ident.create Literals.partial_arg in 
             Some partial_arg, Lam.var partial_arg in 
 
-        let cont = Lam.function_ ~attr:Default_inline
+        let cont = Lam.function_ ~attr:Lam.default_fn_attr
             ~arity:0
             ~params:[]
             ~body:(

jscomp/core/lam_inline_util.ml

@@ -155,14 +155,14 @@ let simplify_alias
       let normal () = Lam.apply ( simpl fn) (Ext_list.map args simpl) loc status in
       begin 
         match Hash_ident.find_opt meta.ident_tbl v with
-        | Some (FunctionId {lambda = Some(Lfunction ({params; body} as m),
+        | Some (FunctionId {lambda = Some(Lfunction ({params; body; attr = {is_a_functor}} as m),
                                           rec_flag)
                            })
           -> 
 
           if Ext_list.same_length args params (* && false *)
           then               
-            if Lam_inline_util.maybe_functor v.name  
+            if is_a_functor = Functor_yes
             (* && (Set_ident.mem v meta.export_idents) && false *)
             then 
               (* TODO: check l1 if it is exported, 

jscomp/core/lam_inline_util.mli

@@ -74,12 +74,12 @@ let values_of_export
               only truly immutable values can be inlined
            *)
            then
-             if Lam_inline_util.should_be_functor x.name lambda (* can also be submodule *)
-             then
+             match lambda with 
+             | Lfunction {attr = {is_a_functor = Functor_yes}} -> 
                if Lam_closure.is_closed lambda (* TODO: seriealize more*)
                then Some lambda
                else None
-             else 
+             | _ -> 
                let lam_size = Lam_analysis.size lambda in
                (* TODO:
                   1. global need re-assocate when do the beta reduction