Emit tags as strings.

Author: cristianoc

a.res

@@ -0,0 +1,3 @@
+module I = { type t = int }
+type t1 = int => string
+type t2 = I.t => string

jscomp/core/js_dump.ml

@@ -799,7 +799,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
         if p.num_nonconst = 1 then tails
         else
           ( Js_op.Lit L.tag,
-            if !Js_config.debug then tag else { tag with comment = Some p.name }
+            E.str p.name
           )
           :: tails
       in

jscomp/core/js_exp_make.ml

@@ -761,7 +761,7 @@ let is_type_number ?comment (e : t) : t =
   string_equal ?comment (typeof e) (str "number")
 
 let is_tag (e : t) : t =
-  string_equal ~comment:"tag" (typeof e) (str "number")
+  string_equal (typeof e) (str "string")
 
 let is_type_string ?comment (e : t) : t =
   string_equal ?comment (typeof e) (str "string")
@@ -774,12 +774,7 @@ let is_type_object (e : t) : t = string_equal (typeof e) (str "object")
 *)
 
 let tag ?comment e : t =
-  {
-    expression_desc =
-      Bin
-        (Bor, { expression_desc = Caml_block_tag e; comment }, zero_int_literal);
-    comment = None;
-  }
+  { expression_desc = Caml_block_tag e; comment }
 
 (* according to the compiler, [Btype.hash_variant],
    it's reduced to 31 bits for hash

jscomp/core/js_of_lam_block.ml

@@ -30,15 +30,6 @@ module E = Js_exp_make
 let make_block mutable_flag (tag_info : Lam_tag_info.t) tag args =
   match tag_info with _ -> E.make_block tag tag_info args mutable_flag
 
-(* | _, (  Tuple | Variant _ ) -> (\** TODO: check with inline record *\) *)
-(*     E.arr Immutable *)
-(*       (E.small_int  ?comment:(Lam_compile_util.comment_of_tag_info tag_info) tag   *)
-(*        :: args) *)
-(* | _, _  ->  *)
-(*     E.arr mutable_flag *)
-(*       (E.int  ?comment:(Lam_compile_util.comment_of_tag_info tag_info) tag   *)
-(*        :: args) *)
-
 let field (field_info : Lam_compat.field_dbg_info) e (i : int32) =
   match field_info with
   | Fld_tuple | Fld_array ->

jscomp/core/lam_compile.ml

@@ -568,8 +568,17 @@ and compile_general_cases :
           [ switch ?default ?declaration switch_exp body ])
 
 and compile_cases cxt (switch_exp : E.t) table default get_name =
+  let string_table = table |> List.filter_map (fun (i, lam) -> match get_name i
+        with None -> None
+        | Some n -> Some (n, lam)) in
+  if List.length string_table = List.length table
+  then
+    compile_string_cases cxt switch_exp string_table default
+  else
   compile_general_cases get_name
-    (fun i -> { (E.small_int i) with comment = get_name i })
+    (fun i -> match get_name i with
+      | None ->  E.small_int i
+      | Some name -> E.str name)
     E.int_equal cxt
     (fun ?default ?declaration e clauses ->
       S.int_switch ?default ?declaration e clauses)

jscomp/core/lam_compile_const.ml

@@ -47,6 +47,8 @@ and translate (x : Lam_constant.t) : J.expression =
   | Const_js_false -> E.bool false
   | Const_js_null -> E.nil
   | Const_js_undefined -> E.undefined
+  | Const_int { i; comment = Pt_constructor {name}} when name <> "[]" ->
+      E.str name
   | Const_int { i; comment } ->
       E.int i ?comment:(Lam_constant.string_of_pointer_info comment)
   | Const_char i -> Js_of_lam_string.const_char i

jscomp/core/lam_compile_util.ml

@@ -30,18 +30,3 @@ let jsop_of_comp (cmp : Lam_compat.comparison) : Js_op.binop =
   | Cgt -> Gt
   | Cle -> Le
   | Cge -> Ge
-
-let comment_of_tag_info (x : Lam_tag_info.t) =
-  match x with
-  | Blk_constructor { name = n } -> Some n
-  | Blk_tuple -> Some "tuple"
-  | Blk_poly_var _ -> None
-  | Blk_record _ -> None
-  | Blk_record_inlined { name = ctor } -> Some ctor
-  | Blk_record_ext _ -> None
-  | Blk_module_export _ | Blk_module _ ->
-      (* Turn it on next time to save some noise diff*)
-      None
-  | Blk_extension (* TODO: enhance it later *) -> None
-  | Blk_some | Blk_some_not_nested | Blk_lazy_general -> assert false
-(* let module_alias = Some "alias"   *)

jscomp/core/lam_compile_util.mli

@@ -25,5 +25,3 @@
 (** Some utilities for lambda compilation*)
 
 val jsop_of_comp : Lam_compat.comparison -> Js_op.binop
-
-val comment_of_tag_info : Lam_tag_info.t -> string option

jscomp/test/a_filename_test.js

@@ -19,7 +19,7 @@ function eq(loc, x, y) {
       loc + (" id " + String(test_id.contents)),
       (function (param) {
           return {
-                  TAG: /* Eq */0,
+                  TAG: "Eq",
                   _0: x,
                   _1: y
                 };

jscomp/test/a_list_test.js

@@ -7,7 +7,7 @@ var suites_0 = [
   "drop",
   (function (param) {
       return {
-              TAG: /* Eq */0,
+              TAG: "Eq",
               _0: Ext_list_test.drop(3, {
                     hd: 0,
                     tl: {
@@ -28,7 +28,7 @@ var suites_1 = {
     "drop1",
     (function (param) {
         return {
-                TAG: /* Eq */0,
+                TAG: "Eq",
                 _0: Ext_list_test.drop(2, {
                       hd: 0,
                       tl: {
@@ -51,7 +51,7 @@ var suites_1 = {
       "flat_map",
       (function (param) {
           return {
-                  TAG: /* Eq */0,
+                  TAG: "Eq",
                   _0: {
                     hd: 0,
                     tl: {

jscomp/test/a_string_test.js

@@ -8,7 +8,7 @@ var suites_0 = [
   "split",
   (function (param) {
       return {
-              TAG: /* Eq */0,
+              TAG: "Eq",
               _0: Ext_string_test.split(true, "hihi", /* 'i' */105),
               _1: {
                 hd: "h",
@@ -29,7 +29,7 @@ var suites_1 = {
     "split_non_empty",
     (function (param) {
         return {
-                TAG: /* Eq */0,
+                TAG: "Eq",
                 _0: Ext_string_test.split(undefined, "hihi", /* 'i' */105),
                 _1: {
                   hd: "h",
@@ -46,7 +46,7 @@ var suites_1 = {
       "split_empty",
       (function (param) {
           return {
-                  TAG: /* Eq */0,
+                  TAG: "Eq",
                   _0: Ext_string_test.split(true, "", /* 'i' */105),
                   _1: /* [] */0
                 };
@@ -57,7 +57,7 @@ var suites_1 = {
         "split_normal",
         (function (param) {
             return {
-                    TAG: /* Eq */0,
+                    TAG: "Eq",
                     _0: Ext_string_test.split(true, "h i i", /* ' ' */32),
                     _1: {
                       hd: "h",
@@ -77,7 +77,7 @@ var suites_1 = {
           "split_by",
           (function (param) {
               return {
-                      TAG: /* Eq */0,
+                      TAG: "Eq",
                       _0: List.filter(function (s) {
                               return s !== "";
                             })(Ext_string_test.split_by(undefined, (function (x) {