Skip to content

Commit 062f0d2

Browse files
zthzth
committed
wip sketching out an IR for the runtime representation of types
1 parent 6838749 commit 062f0d2

File tree

4 files changed

+256
-0
lines changed

4 files changed

+256
-0
lines changed

‎jscomp/core/matching_polyfill.ml

+1
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@
2323
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
2424

2525
let () = Ast_untagged_variants.extract_concrete_typedecl := Ctype.extract_concrete_typedecl
26+
let () = Runtime_representation.extract_concrete_typedecl := Ctype.extract_concrete_typedecl
2627
let () = Ast_untagged_variants.expand_head := Ctype.expand_head
2728

2829
let names_from_construct_pattern (pat : Typedtree.pattern) =

‎jscomp/ml/ctype.ml

+1
Original file line numberDiff line numberDiff line change
@@ -3560,6 +3560,7 @@ let rec subtype_rec env trace t1 t2 cstrs =
35603560
cstrs
35613561
with Not_found ->
35623562
TypePairs.add subtypes (t1, t2) ();
3563+
Runtime_representation.log t1 t2 env |> print_endline;
35633564
match (t1.desc, t2.desc) with
35643565
(Tvar _, _) | (_, Tvar _) ->
35653566
(trace, t1, t2, !univar_pairs)::cstrs

‎jscomp/ml/runtime_representation.ml

