seperate chrome runtime support for normal block support

Author: bobzhang

jscomp/core/js_block_runtime.ml

@@ -28,7 +28,7 @@ let tag_is_zero (tag : J.expression) =
   | Number (Int {i = 0l; _}) -> true 
   | _ -> false;;
 
- let needBlockRuntimeInDebugMode 
+ let needChromeRuntime 
   (tag : J.expression)
   (tag_info : J.tag_info) = 
   match tag_info with 
@@ -48,7 +48,7 @@ let tag_is_zero (tag : J.expression) =
   | Blk_extension_slot -> false 
   | Blk_na  ->  not (tag_is_zero tag )
 
-let needBlockRuntimeInReleaseMode (tag : J.expression) (tag_info : J.tag_info) = 
+let needBlockRuntime (tag : J.expression) (tag_info : J.tag_info) = 
   match  tag_info with 
   | Blk_variant _ 
   | Blk_module _
@@ -69,31 +69,34 @@ let needBlockRuntimeInReleaseMode (tag : J.expression) (tag_info : J.tag_info) =
 #end  
   | Blk_extension_slot -> false 
     (* converted to [Pcreate_extension] in the beginning*)
- 
-
-(* Used to decide whether we should add [require('block')]*)
-let needBlockRuntime tag info = 
-  if !Js_config.debug then 
-    needBlockRuntimeInDebugMode tag info
-  else needBlockRuntimeInReleaseMode tag info  
-
-
 
 let option_id =   
   Ident.create_persistent Js_runtime_modules.option
 let curry_id =   
   Ident.create_persistent Js_runtime_modules.curry
 let block_id = 
   Ident.create_persistent Js_runtime_modules.block
+let caml_chrome_id = 
+  Ident.create_persistent Js_runtime_modules.caml_chrome_block
 
 let check_additional_id (x : J.expression) =
   match x.expression_desc with
   | Optional_block(_,false) -> 
     Some option_id  
   | Call(_, _, {arity = NA}) ->  
     Some curry_id
-  | Caml_block(_,_,tag,tag_info) when 
-    needBlockRuntime tag tag_info -> 
-    Some block_id
+  | Caml_block(_,_,tag,tag_info) 
+    -> 
+    if not !Js_config.debug then
+      if needBlockRuntime tag tag_info then 
+        Some block_id
+      else None   
+    else
+    if needChromeRuntime tag tag_info then 
+      (* This may depends on two modules, so in the runtime
+        we let chrome depends on block
+      *)
+      Some caml_chrome_id
+    else None
   | _ -> 
     None

jscomp/core/js_block_runtime.mli

@@ -25,10 +25,15 @@
 val tag_is_zero : 
   J.expression -> bool
 
-val needBlockRuntime:
+val needChromeRuntime:
   J.expression -> 
   J.tag_info -> 
-  bool
+  bool 
+  
+val needBlockRuntime: 
+  J.expression -> 
+  J.tag_info -> 
+  bool 
 
 val check_additional_id :
   J.expression -> Ident.t option  

jscomp/core/js_dump.ml

@@ -95,32 +95,40 @@ module Curry_gen = struct
     P.string f (Printf.sprintf "%d" len)
 end 
 
-let pp_block_dot f = 
+let block_dot f = 
   P.string f Js_runtime_modules.block;
   P.string f L.dot 
 
 let pp_block_create f =   
-  pp_block_dot f ;
+  block_dot f ;
   P.string f L.caml_block_create
 
-let pp_block_record f =   
-  pp_block_dot f ;
+let dbg_block_dot f =   
+  P.string f Js_runtime_modules.caml_chrome_block;
+  P.string f L.dot 
+
+let dbg_block_create f =   
+  dbg_block_dot f ;
+  P.string f L.caml_block_create
+
+let dbg_record f =   
+  dbg_block_dot f ;
   P.string f L.block_record
 
 let dbg_local_module f =   
-  pp_block_dot f;
+  dbg_block_dot f;
   P.string f L.block_local_module
 
 let dbg_poly_var f =   
-  pp_block_dot f;
+  dbg_block_dot f;
   P.string f L.block_poly_var
 
 let dbg_simple_variant f =   
-  pp_block_dot f ;
+  dbg_block_dot f ;
   P.string f L.block_simple_variant
 
 let dbg_variant f =   
-  pp_block_dot f ; 
+  dbg_block_dot f ; 
   P.string f L.block_variant
 
 
@@ -860,56 +868,62 @@ and expression_desc cxt (level:int) f x : cxt  =
        as an array, note exception or open variant it is outer-most is 
        simply an array
     *)
