Skip to content

Commit 273c4f4

Browse files
committed
Add support for @tag(...) to customize the property used for the tag.
1 parent 4b9d87e commit 273c4f4

39 files changed

+3808
-4467
lines changed

jscomp/core/j.ml

Lines changed: 1 addition & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -151,16 +151,7 @@ and expression_desc =
151151
(* | Caml_uninitialized_obj of expression * expression *)
152152
(* [tag] and [size] tailed for [Obj.new_block] *)
153153

154-
(* For setter, it still return the value of expression,
155-
we can not use
156-
{[
157-
type 'a access = Get | Set of 'a
158-
]}
159-
in another module, since it will break our code generator
160-
[Caml_block_tag] can return [undefined],
161-
you have to use [E.tag] in a safe way
162-
*)
163-
| Caml_block_tag of expression
154+
| Caml_block_tag of expression * string (* e.tag *)
164155
(* | Caml_block_set_length of expression * expression *)
165156
(* It will just fetch tag, to make it safe, when creating it,
166157
we need apply "|0", we don't do it in the

jscomp/core/js_analyzer.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -101,7 +101,7 @@ let rec no_side_effect_expression_desc (x : J.expression_desc) =
101101
| Optional_block (x, _) -> no_side_effect x
102102
| Object kvs -> Ext_list.for_all_snd kvs no_side_effect
103103
| String_append (a, b) | Seq (a, b) -> no_side_effect a && no_side_effect b
104-
| Length (e, _) | Caml_block_tag e | Typeof e -> no_side_effect e
104+
| Length (e, _) | Caml_block_tag (e, _) | Typeof e -> no_side_effect e
105105
| Bin (op, a, b) -> op <> Eq && no_side_effect a && no_side_effect b
106106
| Js_not _ | Cond _ | FlatCall _ | Call _ | New _ | Raw_js_code _
107107
(* actually true? *) ->

jscomp/core/js_dump.ml

Lines changed: 10 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -762,6 +762,9 @@ and expression_desc cxt ~(level : int) f x : cxt =
762762
| Lit n -> Ext_list.mem_string p.optional_labels n
763763
| Symbol_name -> false
764764
in
765+
let tag_name = match Ast_attributes.process_tag_name p.attrs with
766+
| None -> L.tag
767+
| Some s -> s in
765768
let tails =
766769
match p.optional_labels with
767770
| [] -> tails
@@ -771,7 +774,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
771774
| Undefined when is_optional f -> None
772775
| _ -> Some (f, x))
773776
in
774-
( Js_op.Lit L.tag,
777+
( Js_op.Lit tag_name, (* TAG:xx for inline records *)
775778
match Ast_attributes.process_as_value p.attrs with
776779
| None -> E.str p.name
777780
| Some as_value -> E.as_value as_value )
@@ -781,6 +784,9 @@ and expression_desc cxt ~(level : int) f x : cxt =
781784
| Caml_block (el, _, tag, Blk_constructor p) ->
782785
let not_is_cons = p.name <> Literals.cons in
783786
let as_value = Ast_attributes.process_as_value p.attrs in
787+
let tag_name = match Ast_attributes.process_tag_name p.attrs with
788+
| None -> L.tag
789+
| Some s -> s in
784790
let objs =
785791
let tails =
786792
Ext_list.mapi_append el
@@ -796,7 +802,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
796802
in
797803
if (as_value = Some AsUnboxed || not_is_cons = false) && p.num_nonconst = 1 then tails
798804
else
799-
( Js_op.Lit L.tag,
805+
( Js_op.Lit tag_name, (* TAG:xx *)
800806
match as_value with
801807
| None -> E.str p.name
802808
| Some as_value -> E.as_value as_value )
@@ -816,11 +822,11 @@ and expression_desc cxt ~(level : int) f x : cxt =
816822
assert false
817823
| Caml_block (el, mutable_flag, _tag, Blk_tuple) ->
818824
expression_desc cxt ~level f (Array (el, mutable_flag))
819-
| Caml_block_tag e ->
825+
| Caml_block_tag (e, tag) ->
820826
P.group f 1 (fun _ ->
821827
let cxt = expression ~level:15 cxt f e in
822828
P.string f L.dot;
823-
P.string f L.tag;
829+
P.string f tag;
824830
cxt)
825831
| Array_index (e, p) ->
826832
P.cond_paren_group f (level > 15) 1 (fun _ ->

jscomp/core/js_exp_make.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -800,8 +800,8 @@ let is_type_object (e : t) : t = string_equal (typeof e) (str "object")
800800
call plain [dot]
801801
*)
802802

803-
let tag ?comment e : t =
804-
{ expression_desc = Caml_block_tag e; comment }
803+
let tag ?comment ?(name=Js_dump_lit.tag) e : t =
804+
{ expression_desc = Caml_block_tag (e, name); comment }
805805

806806
(* according to the compiler, [Btype.hash_variant],
807807
it's reduced to 31 bits for hash

jscomp/core/js_exp_make.mli

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -307,7 +307,7 @@ val unit : t
307307

308308
val undefined : t
309309

310-
val tag : ?comment:string -> J.expression -> t
310+
val tag : ?comment:string -> ?name:string -> J.expression -> t
311311

312312
(** Note that this is coupled with how we encode block, if we use the
313313
`Object.defineProperty(..)` since the array already hold the length,

jscomp/core/js_fold.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -162,7 +162,7 @@ class fold =
162162
let _self = list (fun _self -> _self#expression) _self _x0 in
163163
let _self = _self#expression _x2 in
164164
_self
165-
| Caml_block_tag _x0 ->
165+
| Caml_block_tag (_x0, _tag) ->
166166
let _self = _self#expression _x0 in
167167
_self
168168
| Number _ -> _self

jscomp/core/js_record_fold.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -168,7 +168,7 @@ let expression_desc : 'a. ('a, expression_desc) fn =
168168
let st = list _self.expression _self st _x0 in
169169
let st = _self.expression _self st _x2 in
170170
st
171-
| Caml_block_tag _x0 ->
171+
| Caml_block_tag (_x0, _tag) ->
172172
let st = _self.expression _self st _x0 in
173173
st
174174
| Number _ -> st

jscomp/core/js_record_iter.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -128,7 +128,7 @@ let expression_desc : expression_desc fn =
128128
| Caml_block (_x0, _x1, _x2, _x3) ->
129129
list _self.expression _self _x0;
130130
_self.expression _self _x2
131-
| Caml_block_tag _x0 -> _self.expression _self _x0
131+
| Caml_block_tag (_x0, _tag) -> _self.expression _self _x0
132132
| Number _ -> ()
133133
| Object _x0 -> property_map _self _x0
134134
| Undefined -> ()

jscomp/core/js_record_map.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -166,9 +166,9 @@ let expression_desc : expression_desc fn =
166166
let _x0 = list _self.expression _self _x0 in
167167
let _x2 = _self.expression _self _x2 in
168168
Caml_block (_x0, _x1, _x2, _x3)
169-
| Caml_block_tag _x0 ->
169+
| Caml_block_tag (_x0, tag) ->
170170
let _x0 = _self.expression _self _x0 in
171-
Caml_block_tag _x0
171+
Caml_block_tag (_x0, tag)
172172
| Number _ as v -> v
173173
| Object _x0 ->
174174
let _x0 = property_map _self _x0 in

jscomp/core/lam_compile.ml

Lines changed: 16 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -141,9 +141,17 @@ let default_action ~saturated failaction =
141141
let get_const_name i (sw_names : Lambda.switch_names option) =
142142
match sw_names with None -> None | Some { consts } -> Some consts.(i)
143143

144-
let get_block_name i (sw_names : Lambda.switch_names option) =
144+
let get_block i (sw_names : Lambda.switch_names option) =
145145
match sw_names with None -> None | Some { blocks } -> Some blocks.(i)
146146

147+
let get_tag_name (sw_names : Lambda.switch_names option) =
148+
match sw_names with
149+
| None -> Js_dump_lit.tag
150+
| Some { blocks } ->
151+
(match Array.find_opt (fun {Lambda.tag_name} -> tag_name <> None) blocks with
152+
| Some {tag_name = Some s} -> s
153+
| _ -> Js_dump_lit.tag
154+
)
147155

148156
let has_null_undefined_other (sw_names : Lambda.switch_names option) =
149157
let (null, undefined, other) = (ref false, ref false, ref false) in
@@ -628,7 +636,11 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch)
628636
default_action ~saturated:sw_blocks_full sw_failaction
629637
in
630638
let get_const_name i = get_const_name i sw_names in
631-
let get_block_name i = get_block_name i sw_names in
639+
let get_block i = get_block i sw_names in
640+
let get_block_name i = match get_block i with
641+
| None -> None
642+
| Some {cstr_name} -> Some cstr_name in
643+
let tag_name = get_tag_name sw_names in
632644
let compile_whole (cxt : Lam_compile_context.t) =
633645
match
634646
compile_lambda { cxt with continuation = NeedValue Not_tail } switch_arg
@@ -638,7 +650,7 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch)
638650
block
639651
@
640652
if sw_consts_full && sw_consts = [] then
641-
compile_cases cxt (E.tag e) sw_blocks sw_blocks_default get_block_name
653+
compile_cases cxt (E.tag ~name:tag_name e) sw_blocks sw_blocks_default get_block_name
642654
else if sw_blocks_full && sw_blocks = [] then
643655
compile_cases cxt e sw_consts sw_num_default get_const_name
644656
else
@@ -648,7 +660,7 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch)
648660
(compile_cases cxt e sw_consts sw_num_default get_const_name)
649661
(* default still needed, could simplified*)
650662
~else_:
651-
(compile_cases cxt (E.tag e) sw_blocks sw_blocks_default
663+
(compile_cases cxt (E.tag ~name:tag_name e) sw_blocks sw_blocks_default
652664
get_block_name)
653665
in
654666
match e.expression_desc with

0 commit comments

Comments
 (0)