Merge pull request #3790 from BuckleScript/local_modules_to_objects

Compile local modules to objects, single commit.

Author: bobzhang

jscomp/core/j.ml

@@ -140,7 +140,7 @@ and expression_desc =
        This can be constructed either in a static way [E.array_index_by_int] or a dynamic way 
        [E.array_index]
      *)
-  | Static_index of expression * string 
+  | Static_index of expression * string * int32 option
     (* The third argument bool indicates whether we should 
        print it as 
        a["idd"] -- false

jscomp/core/js_analyzer.ml

@@ -231,10 +231,11 @@ let rec eq_expression
           opts0 = opts1
         | _ -> false
       end
-    | Static_index (e0,p0) -> 
+    | Static_index (e0,p0,off0) -> 
       begin match y0 with 
-        | Static_index(e1,p1) -> 
+        | Static_index(e1,p1,off1) -> 
           p0 = p1 && eq_expression e0 e1
+          && off0 = off1 (* could be relaxed *)
         |  _ -> false 
       end
     | Seq (a0,b0) -> 
@@ -368,5 +369,5 @@ let rec is_okay_to_duplicate (e : J.expression) =
   | Bool _ 
   | Str _ 
   | Number _ -> true
-  | Static_index (e, _s) -> is_okay_to_duplicate e 
+  | Static_index (e, _s,_off) -> is_okay_to_duplicate e 
   | _ -> false 

jscomp/core/js_dump.ml

@@ -855,6 +855,8 @@ and expression_desc cxt (level:int) f x : cxt  =
       (if identity then e 
        else       
          E.runtime_call Js_runtime_modules.option "some" [e])
+  | Caml_block(el,_, _, Blk_module fields) ->        
+      expression_desc cxt (level:int) f (Object (List.combine fields el))
   | Caml_block( el, mutable_flag, tag, tag_info)
     ->
     (* Note that, if we ignore more than tag [0] we loose some information
@@ -949,7 +951,7 @@ and expression_desc cxt (level:int) f x : cxt  =
         let cxt = expression 15 cxt f e in
         P.bracket_group f 1 @@ fun _ ->
         expression 0 cxt f p )
-  | Static_index (e, s) ->
+  | Static_index (e, s,_) ->
     P.cond_paren_group f (level > 15) 1 (fun _ -> 
         let cxt = expression 15 cxt f e in
         Js_dump_property.property_access f s ;

jscomp/core/js_exp_make.ml

@@ -155,11 +155,34 @@ let optional_not_nest_block e : J.expression =
     comment = None
   } 
 
+(** used in normal property
+    like [e.length], no dependency introduced
+*)
+let dot ?comment (e0 : t)  (e1 : string) : t = 
+  { expression_desc = Static_index (e0,  e1,None); comment} 
+
+
+let module_access (e : t) (name : string) (pos : int32) =    
+  match e.expression_desc with 
+  | Caml_block (l, _, _,_) when no_side_effect e -> 
+    (match Ext_list.nth_opt l (Int32.to_int pos) with 
+    | Some x -> x 
+    | None -> 
+      { expression_desc = Static_index (e, name,Some pos); comment=None} 
+    ) 
+  | _ -> 
+  { expression_desc = Static_index (e, name,Some pos); comment=None} 
+    
+
 let make_block ?comment 
   (tag : t) 
   (tag_info : J.tag_info) 
   (es : t list) 
   (mutable_flag : J.mutable_flag) : t = 
+  match tag_info with 
+  | Blk_module _ -> 
+    {expression_desc = Caml_block(es,mutable_flag, tag,tag_info); comment}
+  | _ -> 
   let comment = 
     match comment with 
     | None -> Lam_compile_util.comment_of_tag_info tag_info 
@@ -393,12 +416,6 @@ let assign_by_int
   assign_by_exp ?comment e0 (int ?comment index) value
 
 
-(** used in normal property
-    like [e.length], no dependency introduced
-*)
-let dot ?comment (e0 : t)  (e1 : string) : t = 
-  { expression_desc = Static_index (e0,  e1); comment} 
-
 
 
 
@@ -436,7 +453,7 @@ let function_length ?comment (e : t) : t =
 
 (** no dependency introduced *)
 let js_global_dot ?comment (x : string)  (e1 : string) : t = 
-  { expression_desc = Static_index (js_global x,  e1); comment} 
+  { expression_desc = Static_index (js_global x,  e1,None); comment} 
 
 let char_of_int ?comment (v : t) : t = 
   match v.expression_desc with

jscomp/core/js_exp_make.mli

@@ -128,6 +128,12 @@ val is_out : ?comment:string -> t -> t -> t
 
 val dot : ?comment:string -> t -> string -> t
 
+val module_access : 
+  t -> 
+  string -> 
+  int32 ->
+  t 
+
 val array_length : ?comment:string -> t -> t 
 
 val string_length : ?comment:string -> t -> t 

jscomp/core/js_fold.ml

@@ -31,6 +31,7 @@ class virtual fold =
         function
         | [] -> o
         | _x :: _x_i1 -> let o = _f_a o _x in let o = o#list _f_a _x_i1 in o
+    method int32 : int32 -> 'self_type = o#unknown
     method int : int -> 'self_type = o#unknown
     method bool : bool -> 'self_type = function | false -> o | true -> o
     method vident : vident -> 'self_type =
@@ -340,8 +341,10 @@ class virtual fold =
           let o = o#expression _x in let o = o#expression _x_i1 in o
       | Array_index (_x, _x_i1) ->
           let o = o#expression _x in let o = o#expression _x_i1 in o
-      | Static_index (_x, _x_i1) ->
-          let o = o#expression _x in let o = o#string _x_i1 in o
+      | Static_index (_x, _x_i1, _x_i2) ->
+          let o = o#expression _x in
+          let o = o#string _x_i1 in
+          let o = o#option (fun o -> o#int32) _x_i2 in o
       | New (_x, _x_i1) ->
           let o = o#expression _x in
           let o = o#option (fun o -> o#list (fun o -> o#expression)) _x_i1

jscomp/core/js_map.ml

@@ -34,6 +34,7 @@ class virtual map =
         | _x :: _x_i1 ->
             let _x = _f_a o _x in
             let _x_i1 = o#list _f_a _x_i1 in _x :: _x_i1
+    method int32 : int32 -> int32 = o#unknown
     method int : int -> int = o#unknown
     method bool : bool -> bool = function | false -> false | true -> true
     method vident : vident -> vident =
@@ -372,9 +373,11 @@ class virtual map =
       | Array_index (_x, _x_i1) ->
           let _x = o#expression _x in
           let _x_i1 = o#expression _x_i1 in Array_index (_x, _x_i1)
-      | Static_index (_x, _x_i1) ->
+      | Static_index (_x, _x_i1, _x_i2) ->
           let _x = o#expression _x in
-          let _x_i1 = o#string _x_i1 in Static_index (_x, _x_i1)
+          let _x_i1 = o#string _x_i1 in
+          let _x_i2 = o#option (fun o -> o#int32) _x_i2
+          in Static_index (_x, _x_i1, _x_i2)
       | New (_x, _x_i1) ->
           let _x = o#expression _x in
           let _x_i1 =

jscomp/core/js_of_lam_block.ml

@@ -50,16 +50,17 @@ let make_block mutable_flag (tag_info : Lam_tag_info.t) tag args  =
 
 let field (field_info : Lam_compat.field_dbg_info) e i =
   match field_info with 
-  | Fld_na -> 
-    E.array_index_by_int e i 
+  | Fld_na ->
+    (* let comment = "NA" in *)
+    E.array_index_by_int (* ~comment *) e i 
 #if OCAML_VERSION =~ ">4.03.0" then 
   | Fld_record_inline comment
   | Fld_record_extension comment
 #end
   | Fld_record comment
-  | Fld_module comment
     -> E.array_index_by_int ~comment e i
-
+  | Fld_module name
+    -> E.module_access e name i
 let field_by_exp e i = 
   E.array_index e i 
 

jscomp/core/js_pass_flatten_and_mark_dead.ml

@@ -238,8 +238,14 @@ let subst_map () = object (self)
                let v' = self#expression x in 
                let match_id =
                  Ext_ident.create
-                   (Printf.sprintf "%s_%03d"
-                      ident.name i) in
+                   (ident.name ^ "_" ^
+                    (match tag_info with 
+                     | Blk_module fields -> 
+                       (match Ext_list.nth_opt fields i with 
+                        | None -> Printf.sprintf "%03d" i                      
+                        | Some x -> x )
+                     | _ -> Printf.sprintf "%03d" i    
+                    )) in
                (i + 1, E.var match_id :: e, (match_id, v') :: acc))  in
       let e = 
         {block with 
@@ -267,7 +273,9 @@ let subst_map () = object (self)
   method! expression x =
     match x.expression_desc with 
     | Array_index ({expression_desc = Var (Id (id))}, 
-              {expression_desc = Number (Int {i; _})}) -> 
+              {expression_desc = Number (Int {i; _})})
+    | Static_index ({expression_desc = Var (Id (id))}, _, Some i)          
+     -> 
       (match Ident_hashtbl.find_opt self#get_substitution id with 
        | Some {expression_desc = Caml_block (ls, Immutable, _, _) } 
          -> 

jscomp/runtime/caml_module.ml

@@ -36,35 +36,48 @@ type shape =
    | Value of Caml_obj_extern.t
 (* ATTENTION: check across versions *)
 module Array = Caml_array_extern 
+
+external set_field : Caml_obj_extern.t -> string -> Caml_obj_extern.t -> unit   = ""
+  [@@bs.set_index]
+
+external get_field : Caml_obj_extern.t -> string -> Caml_obj_extern.t = ""
+  [@@bs.get_index]
+
+module type Empty = sig end
+
 (** Note that we have to provide a drop in replacement, since compiler internally will
     spit out ("CamlinternalMod".[init_mod|update_mod] unless we intercept it 
     in the lambda layer
  *)
 let init_mod (loc : string * int * int) (shape : shape) =    
   let undef_module _ = raise (Undefined_recursive_module loc) in
-  let rec loop (shape : shape) (struct_ : Caml_obj_extern.t array) idx = 
+  let rec loop (shape : shape) (struct_ : Caml_obj_extern.t) idx = 
     match shape with 
-    | Function -> struct_.(idx)<-(Obj.magic undef_module)
-    | Lazy -> struct_.(idx)<- (Obj.magic (lazy undef_module))
-    | Class ->  
-      struct_.(idx)<- 
+    | Function ->
+      set_field struct_ idx (Obj.magic undef_module) 
+    | Lazy ->
+      set_field struct_ idx (Obj.magic (lazy undef_module)) 
+    | Class ->
+      set_field struct_ idx      
         (Obj.magic (*ref {!CamlinternalOO.dummy_class loc} *)
            (undef_module, undef_module, undef_module,  0)
            (* depends on dummy class representation *)
-        )
+        ) 
     | Module comps 
       -> 
-      let v =  (Obj.magic [||]) in
-      struct_.(idx)<- v ;
+      let v = Caml_obj_extern.repr (module struct end :  Empty) in
+      set_field struct_ idx v ;
       let len = Array.length comps in
-      for i = 0 to len - 1 do 
-        loop (fst comps.(i)) v i       
+      for i = 0 to len - 1 do
+        let shape, name = comps.(i) in
+        loop shape v name       
       done
     | Value v ->
-       struct_.(idx) <- v in
-  let res = (Obj.magic [||] : Caml_obj_extern.t array) in
-  loop shape res 0 ;
-  res.(0)      
+      set_field struct_ idx v in
+  let res = Caml_obj_extern.repr (module struct end :  Empty) in
+  let dummy_name = "dummy" in
+  loop shape res dummy_name;
+  get_field res dummy_name 
 
 (* Note the [shape] passed between [init_mod] and [update_mod] is always the same 
    and we assume [module] is encoded as an array
@@ -73,19 +86,22 @@ let update_mod (shape : shape)  (o : Caml_obj_extern.t)  (n : Caml_obj_extern.t)
   let rec aux (shape : shape) o n parent i  =
     match shape with
     | Function 
-      -> Caml_obj_extern.set_field parent i n 
+      -> set_field parent i n
+
     | Lazy 
     | Class -> 
       Caml_obj.caml_update_dummy o n 
     | Module comps 
       -> 
       for i = 0 to Array.length comps - 1 do 
-        aux (fst comps.(i)) (Caml_obj_extern.field o i) (Caml_obj_extern.field n i) o i       
+        let shape, name = comps.(i) in
+        aux shape (get_field o name ) (get_field n name) o name       
       done
     | Value _ -> () in 
   match shape with 
   | Module comps -> 
-    for i = 0 to Array.length comps - 1 do  
-      aux (fst comps.(i)) (Caml_obj_extern.field o i) (Caml_obj_extern.field n i) o  i
+    for i = 0 to Array.length comps - 1 do
+      let shape, name = comps.(i) in
+      aux shape (get_field o name) (get_field n name) o name
     done
   |  _ -> assert false