Merge pull request #4558 from BuckleScript/string_poly_var

first class string types

Author: bobzhang

jscomp/core/js_dump.ml

@@ -167,7 +167,7 @@ let exp_need_paren  (e : J.expression) =
 
   | Raw_js_code {code_info = Exp _}
   | Fun _ 
-  | Caml_block (_,_,_, (Blk_record _ | Blk_module _ | Blk_poly_var _ | Blk_extension | Blk_record_ext _ | Blk_record_inlined _ | Blk_constructor _ ))
+  | Caml_block (_,_,_, (Blk_record _ | Blk_module _ | Blk_poly_var  | Blk_extension | Blk_record_ext _ | Blk_record_inlined _ | Blk_constructor _ ))
   | Object _ -> true
   | Raw_js_code {code_info = Stmt _ }
   | Length _
@@ -823,23 +823,17 @@ and expression_desc cxt ~(level:int) f x : cxt  =
       expression_desc cxt ~level f (Object 
         ((Ext_list.combine_array fields el  (fun i -> Js_op.Lit i))))      
 
-  | Caml_block(el,_,_, Blk_poly_var name) ->
+  | Caml_block(el,_,_, Blk_poly_var ) ->
     begin match el with 
-      | [hash;value] -> 
+      | [{expression_desc = Str (_,name)};value] -> 
         expression_desc 
           cxt 
           ~level 
           f 