-    let needBlockRuntime = Js_block_runtime.needBlockRuntime tag tag_info in 
-    let is_debug = !Js_config.debug in 
-    if not needBlockRuntime then 
-      expression_desc cxt level f  (Array (el, mutable_flag))
-    else (  
-      match tag_info with 
-      | Blk_record labels ->
-        pp_block_record f ;
-        P.paren_group f 1 (fun _ -> arguments cxt f 
-              [E.array Immutable
-                 (Ext_array.to_list_f E.str labels);
-               E.array mutable_flag 
-                 (Ext_list.map el drop_comment) ]
-          )
-      | Blk_module (Some labels) ->         
-        dbg_local_module f;
-        P.paren_group f 1 (fun _ -> arguments cxt f 
-              [E.array Immutable
-                 (Ext_list.map labels E.str);
-               E.array mutable_flag
-                 (Ext_list.map el drop_comment)])
-      | Blk_variant name ->  
-        dbg_poly_var f;
-        P.paren_group f 1 (fun _ -> arguments cxt f [ 
-            E.str name;
-            E.array mutable_flag el])        
-      | Blk_constructor(name,number) when number = 1 && Js_block_runtime.tag_is_zero tag 
-        -> (* has to be debug mode *)          
-        dbg_simple_variant f ;
-        P.paren_group f 1 (fun _ -> arguments cxt f 
-              [E.str name; E.array mutable_flag el])             
-      | Blk_constructor(name,number) when is_debug ->
-        dbg_variant f ; 
-        P.paren_group f 1 (fun _ -> arguments cxt f 
-                              [ E.str name; tag ; E.array mutable_flag el])
+    if not !Js_config.debug then begin 
+      if not (Js_block_runtime.needBlockRuntime tag tag_info) then 
+        expression_desc cxt level f  (Array (el, mutable_flag))
+      else  
+        begin
+          pp_block_create f;
+          P.paren_group f 1 (fun _ -> arguments cxt f [tag; E.array mutable_flag el])
+        end  
+    end 
+      else
+        if not (Js_block_runtime.needChromeRuntime tag tag_info) then 
+          expression_desc cxt level f  (Array (el, mutable_flag))
+        else 
+      (  
+        match tag_info with 
+        | Blk_record labels ->
+          dbg_record f ;
+          P.paren_group f 1 (fun _ -> arguments cxt f 
+                                [E.array Immutable
+                                   (Ext_array.to_list_f E.str labels);
+                                 E.array mutable_flag 
+                                   (Ext_list.map el drop_comment) ]
+                            )
+        | Blk_module (Some labels) ->         
+          dbg_local_module f;
+          P.paren_group f 1 (fun _ -> arguments cxt f 
+                                [E.array Immutable
+                                   (Ext_list.map labels E.str);
+                                 E.array mutable_flag
+                                   (Ext_list.map el drop_comment)])
+        | Blk_variant name ->  
+          dbg_poly_var f;
+          P.paren_group f 1 (fun _ -> arguments cxt f [ 
+              E.str name;
+              E.array mutable_flag el])        
+        | Blk_constructor(name,number) 
+
+          -> (* has to be debug mode *)          
+          (if number = 1 && Js_block_runtime.tag_is_zero tag then          
+             dbg_simple_variant f 
+           else dbg_variant f) ;
+          P.paren_group f 1 (fun _ -> arguments cxt f 
+                                [E.str name; E.array mutable_flag el])             
 #if OCAML_VERSION =~ ">4.03.0" then                               
-      | Blk_record_inlined _ (* TODO: No support for debug mode yet *)
+        | Blk_record_inlined _ (* TODO: No support for debug mode yet *)
 #end
-      | Blk_constructor _                        
-      | Blk_tuple
-      | Blk_array
+        | Blk_tuple
+        | Blk_array
 #if OCAML_VERSION =~ ">4.03.0" then     
-      | Blk_record_ext _
+        | Blk_record_ext _
 #end      
-      | Blk_extension_slot
-      | Blk_na
-      | Blk_module None ->           
-        pp_block_create f;
-        P.paren_group f 1 (fun _ -> arguments cxt f [tag; E.array mutable_flag el])
-
+        | Blk_extension_slot
+        | Blk_na
+        | Blk_module None ->           
+          dbg_block_create f;
+          P.paren_group f 1 (fun _ -> arguments cxt f [tag; E.array mutable_flag el])
     )
 
   | Caml_block_tag e ->

jscomp/runtime/caml_chrome_debugger.ml

@@ -205,7 +205,7 @@ external cacheSymbol : string -> symbol = "for"
 external addProp : 'a -> symbol -> <value: 'b> Js.t -> 'a = 
   "defineProperty"  [@@bs.scope "Object"] [@@bs.val]
 
-
+let __ = Block.__
 (* It won't affect [Object.keys] using [Object.defineProperty*)
 let record  meta xs =
   setupOnce ();

jscomp/runtime/caml_chrome_debugger.mli

@@ -24,6 +24,7 @@
 
 type obj = Caml_obj_extern.t
 
+val __ : int -> obj -> obj
 val record : 'a -> obj -> obj
 
 val variant : 'a -> int ->  obj -> obj