Merge pull request #4405 from BuckleScript/switch_poly_var

switch poly-var encoding

Author: bobzhang

jscomp/core/js_dump.ml

@@ -849,6 +849,26 @@ and expression_desc cxt ~(level:int) f x : cxt  =
         (List.combine (Array.to_list fields) el )))      
         (* name convention of Record is slight different from modules 
         *)
+  | Caml_block(el,_,_, Blk_poly_var name) ->
+    begin match el with 
+      | [hash;value] -> 
+        expression_desc 
+          cxt 
+          ~level 
+          f 
+          (Object 
+             ((Literals.polyvar_hash, 
+               if !Js_config.debug then hash
+               else {hash with comment = Some name}
+              ) ::
+              (Literals.polyvar_value, value) ::
+              if !Js_config.debug then 
+                ["name", E.str name]
+              else []
+             )          
+          )
+      | _ -> assert false
+    end       
   | Caml_block(el,_, _, (Blk_extension | Blk_record_ext _ as ext )) ->             
     expression_desc cxt ~level f (exn_block_as_obj ~stack:false el ext)      
   | Caml_block( el, mutable_flag, tag, tag_info)

jscomp/core/js_exp_make.ml

@@ -400,7 +400,30 @@ let record_access (e : t) (name : string) (pos : int32) =
       { expression_desc = Static_index (e, name, Some pos); comment = None}     
     )
   | _ -> { expression_desc = Static_index (e, name, Some pos); comment = None} 
-    
+
+let poly_var_tag_access (e : t)  = 
+  match e.expression_desc with
+  | Caml_block (l,_, _, _) when no_side_effect e
+    -> 
+    (match l  with
+     | x ::_ -> x 
+     | [] -> 
+       assert false
+    )
+  | _ -> { expression_desc = Static_index (e, Literals.polyvar_hash, Some 0l); comment = None} 
+
+
+let poly_var_value_access (e : t) =   
+  match e.expression_desc with
+  | Caml_block (l,_, _, _) when no_side_effect e
+    -> 
+    (match l  with
+     | _ :: v :: _ ->  v
+     | _  -> 
+       assert false
+    )
+  | _ -> { expression_desc = Static_index (e, Literals.polyvar_value, Some 1l); comment = None} 
+  
 let extension_access (e : t) name (pos : int32)  : t  = 
   match e.expression_desc with
   | Array (l,_) (* Float i -- should not appear here *)

jscomp/core/js_exp_make.mli

@@ -201,6 +201,13 @@ val record_assign :
   t -> 
   t 
 
+val poly_var_tag_access : 
+  t -> t 
+
+val poly_var_value_access : 
+  t -> t  
+
+  
 val extension_assign : 
   t -> 
   int32 -> 

jscomp/core/js_of_lam_block.ml

@@ -52,14 +52,18 @@ let field (field_info : Lam_compat.field_dbg_info) e i =
   match field_info with 
   | Fld_na _
   | Fld_tuple  
-  | Fld_poly_var_tag 
-  | Fld_poly_var_content 
+  
+
   | Fld_record_inline _
   | Fld_variant
   | Fld_array
     -> 
     E.array_index_by_int  
       ?comment:(Lam_compat.str_of_field_info field_info) e i 
+  | Fld_poly_var_content
+    -> E.poly_var_value_access e     
+  | Fld_poly_var_tag    
+    -> E.poly_var_tag_access e 
   | Fld_record_extension {name} -> 
     E.extension_access e (Some name) i
   | Fld_extension -> 

jscomp/core/js_of_lam_option.ml

@@ -93,21 +93,16 @@ let get_default_undefined_from_optional
     else
       (E.runtime_call Js_runtime_modules.option "option_get" [arg])
 
-let get_default_undefined (arg : J.expression) : J.expression =
+let option_unwrap (arg : J.expression) : J.expression =
   let desc = arg.expression_desc in
   if is_none_static desc then E.undefined else
   match desc with
   | Optional_block (x,_) 
     -> 
-    Js_of_lam_polyvar.get_field x 
+    E.poly_var_value_access x 
     (* invariant: option encoding *)
   | _ ->
-    (* FIXME: no need do such inlining*)
-    if Js_analyzer.is_okay_to_duplicate arg then
-      E.econd (is_not_none arg) 
-        (Js_of_lam_polyvar.get_field (val_from_option arg)) E.undefined
-    else
-      E.runtime_call Js_runtime_modules.option "option_get_unwrap" [arg]
+    E.runtime_call Js_runtime_modules.option "option_unwrap" [arg]
 
 let destruct_optional
   ~for_sure_none

jscomp/core/js_of_lam_option.mli

@@ -44,7 +44,7 @@ val get_default_undefined_from_optional:
 
 (** Given [Some (`a x)] or [None], 
     return [x] *)  
-val get_default_undefined : 
+val option_unwrap : 
   J.expression ->
   J.expression
 

jscomp/core/js_of_lam_polyvar.ml

@@ -58,7 +58,7 @@ let eval_as_event (arg : J.expression) (dispatches : (int * string) list ) =
   | _ ->
     Splice2
       (E.of_block
-      [(S.int_switch (Js_of_lam_polyvar.get_tag arg)
+      [(S.int_switch (E.poly_var_tag_access arg)
       (Ext_list.map dispatches (fun (i,r) ->
               {J.switch_case = i ;
                switch_body = [S.return_stmt (E.str r)];
@@ -69,7 +69,7 @@ let eval_as_event (arg : J.expression) (dispatches : (int * string) list ) =
            the problem is that we can not create bindings
            due to the
         *)
-     (Js_of_lam_polyvar.get_field  arg)
+     (E.poly_var_value_access  arg)
       )
       (** FIXME:
         1. duplicated evaluation of expressions arg
@@ -100,7 +100,7 @@ let eval_as_unwrap (arg : J.expression) : E.t =
   | Caml_block ([{expression_desc = Number _}; cb], _, _, _) ->
     cb
   | _ ->
-    Js_of_lam_polyvar.get_field arg 
+    E.poly_var_value_access arg 
 
 
 

jscomp/core/js_of_lam_polyvar.mli

@@ -139,8 +139,10 @@ let ocaml_to_js_eff
            - if ocaml arg is `None`, let js arg be `undefined` (no unwrapping)
            - if ocaml arg is `Some x`, unwrap the arg to get the `x`, then
              unwrap the `x` itself
+           - Here `Some x` is `x` due to the current encoding
+           Lets inline here since it depends on the runtime encoding
         *)
-        Js_of_lam_option.get_default_undefined raw_arg
+        Js_of_lam_option.option_unwrap raw_arg
       | _ ->
         Js_of_lam_variant.eval_as_unwrap raw_arg
     in