+242
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,242 @@
1+
let extract_concrete_typedecl :
2+
(Env.t -> Types.type_expr -> Path.t * Path.t * Types.type_declaration) ref =
3+
ref (Obj.magic ())
4+
5+
type 'value value = Known of 'value | Unknown
6+
7+
type object_property = {
8+
key: string;
9+
value: runtime_js_value list value;
10+
optional: bool;
11+
}
12+
and runtime_js_value =
13+
| String of {value: string value}
14+
| Number of {value: string value}
15+
| BigInt of {value: string value}
16+
| Boolean of {value: bool value}
17+
| NullLiteral
18+
| UndefinedLiteral
19+
| Array of {element_type: runtime_js_value value}
20+
| Object of {
21+
properties: object_property list;
22+
can_have_unknown_properties: bool;
23+
}
24+
| Dict of {value_type: runtime_js_value list}
25+
| Promise of {resolved_type: runtime_js_value value}
26+
| Any
27+
28+
let rec debug_print_runtime_value (value : runtime_js_value) =
29+
match value with
30+
| String {value = Known v} -> Printf.sprintf "String(%s)" v
31+
| String {value = Unknown} -> "String"
32+
| Number {value = Known v} -> Printf.sprintf "Number(%s)" v
33+
| Number {value = Unknown} -> "Number"
34+
| BigInt {value = Known v} -> Printf.sprintf "BigInt(%s)" v
35+
| BigInt {value = Unknown} -> "BigInt"
36+
| Boolean {value = Known v} -> Printf.sprintf "Boolean(%b)" v
37+
| Boolean {value = Unknown} -> "Boolean"
38+
| NullLiteral -> "Null"
39+
| UndefinedLiteral -> "Undefined"
40+
| Array {element_type = Known v} ->
41+
Printf.sprintf "Array(%s)" (debug_print_runtime_value v)
42+
| Array {element_type = Unknown} -> "Array"
43+
| Object {properties} ->
44+
Printf.sprintf "Object(%s)"
45+
(properties
46+
|> List.map (fun {key; value; optional} ->
47+
Printf.sprintf "{key: %s, value: %s, optional: %b}" key
48+
(match value with
49+
| Known v ->
50+
v |> List.map debug_print_runtime_value |> String.concat ", "
51+
| Unknown -> "Unknown")
52+
optional)
53+
|> String.concat ", ")
54+
| Promise {resolved_type = Known v} ->
55+
Printf.sprintf "Promise(%s)" (debug_print_runtime_value v)
56+
| Any -> "Any"
57+
| _ -> "__other__"
58+
59+
type runtime_representation = {possible_values: runtime_js_value list}
60+
61+
let tag_type_to_possible_values (tag_type : Ast_untagged_variants.tag_type) :
62+
runtime_js_value =
63+
match tag_type with
64+
| String v -> String {value = Known v}
65+
| Int v -> Number {value = Known (string_of_int v)}
66+
| Float v -> Number {value = Known v}
67+
| BigInt v -> BigInt {value = Known v}
68+
| Bool v -> Boolean {value = Known v}
69+
| Null -> NullLiteral
70+
| Undefined -> UndefinedLiteral
71+
| Untagged (IntType | FloatType) -> Number {value = Unknown}
72+
| Untagged StringType -> String {value = Unknown}
73+
| Untagged BooleanType -> Boolean {value = Unknown}
74+
| Untagged ObjectType ->
75+
Object {properties = []; can_have_unknown_properties = true}
76+
| Untagged UnknownType -> Any
77+
| _ -> Any
78+
79+
let process_fields fields env type_expr_to_possible_values =
80+
fields
81+
|> List.map (fun (label : Types.label_declaration) ->
82+
{
83+
optional = false (* TODO: Replicate existing rules*);
84+
key = label.ld_id.name (* TODO: @as attribute *);
85+
value = Known (type_expr_to_possible_values label.ld_type env);
86+
})
87+
88+
let rec type_expr_to_possible_values (type_expr : Types.type_expr) (env : Env.t)
89+
: runtime_js_value list =
90+
match type_expr.desc with
91+
(* Builtins *)
92+
| Tconstr (p, _, _) when Path.same p Predef.path_string ->
93+
[String {value = Unknown}]
94+
| Tconstr (p, _, _) when Path.same p Predef.path_bool ->
95+
[Boolean {value = Unknown}]
96+
| Tconstr (p, _, _)
97+
when Path.same p Predef.path_float || Path.same p Predef.path_int ->
98+
[Number {value = Unknown}]
99+
| Tconstr (p, [inner], _) when Path.same p Predef.path_option ->
100+
[UndefinedLiteral] @ type_expr_to_possible_values inner env
101+
| Tconstr (p, [inner], _) when Path.same p Predef.path_dict ->
102+
[Dict {value_type = type_expr_to_possible_values inner env}]
103+
(* Types needing lookup*)
104+
| Tconstr (_, _, _) -> (
105+
try
106+
match !extract_concrete_typedecl env type_expr with
107+
| _, _, {type_kind = Type_abstract | Type_open} -> [Any]
108+
| _, _, {type_kind = Type_record (fields, _)} ->
109+
[
110+
Object
111+
{
112+
properties = process_fields fields env type_expr_to_possible_values;
113+
can_have_unknown_properties = false;
114+
};
115+
]
116+
| _, _, {type_kind = Type_variant consructors; type_attributes} ->
117+
let _unboxed = Ast_untagged_variants.process_untagged type_attributes in
118+
let tag_name = Ast_untagged_variants.process_tag_name type_attributes in
119+
120+
consructors
121+
|> List.map (fun (c : Types.constructor_declaration) ->
122+
let tag_type =
123+
Ast_untagged_variants.process_tag_type c.cd_attributes
124+
in
125+
match (c.cd_args, tag_type) with
126+
| Cstr_tuple [], None -> String {value = Known c.cd_id.name}
127+
| Cstr_tuple [], Some tag_type ->
128+
tag_type_to_possible_values tag_type
129+
| Cstr_tuple payloads, maybe_tag_type ->
130+
let tag_value =
131+
match maybe_tag_type with
132+
| Some tag_type -> tag_type_to_possible_values tag_type
133+
| None -> String {value = Known c.cd_id.name}
134+
in
135+
Object
136+
{
137+
properties =
138+
[
139+
{
140+
optional = false;
141+
key =
142+
(match tag_name with
143+
| None -> "TAG"
144+
| Some t -> t);
145+
value = Known [tag_value];
146+
};
147+
]
148+
@ (payloads
149+
|> List.mapi (fun index (payload : Types.type_expr) ->
150+
{
151+
optional = false;
152+
key = "_" ^ string_of_int index;
153+
value =
154+
Known
155+
(type_expr_to_possible_values payload env);
156+
}));
157+
can_have_unknown_properties = false;
158+
}
159+
| Cstr_record fields, maybe_tag_type ->
160+
let tag_value =
161+
match maybe_tag_type with
162+
| Some tag_type -> tag_type_to_possible_values tag_type
163+
| None -> String {value = Known c.cd_id.name}
164+
in
165+
Object
166+
{
167+
properties =
168+
[
169+
{
170+
optional = false;
171+
key =
172+
(match tag_name with
173+
| None -> "TAG"
174+
| Some t -> t);
175+
value = Known [tag_value];
176+
};
177+
]
178+
@ process_fields fields env type_expr_to_possible_values;
179+
can_have_unknown_properties = false;
180+
})
181+
with Not_found -> [Any])
182+
(* Polyvariants *)
183+
| Tvariant {row_fields; row_closed} ->
184+
row_fields
185+
|> List.map (fun ((label, field) : string * Types.row_field) ->
186+
match field with
187+
| Rpresent None -> [String {value = Known label}]
188+
| Rpresent (Some inner) ->
189+
[
190+
Object
191+
{
192+
can_have_unknown_properties = not row_closed;
193+
properties =
194+
[
195+
{
196+
key = "NAME";
197+
value = Known [String {value = Known label}];
198+
optional = false;
199+
};
200+
{
201+
key = "VAL";
202+
optional = false;
203+
value = Known (type_expr_to_possible_values inner env);
204+
};
205+
];
206+
};
207+
]
208+
| _ -> [])
209+
|> List.concat
210+
| _ -> []
211+
212+
let runtime_values_match (a : runtime_js_value) (b : runtime_js_value) =
213+
match (a, b) with
214+
| String {value = Known a_value}, String {value = Known b_value} ->
215+
a_value = b_value
216+
| Number {value = Known a_value}, Number {value = Known b_value} ->
217+
a_value = b_value
218+
| BigInt {value = Known a_value}, BigInt {value = Known b_value} ->
219+
a_value = b_value
220+
| Boolean {value = Known a_value}, Boolean {value = Known b_value} ->
221+
a_value = b_value
222+
| NullLiteral, NullLiteral -> true
223+
| UndefinedLiteral, UndefinedLiteral -> true
224+
| _ -> false
225+
226+
let a_can_be_represented_as_b (a : runtime_js_value list)
227+
(b : runtime_js_value list) =
228+
a
229+
|> List.for_all (fun a_value ->
230+
b |> List.exists (fun b_value -> runtime_values_match a_value b_value))
231+
232+
let log t1 t2 env =
233+
Printf.sprintf "Can be coerced: %b\n\nt1 dump: %s\n\nt2 dump: %s\n"
234+
(a_can_be_represented_as_b
235+
(type_expr_to_possible_values t1 env)
236+
(type_expr_to_possible_values t2 env))
237+
(type_expr_to_possible_values t1 env
238+
|> List.map debug_print_runtime_value
239+
|> String.concat " | ")
240+
(type_expr_to_possible_values t2 env
241+
|> List.map debug_print_runtime_value
242+
|> String.concat " | ")

‎tst.res

+12
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
type x = [#One | #Two]
2+
3+
@tag("kind")
4+
type y = | @as("one") One({hello: [#hello]}) | @as(null) Two
5+
6+
let x: x = #One
7+
8+
let xx = #One({"hello": "hi"})
9+
10+
let y: y = One({hello: #hello})
11+
12+
let z = (x :> y)

0 commit comments

Comments
 (0)