Merge pull request #3966 from BuckleScript/refactor_meta_data_collection

Improve module coercion in strict subtyping, fix #3897

Author: bobzhang

jscomp/core/js_block_runtime.ml

@@ -38,6 +38,7 @@ let tag_is_zero (tag : J.expression) =
   | Blk_record_inlined _ -> true  
 #end  
   | Blk_record _   
+  | Blk_module_export
   | Blk_module _ -> false
   | Blk_tuple 
   | Blk_extension
@@ -53,6 +54,7 @@ let needBlockRuntime (tag : J.expression) (tag_info : J.tag_info) =
   match  tag_info with 
   | Blk_variant _ 
   | Blk_module _
+  | Blk_module_export
   | Blk_record _  
   | Blk_tuple 
   | Blk_extension

jscomp/core/js_dump.ml

@@ -841,7 +841,8 @@ and expression_desc cxt ~(level:int) f x : cxt  =
       (  
         match tag_info with 
         | Blk_record _ 
-        | Blk_module _ -> 
+        | Blk_module _ 
+        | Blk_module_export -> 
           assert false 
             (* 
               This can not happen, see the pattern match on previous branch 

jscomp/core/js_exp_make.ml

@@ -198,6 +198,7 @@ let make_block ?comment
     (* TODO: may overriden its previous comments *)
     | Blk_record _ 
     | Blk_module _
+    | Blk_module_export
     | Blk_tuple 
     | Blk_array
     | Blk_extension_slot 

jscomp/core/lam.ml

@@ -646,30 +646,35 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc  : t =
         end
       | _ -> default ()
     end
-
   | _ -> 
-
-#if 0 then  
     match prim with 
     | Pmakeblock(size,Blk_module fields,_)->
-      let rec aux fields args (var : Ident.t) =
+      let rec aux fields args (var : Ident.t) i =
         match fields, args with 
         | [], [] -> true 
-        | f :: fields, Lprim {primitive = Pfield (_, Fld_module f1); args = [Lglobal_module v1 | Lvar v1]} :: args 
-          -> f = f1 && Ident.same var v1 && aux fields args var 
+        | f :: fields, Lprim {primitive = Pfield (pos, Fld_module f1); args = [Lglobal_module v1 | Lvar v1]} :: args 
+          -> 
+            pos = i && 
+            f = f1 &&
+            Ident.same var v1 && aux fields args var (i + 1)
         | _, _ -> false in   
       begin match fields, args with   
       | field1 :: rest, 
-          Lprim{primitive = Pfield (_, Fld_module f1); args = [Lglobal_module v1 | Lvar v1 as lam]} :: args1
+          Lprim{primitive = Pfield (pos, Fld_module f1); args = [Lglobal_module v1 | Lvar v1 as lam]} :: args1
           ->
-          if field1 = f1 && aux rest args1 v1 then 
+          if pos = 0 && field1 = f1 && aux rest args1 v1 1 then 
             lam
           else 
             default ()
         | _ -> default ()                    
-      end
+      end 
+      (* In this level, include is already expanded, so that 
+        {[
+          { x0 : y0 ; x1 : y1 }
+        ]}
+        such module x can indeed be replaced by module y
+      *)
     | _ ->    
-#end          
       default ()
 
 let not_ loc x  : t =

jscomp/core/lam_compile_util.ml

@@ -52,6 +52,7 @@ let comment_of_tag_info  (x : Lam_tag_info.t) =
   | Blk_record_ext _ -> None
 #end  
   | Blk_array -> Some "array"
+  | Blk_module_export
   | Blk_module _ ->  
      (* Turn it on next time to save some noise diff*)
     None

jscomp/core/lam_constant_convert.ml

@@ -77,6 +77,9 @@ let rec convert_constant ( const : Lambda.structured_constant) : Lam_constant.t
     | Blk_module s -> 
       let t : Lam_tag_info.t = Blk_module s in 
       Const_block (i,t, Ext_list.map xs convert_constant )    
+     | Blk_module_export s -> 
+      let t : Lam_tag_info.t = Blk_module_export in 
+      Const_block (i,t, Ext_list.map xs convert_constant )     
     | Blk_extension_slot -> 
       let t : Lam_tag_info.t = Blk_extension_slot in 
       Const_block (i,t, Ext_list.map xs convert_constant )      

jscomp/core/lam_convert.ml

@@ -252,6 +252,9 @@ let lam_prim ~primitive:( p : Lambda.primitive) ~args loc : Lam.t =
     | Blk_module s -> 
       let info : Lam_tag_info.t = Blk_module s in
       prim ~primitive:(Pmakeblock (tag,info,mutable_flag)) ~args loc
+    | Blk_module_export _ -> 
+      let info : Lam_tag_info.t = Blk_module_export in
+      prim ~primitive:(Pmakeblock (tag,info,mutable_flag)) ~args loc  
     | Blk_extension_slot -> 
       let info : Lam_tag_info.t = Blk_extension_slot in
       ( 

jscomp/core/lam_tag_info.ml

@@ -41,4 +41,5 @@ type t =
   | Blk_record_inlined of string array * string * int
   | Blk_record_ext of string array
 #end
-  | Blk_class
+  | Blk_class
+  | Blk_module_export

jscomp/test/build.ninja

@@ -310,6 +310,7 @@ build test/gpr_3865_foo.cmi test/gpr_3865_foo.cmj : cc test/gpr_3865_foo.re | $s
 build test/gpr_3875_test.cmi test/gpr_3875_test.cmj : cc test/gpr_3875_test.ml | test/mt.cmj $stdlib
 build test/gpr_3877_test.cmi test/gpr_3877_test.cmj : cc test/gpr_3877_test.ml | $stdlib
 build test/gpr_3895_test.cmi test/gpr_3895_test.cmj : cc test/gpr_3895_test.ml | $stdlib
+build test/gpr_3897_test.cmi test/gpr_3897_test.cmj : cc test/gpr_3897_test.ml | $stdlib
 build test/gpr_3931_test.cmi test/gpr_3931_test.cmj : cc test/gpr_3931_test.ml | $stdlib
 build test/gpr_405_test.cmj : cc_cmi test/gpr_405_test.ml | test/gpr_405_test.cmi $stdlib
 build test/gpr_405_test.cmi : cc test/gpr_405_test.mli | $stdlib

jscomp/test/defunctor_make_test.js

@@ -8,9 +8,7 @@ function getcompare(x) {
 }
 
 function Make(M) {
-  return {
-          compare: M.compare
-        };
+  return M;
 }
 
 var Comparable = {