-          (Object 
-             ((Js_op.Lit Literals.polyvar_hash, 
-               if !Js_config.debug then hash
-               else {hash with comment = Some name}
-              ) ::
-              (Js_op.Lit Literals.polyvar_value, value) ::
-              if !Js_config.debug then 
-                [name_symbol, E.str name]
-              else []
-             )          
+          (Object [
+             Js_op.Lit Literals.polyvar_hash, E.str name;
+              Lit Literals.polyvar_value, value
+          ]                       
           )
       | _ -> assert false
     end       

jscomp/core/js_exp_make.ml

@@ -255,7 +255,7 @@ let dummy_obj ?comment (info : Lam_tag_info.t)  : t =
   | Blk_module _ 
   | Blk_constructor _ 
   | Blk_record_inlined _ 
-  | Blk_poly_var _ 
+  | Blk_poly_var  
   | Blk_extension 
   | Blk_record_ext _ 
     -> 
@@ -856,6 +856,8 @@ let  string_equal ?comment (e0 : t) (e1 : t) : t =
 let is_type_number ?comment (e : t) : t = 
   string_equal ?comment (typeof e) (str "number")    
 
+let is_type_string ?comment (e : t) : t = 
+  string_equal ?comment (typeof e) (str "string")    
 
 (* we are calling [Caml_primitive.primitive_name], since it's under our
    control, we should make it follow the javascript name convention, and

jscomp/core/js_exp_make.mli

@@ -260,7 +260,12 @@ val int_equal : ?comment:string -> t -> t -> t
 val string_equal : ?comment:string -> t -> t -> t 
 val eq_null_undefined_boolean: ?comment:string -> t -> t -> t 
 val neq_null_undefined_boolean: ?comment:string -> t -> t -> t 
-val is_type_number : ?comment:string -> t -> t 
+
+val is_type_number : 
+  ?comment:string -> t -> t 
+val is_type_string : 
+  ?comment:string -> t -> t 
+
 val typeof : ?comment:string -> t -> t 
 
 val to_int32 : ?comment:string -> t -> t 

jscomp/core/js_of_lam_variant.ml

@@ -31,14 +31,14 @@ type arg_expression =
   | Splice2 of E.t * E.t
 
 (* we need destruct [undefined] when input is optional *)
-let eval (arg : J.expression) (dispatches : (int * string) list ) : E.t =
+let eval (arg : J.expression) (dispatches : (Ast_compatible.hash_label * string) list ) : E.t =
   if arg == E.undefined then E.undefined else
   match arg.expression_desc with
-  | Number (Int {i} | Uint i) ->
-    E.str (Ext_list.assoc_by_int  dispatches (Int32.to_int i) None)
+  | Str (_,s) -> 
+    E.str (Ext_list.assoc_by_string  dispatches s None)
   | _ ->
     E.of_block
-      [(S.int_switch arg
+      [(S.string_switch arg
       (Ext_list.map dispatches (fun (i,r) ->
               {J.switch_case = i ;
                switch_body = [S.return_stmt (E.str r)];
@@ -48,17 +48,16 @@ let eval (arg : J.expression) (dispatches : (int * string) list ) : E.t =
 
 (** invariant: optional is not allowed in this case *)
 (** arg is a polyvar *)
-let eval_as_event (arg : J.expression) (dispatches : (int * string) list ) =
+let eval_as_event (arg : J.expression) (dispatches : (Ast_compatible.hash_label * string) list ) =
   match arg.expression_desc with
-  | Array ([{expression_desc = Number (Int {i} | Uint i)}; cb], _)
-  | Caml_block([{expression_desc = Number (Int {i} | Uint i)}; cb], _, _, _)
-    -> (* FIXME - to polyvar*)
-    let v = Ext_list.assoc_by_int dispatches (Int32.to_int i) None in
+  | Caml_block([{expression_desc = Str(_,s)}; cb], _, _, Blk_poly_var ) when Js_analyzer.no_side_effect_expression cb 
+    -> 
+    let v = Ext_list.assoc_by_string dispatches s None in
     Splice2(E.str v , cb )
   | _ ->
     Splice2
       (E.of_block
-      [(S.int_switch (E.poly_var_tag_access arg)
+      [(S.string_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)];
@@ -80,14 +79,14 @@ let eval_as_event (arg : J.expression) (dispatches : (int * string) list ) =
       *)
 
 (* we need destruct [undefined] when input is optional *)
-let eval_as_int (arg : J.expression) (dispatches : (int * int) list ) : E.t  =
+let eval_as_int (arg : J.expression) (dispatches : (Ast_compatible.hash_label * int) list ) : E.t  =
   if arg == E.undefined then E.undefined else
   match arg.expression_desc with
-  | Number (Int {i} | Uint i) ->
-    E.int (Int32.of_int (Ext_list.assoc_by_int dispatches (Int32.to_int i) None))
+  | Str(_,i) ->
+    E.int (Int32.of_int (Ext_list.assoc_by_string dispatches i None))
   | _ ->
     E.of_block
-      [(S.int_switch arg
+      [(S.string_switch arg
       (Ext_list.map dispatches (fun (i,r) ->
               {J.switch_case = i ;
                switch_body = [S.return_stmt (E.int (Int32.of_int  r))];

jscomp/core/js_of_lam_variant.mli

@@ -30,9 +30,9 @@ type arg_expression =
   | Splice2 of J.expression * J.expression
 
 val eval :
-   J.expression -> (int * string) list -> J.expression
+   J.expression -> (Ast_compatible.hash_label * string) list -> J.expression
 val eval_as_event : 
-  J.expression -> (int * string) list -> arg_expression
+  J.expression -> (Ast_compatible.hash_label * string) list -> arg_expression
 val eval_as_int : 
-  J.expression -> (int * int) list -> J.expression
+  J.expression -> (Ast_compatible.hash_label * int) list -> J.expression
 val eval_as_unwrap : J.expression -> J.expression

jscomp/core/lam_analysis.ml

@@ -132,6 +132,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
       | Parrayrefs  
       (* Test if the argument is a block or an immediate integer *)
       | Pisint
+      | Pis_poly_var_const
       (* Test if the (integer) argument is outside an interval *)
       | Pisout
       | Pbintofint _

jscomp/core/lam_compile_const.ml

@@ -89,9 +89,12 @@ and translate (x : Lam_constant.t ) : J.expression =
 
 
   | Const_pointer (c,pointer_info) ->     
-    E.int ?comment:(Lam_compile_util.comment_of_pointer_info pointer_info)
-      (Int32.of_int c )
-
+    begin match pointer_info with 
+      | Pt_variant {name} -> E.str name
+      | _ -> 
+        E.int ?comment:(Lam_compile_util.comment_of_pointer_info pointer_info)
+          (Int32.of_int c )
+    end
   | Const_block(tag, tag_info, xs ) -> 
     Js_of_lam_block.make_block NA tag_info 
       (E.small_int  tag) (Ext_list.map xs translate)

jscomp/core/lam_compile_primitive.ml

@@ -579,6 +579,8 @@ let translate  loc
   (** FIXME, this can be removed later *)
   | Pisint -> 
     E.is_type_number (Ext_list.singleton_exn args)
+  | Pis_poly_var_const -> 
+    E.is_type_string (Ext_list.singleton_exn args)  
   | Pctconst ct -> 
     (match ct with 
      | Big_endian -> E.bool Sys.big_endian

jscomp/core/lam_compile_util.ml

@@ -45,7 +45,7 @@ let comment_of_tag_info  (x : Lam_tag_info.t) =
   | Blk_constructor {name = n} -> Some n 
   | Blk_tuple -> Some "tuple"
   | Blk_class -> Some "class"
-  | Blk_poly_var _ -> None
+  | Blk_poly_var  -> None
   | Blk_record _ -> None
   | Blk_record_inlined {name = ctor} -> Some ctor
   | Blk_record_ext _ -> None

jscomp/core/lam_constant_convert.ml

@@ -72,8 +72,12 @@ let rec convert_constant ( const : Lambda.structured_constant) : Lam_constant.t
       let t : Lam_tag_info.t = Blk_array in 
       Const_block (i,t, Ext_list.map xs convert_constant )
     | Blk_poly_var s -> 
-      let t : Lam_tag_info.t = Blk_poly_var s in 
-      Const_block (i,t, Ext_list.map xs convert_constant )      
+     begin match xs with 
+     | [_; value] -> 
+      let t : Lam_tag_info.t = Blk_poly_var  in 
+      Const_block (i,t, [Const_string s; convert_constant value] )      
+    | _ -> assert false  
+    end
     | Blk_record s -> 
       let t : Lam_tag_info.t = Blk_record s in 
       Const_block (i,t, Ext_list.map xs convert_constant )