Support @as("foo") to customize the representation of tags.

jscomp/core/j.ml

@@ -151,17 +151,7 @@ and expression_desc =
   (* | Caml_uninitialized_obj of expression * expression *)
   (* [tag] and [size] tailed  for [Obj.new_block] *)
 
-  (* For setter, it still return the value of expression,
-     we can not use
-     {[
-       type 'a access = Get | Set of 'a
-     ]}
-     in another module, since it will break our code generator
-     [Caml_block_tag] can return [undefined],
-     you have to use [E.tag] in a safe way
-  *)
-  | Caml_block_tag of expression
-  (* | Caml_block_set_tag of expression * expression *)
+  | Caml_block_tag of expression * string (* e.tag *)
   (* | Caml_block_set_length of expression * expression *)
   (* It will just fetch tag, to make it safe, when creating it,
      we need apply "|0", we don't do it in the
@@ -254,7 +244,7 @@ and case_clause = {
   comment : string option;
 }
 
-and string_clause = string * case_clause
+and string_clause = Lambda.as_value * case_clause
 and int_clause = int * case_clause
 
 and statement_desc =

jscomp/core/js_analyzer.ml

@@ -101,10 +101,9 @@ let rec no_side_effect_expression_desc (x : J.expression_desc) =
   | Optional_block (x, _) -> no_side_effect x
   | Object kvs -> Ext_list.for_all_snd kvs no_side_effect
   | String_append (a, b) | Seq (a, b) -> no_side_effect a && no_side_effect b
-  | Length (e, _) | Caml_block_tag e | Typeof e -> no_side_effect e
+  | Length (e, _) | Caml_block_tag (e, _) | Typeof e -> no_side_effect e
   | Bin (op, a, b) -> op <> Eq && no_side_effect a && no_side_effect b
   | Js_not _ | Cond _ | FlatCall _ | Call _ | New _ | Raw_js_code _
-  (* | Caml_block_set_tag _  *)
   (* actually true? *) ->
       false
   | Await _ -> false

jscomp/core/js_dump.ml

@@ -762,6 +762,9 @@ and expression_desc cxt ~(level : int) f x : cxt =
           | Lit n -> Ext_list.mem_string p.optional_labels n
           | Symbol_name -> false
         in
+        let tag_name = match Ast_attributes.process_tag_name p.attrs with
+        | None -> L.tag
+        | Some s -> s in
         let tails =
           match p.optional_labels with
           | [] -> tails
@@ -771,11 +774,19 @@ and expression_desc cxt ~(level : int) f x : cxt =
               | Undefined when is_optional f -> None
               | _ -> Some (f, x))
           in
-        (Js_op.Lit L.tag, E.str p.name) :: tails
+        ( Js_op.Lit tag_name, (* TAG:xx for inline records *)
+          match Ast_attributes.process_as_value p.attrs with
+          | None -> E.str p.name
+          | Some as_value -> E.as_value as_value )
+        :: tails
       in
       expression_desc cxt ~level f (Object objs)
   | Caml_block (el, _, tag, Blk_constructor p) ->
       let not_is_cons = p.name <> Literals.cons in
+      let as_value = Ast_attributes.process_as_value p.attrs in
+      let tag_name = match Ast_attributes.process_tag_name p.attrs with
+        | None -> L.tag
+        | Some s -> s in
       let objs =
         let tails =
           Ext_list.mapi_append el
@@ -789,14 +800,19 @@ and expression_desc cxt ~(level : int) f x : cxt =
              [ (name_symbol, E.str p.name) ]
             else [])
         in
-        if not_is_cons = false && p.num_nonconst = 1 then tails
+        if (as_value = Some AsUnboxed || not_is_cons = false) && p.num_nonconst = 1 then tails
         else
-          ( Js_op.Lit L.tag,
-            E.str p.name
-          )
+          ( Js_op.Lit tag_name, (* TAG:xx *) 
+            match as_value with
+            | None -> E.str p.name
+            | Some as_value -> E.as_value as_value )
           :: tails
       in
