Refactor untagged logic

jscomp/core/j.ml

@@ -244,7 +244,7 @@ and case_clause = {
   comment : string option;
 }
 
-and string_clause = Ast_untagged_variants.literal_type * case_clause
+and string_clause = Ast_untagged_variants.tag_type * case_clause
 and int_clause = int * case_clause
 
 and statement_desc =

jscomp/core/js_dump.ml

@@ -779,15 +779,15 @@ and expression_desc cxt ~(level : int) f x : cxt =
           tails
         else
           (Js_op.Lit tag_name, (* TAG:xx for inline records *)
-            match Ast_untagged_variants.process_literal_type p.attrs with
+            match Ast_untagged_variants.process_tag_type p.attrs with
             | None -> E.str p.name
-            | Some literal -> E.literal literal )
+            | Some t -> E.tag_type t )
           :: 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 literal = Ast_untagged_variants.process_literal_type p.attrs in
+      let tag_type = Ast_untagged_variants.process_tag_type p.attrs in
       let untagged = Ast_untagged_variants.process_untagged p.attrs in
       let tag_name = match Ast_untagged_variants.process_tag_name p.attrs with
         | None -> L.tag
@@ -808,9 +808,9 @@ and expression_desc cxt ~(level : int) f x : cxt =
         if untagged || (not_is_cons = false) && p.num_nonconst = 1 then tails
         else
           ( Js_op.Lit tag_name, (* TAG:xx *) 
-            match literal with
+            match tag_type with
             | None -> E.str p.name
-            | Some literal -> E.literal literal )
+            | Some t -> E.tag_type t )
           :: tails
       in
       let exp = match objs with
@@ -1210,8 +1210,8 @@ 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_as_value f (literal: Ast_untagged_variants.literal_type) =
-            let e = E.literal literal in
+          let pp_as_value f (tag_type: Ast_untagged_variants.tag_type) =
+            let e = E.tag_type tag_type 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

jscomp/core/js_exp_make.ml

@@ -336,22 +336,6 @@ let zero_float_lit : t =
 let float_mod ?comment e1 e2 : J.expression =
   { comment; expression_desc = Bin (Mod, e1, e2) }
 
-let literal = function
-  | Ast_untagged_variants.String s -> str s ~delim:DStarJ
-  | Int i -> small_int i
-  | Float f -> float f
-  | Bool b -> bool b
-  | Null -> nil
-  | Undefined -> undefined
-  | Block IntType -> str "number"
-  | Block FloatType -> str "number"
-  | Block StringType -> str "string"
-  | Block Array -> str "Array" ~delim:DNoQuotes
-  | Block Object -> str "object"
-  | Block Unknown ->
-    (* TODO: clean up pattern mathing algo whih confuses literal with blocks *)
-    assert false
-
 let array_index ?comment (e0 : t) (e1 : t) : t =
   match (e0.expression_desc, e1.expression_desc) with
   | Array (l, _), Number (Int { i; _ })
@@ -776,7 +760,23 @@ 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 rec is_a_literal_case ~(literal_cases : Ast_untagged_variants.literal_type list) ~block_cases (e:t) : t =
+let tag_type = function
+  | Ast_untagged_variants.String s -> str s ~delim:DStarJ
+  | Int i -> small_int i
+  | Float f -> float f
+  | Bool b -> bool b
+  | Null -> nil
+  | Undefined -> undefined
+  | Untagged IntType -> str "number"
+  | Untagged FloatType -> str "number"
+  | Untagged StringType -> str "string"
+  | Untagged ArrayType -> str "Array" ~delim:DNoQuotes
+  | Untagged ObjectType -> str "object"
+  | Untagged UnknownType ->
+    (* TODO: this should not happen *)
+    assert false
+
+let rec is_a_literal_case ~(literal_cases : Ast_untagged_variants.tag_type list) ~block_cases (e:t) : t =
   let literals_overlaps_with_string () = 
     Ext_list.exists literal_cases (function
       | String _ -> true
@@ -793,24 +793,24 @@ let rec is_a_literal_case ~(literal_cases : Ast_untagged_variants.literal_type l
   let (!=) x y = bin NotEqEq x y in
   let (||) x y = bin Or x y in
   let (&&) x y = bin And x y in
-  let is_literal_case (l:Ast_untagged_variants.literal_type) : t =  e == (literal l) in
-  let is_not_block_case (c:Ast_untagged_variants.block_type) : t = match c with
+  let is_literal_case (t: Ast_untagged_variants.tag_type) : t =  e == (tag_type t) in
+  let is_not_block_case (c: Ast_untagged_variants.block_type) : t = match c with
   | StringType when literals_overlaps_with_string () = false  (* No overlap *) -> 
     (typeof e) != (str "string")
   | IntType when literals_overlaps_with_number () = false ->
     (typeof e) != (str "number")
   | FloatType when literals_overlaps_with_number () = false ->
     (typeof e) != (str "number")
-  | Array -> 
+  | ArrayType -> 
     not (is_array e)
-  | Object when literals_overlaps_with_object () = false ->
+  | ObjectType when literals_overlaps_with_object () = false ->
     (typeof e) != (str "object")
-  | Object (* overlap *) ->
+  | ObjectType (* overlap *) ->
     e == nil || (typeof e) != (str "object")
   | StringType (* overlap *)
   | IntType (* overlap *)
   | FloatType (* overlap *)
-  | Unknown ->
+  | UnknownType ->
     (* We don't know the type of unknown, so we need to express:
        this is not one of the literals *)
     (match literal_cases with

jscomp/core/js_exp_make.mli

@@ -186,7 +186,7 @@ val assign_by_exp : t -> t -> t -> t
 
 val assign : ?comment:string -> t -> t -> t
 
-val literal : Ast_untagged_variants.literal_type -> t
+val tag_type : Ast_untagged_variants.tag_type -> t
 
 val triple_equal : ?comment:string -> t -> t -> t
 (* TODO: reduce [triple_equal] use *)
@@ -205,7 +205,7 @@ val is_type_number : ?comment:string -> t -> t
 
 val is_int_tag : ?has_null_undefined_other:(bool * bool * bool) -> t -> t
 
-val is_a_literal_case : literal_cases:Ast_untagged_variants.literal_type list -> block_cases:Ast_untagged_variants.block_type list -> t -> t
+val is_a_literal_case : literal_cases:Ast_untagged_variants.tag_type list -> block_cases:Ast_untagged_variants.block_type list -> t -> t
 
 val is_type_string : ?comment:string -> t -> t
 

jscomp/core/js_stmt_make.ml

@@ -129,7 +129,7 @@ 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 : (Ast_untagged_variants.literal_type * J.case_clause) list) : t =
+    (e : J.expression) (clauses : (Ast_untagged_variants.tag_type * J.case_clause) list) : t =
   match e.expression_desc with
   | Str {txt} -> (
       let continuation =
@@ -138,9 +138,8 @@ let string_switch ?(comment : string option)
             match switch_case with
             | String s ->
               if s = txt then Some x.switch_body else None
-            | Int _  | Float _| Bool _ | Null
-            | Undefined
-            | Block _ -> None)
+            | Int _  | Float _| Bool _ | Null | Undefined | Untagged _ ->
+              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 ->
-  (Ast_untagged_variants.literal_type * J.case_clause) list ->
+  (Ast_untagged_variants.tag_type * J.case_clause) list ->
   t
 
 val declare_variable :