-      expression_desc cxt ~level f (Object objs)
+      let exp = match objs with
+        | [(_, e)] when as_value = Some AsUnboxed -> e.expression_desc
+        | _ when as_value = Some AsUnboxed -> assert false (* should not happen *)
+        | _ -> J.Object objs in
+      expression_desc cxt ~level f exp
   | Caml_block
       ( _,
         _,
@@ -806,11 +822,11 @@ and expression_desc cxt ~(level : int) f x : cxt =
       assert false
   | Caml_block (el, mutable_flag, _tag, Blk_tuple) ->
       expression_desc cxt ~level f (Array (el, mutable_flag))
-  | Caml_block_tag e ->
+  | Caml_block_tag (e, tag) ->
       P.group f 1 (fun _ ->
           let cxt = expression ~level:15 cxt f e in
           P.string f L.dot;
-          P.string f L.tag;
+          P.string f tag;
           cxt)
   | Array_index (e, p) ->
       P.cond_paren_group f (level > 15) 1 (fun _ ->
@@ -1188,8 +1204,10 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt =
       let cxt = P.paren_group f 1 (fun _ -> expression ~level:0 cxt f e) in
       P.space f;
       P.brace_vgroup f 1 (fun _ ->
-          let pp_string f txt = ignore @@ expression_desc cxt ~level:0 f (Str {txt; delim=DStarJ}) in
-          let cxt = loop_case_clauses cxt f pp_string cc in
+          let pp_as_value f (as_value: Lambda.as_value) =
+            let e = E.as_value as_value in
+            ignore @@ expression_desc cxt ~level:0 f e.expression_desc in
+          let cxt = loop_case_clauses cxt f pp_as_value cc in
           match def with
           | None -> cxt
           | Some def ->

jscomp/core/js_exp_make.ml

@@ -316,6 +316,13 @@ let small_int i : t =
   | 248 -> obj_int_tag_literal
   | i -> int (Int32.of_int i)
 
+let as_value = function
+  | Lambda.AsString s -> str s ~delim:DStarJ
+  | AsInt i -> small_int i
+  | AsNull -> nil
+  | AsUndefined -> undefined
+  | AsUnboxed -> assert false (* Should not emit tags for unboxed *)
+
 let array_index ?comment (e0 : t) (e1 : t) : t =
   match (e0.expression_desc, e1.expression_desc) with
   | Array (l, _), Number (Int { i; _ })
@@ -762,8 +769,26 @@ 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_tag (e : t) : t =
-  { expression_desc = Bin (NotEqEq, typeof e, str "object"); comment=None }
+let is_tag ?(has_null_undefined_other=(false, false, false)) (e : t) : t =
+  let (has_null, has_undefined, has_other) = has_null_undefined_other in
+  if has_null && (has_undefined = false) && (has_other = false) then (* null *)
+    { expression_desc = Bin (EqEqEq, e, nil); comment=None }
+  else if has_null && has_undefined && has_other=false then (* null + undefined *)
+    { J.expression_desc = Bin
+      (Or,
+        { expression_desc = Bin (EqEqEq, e, nil); comment=None },
+        { expression_desc = Bin (EqEqEq, e, undefined); comment=None }
+      ); comment=None }
+  else if has_null=false && has_undefined && has_other=false then (* undefined *)
+    { expression_desc = Bin (EqEqEq, e, undefined); comment=None }
+  else if has_null then (* (null + undefined + other) || (null + other) *)
+    { J.expression_desc = Bin
+      (Or,
+        { expression_desc = Bin (EqEqEq, e, nil); comment=None },
+        { expression_desc = Bin (NotEqEq, typeof e, str "object"); comment=None }
+      ); comment=None }
+  else (* (undefiled + other) || other *)
+    { expression_desc = Bin (NotEqEq, typeof e, str "object"); comment=None }
 
 let is_type_string ?comment (e : t) : t =
   string_equal ?comment (typeof e) (str "string")
@@ -775,8 +800,8 @@ let is_type_object (e : t) : t = string_equal (typeof e) (str "object")
    call plain [dot]
 *)
 
-let tag ?comment e : t =
-  { expression_desc = Caml_block_tag e; comment }
+let tag ?comment ?(name=Js_dump_lit.tag) e : t =
+  { expression_desc = Caml_block_tag (e, name); comment }
 
 (* according to the compiler, [Btype.hash_variant],
    it's reduced to 31 bits for hash

jscomp/core/js_exp_make.mli

@@ -185,6 +185,8 @@ val assign_by_exp : t -> t -> t -> t
 
 val assign : ?comment:string -> t -> t -> t
 
+val as_value : Lambda.as_value -> t
+
 val triple_equal : ?comment:string -> t -> t -> t
 (* TODO: reduce [triple_equal] use *)
 
@@ -199,7 +201,8 @@ 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_tag : t -> t
+
+val is_tag : ?has_null_undefined_other:(bool * bool * bool) -> t -> t
 
 val is_type_string : ?comment:string -> t -> t
 
@@ -304,7 +307,7 @@ val unit : t
 
 val undefined : t
 
-val tag : ?comment:string -> J.expression -> t
+val tag : ?comment:string -> ?name:string -> J.expression -> t
 
 (** Note that this is coupled with how we encode block, if we use the 
     `Object.defineProperty(..)` since the array already hold the length,

jscomp/core/js_fold.ml

@@ -162,7 +162,7 @@ class fold =
           let _self = list (fun _self -> _self#expression) _self _x0 in
           let _self = _self#expression _x2 in
           _self
-      | Caml_block_tag _x0 ->
+      | Caml_block_tag (_x0, _tag) ->
           let _self = _self#expression _x0 in
           _self
       | Number _ -> _self

jscomp/core/js_of_lam_variant.ml

@@ -39,8 +39,8 @@ let eval (arg : J.expression) (dispatches : (string * string) list) : E.t =
         E.of_block
           [
             S.string_switch arg
-              (Ext_list.map dispatches (fun (i, r) ->
-                   ( i,
+              (Ext_list.map dispatches (fun (s, r) ->
+                   ( Lambda.AsString s,
                      J.
                        {
                          switch_body = [ S.return_stmt (E.str r) ];
@@ -79,8 +79,8 @@ let eval_as_event (arg : J.expression)
                 [
                   S.string_switch
                     (E.poly_var_tag_access arg)
-                    (Ext_list.map dispatches (fun (i, r) ->
-                         ( i,
+                    (Ext_list.map dispatches (fun (s, r) ->
+                         ( Lambda.AsString s,
                            J.
                              {
                                switch_body = [ S.return_stmt (E.str r) ];
@@ -107,8 +107,8 @@ let eval_as_int (arg : J.expression) (dispatches : (string * int) list) : E.t =
         E.of_block
           [
             S.string_switch arg
-              (Ext_list.map dispatches (fun (i, r) ->
-                   ( i,
+              (Ext_list.map dispatches (fun (s, r) ->
+                   ( Lambda.AsString s,
                      J.
                        {
                          switch_body =

jscomp/core/js_record_fold.ml

@@ -168,7 +168,7 @@ let expression_desc : 'a. ('a, expression_desc) fn =
       let st = list _self.expression _self st _x0 in
       let st = _self.expression _self st _x2 in
       st
-  | Caml_block_tag _x0 ->
+  | Caml_block_tag (_x0, _tag) ->
       let st = _self.expression _self st _x0 in
       st
   | Number _ -> st

jscomp/core/js_record_iter.ml

@@ -128,7 +128,7 @@ let expression_desc : expression_desc fn =
   | Caml_block (_x0, _x1, _x2, _x3) ->
       list _self.expression _self _x0;
       _self.expression _self _x2
-  | Caml_block_tag _x0 -> _self.expression _self _x0
+  | Caml_block_tag (_x0, _tag) -> _self.expression _self _x0
   | Number _ -> ()
   | Object _x0 -> property_map _self _x0
   | Undefined -> ()

jscomp/core/js_record_map.ml

@@ -166,9 +166,9 @@ let expression_desc : expression_desc fn =
       let _x0 = list _self.expression _self _x0 in
       let _x2 = _self.expression _self _x2 in
       Caml_block (_x0, _x1, _x2, _x3)
-  | Caml_block_tag _x0 ->
+  | Caml_block_tag (_x0, tag) ->
       let _x0 = _self.expression _self _x0 in
-      Caml_block_tag _x0
+      Caml_block_tag (_x0, tag)
   | Number _ as v -> v
   | Object _x0 ->
       let _x0 = property_map _self _x0 in

jscomp/core/js_stmt_make.ml

@@ -129,13 +129,16 @@ let int_switch ?(comment : string option)
 
 let string_switch ?(comment : string option)
     ?(declaration : (J.property * Ident.t) option) ?(default : J.block option)
-    (e : J.expression) (clauses : (string * J.case_clause) list) : t =
+    (e : J.expression) (clauses : (Lambda.as_value * J.case_clause) list) : t =
   match e.expression_desc with
   | Str {txt} -> (
       let continuation =
         match
           Ext_list.find_opt clauses (fun (switch_case, x) ->
-              if switch_case = txt then Some x.switch_body else None)
+            match switch_case with
+            | AsString s ->
+              if s = txt then Some x.switch_body else None
+            | AsInt _ | AsNull | AsUnboxed | AsUndefined -> None)
         with
         | Some case -> case
         | None -> ( match default with Some x -> x | None -> assert false)

jscomp/core/js_stmt_make.mli

@@ -77,7 +77,7 @@ val string_switch :
   ?declaration:Lam_compat.let_kind * Ident.t ->
   ?default:J.block ->
   J.expression ->
-  (string * J.case_clause) list ->
+  (Lambda.as_value * J.case_clause) list ->
   t
 
 val declare_variable :