From e317fa0ca0a6bd5f3a76df3360493f8dfc176637 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 30 Aug 2024 22:46:56 +0200 Subject: [PATCH 1/4] wip sketching out an IR for the runtime representation of types --- jscomp/core/matching_polyfill.ml | 1 + jscomp/ml/ctype.ml | 1 + jscomp/ml/runtime_representation.ml | 242 ++++++++++++++++++++++++++++ tst.res | 12 ++ 4 files changed, 256 insertions(+) create mode 100644 jscomp/ml/runtime_representation.ml create mode 100644 tst.res diff --git a/jscomp/core/matching_polyfill.ml b/jscomp/core/matching_polyfill.ml index 8955813581..a7a8a64d95 100644 --- a/jscomp/core/matching_polyfill.ml +++ b/jscomp/core/matching_polyfill.ml @@ -23,6 +23,7 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) let () = Ast_untagged_variants.extract_concrete_typedecl := Ctype.extract_concrete_typedecl +let () = Runtime_representation.extract_concrete_typedecl := Ctype.extract_concrete_typedecl let () = Ast_untagged_variants.expand_head := Ctype.expand_head let names_from_construct_pattern (pat : Typedtree.pattern) = diff --git a/jscomp/ml/ctype.ml b/jscomp/ml/ctype.ml index 950a1a598f..fe7fc8499c 100644 --- a/jscomp/ml/ctype.ml +++ b/jscomp/ml/ctype.ml @@ -3560,6 +3560,7 @@ let rec subtype_rec env trace t1 t2 cstrs = cstrs with Not_found -> TypePairs.add subtypes (t1, t2) (); + Runtime_representation.log t1 t2 env |> print_endline; match (t1.desc, t2.desc) with (Tvar _, _) | (_, Tvar _) -> (trace, t1, t2, !univar_pairs)::cstrs diff --git a/jscomp/ml/runtime_representation.ml b/jscomp/ml/runtime_representation.ml new file mode 100644 index 0000000000..5f6ed35f10 --- /dev/null +++ b/jscomp/ml/runtime_representation.ml @@ -0,0 +1,242 @@ +let extract_concrete_typedecl : + (Env.t -> Types.type_expr -> Path.t * Path.t * Types.type_declaration) ref = + ref (Obj.magic ()) + +type 'value value = Known of 'value | Unknown + +type object_property = { + key: string; + value: runtime_js_value list value; + optional: bool; +} +and runtime_js_value = + | String of {value: string value} + | Number of {value: string value} + | BigInt of {value: string value} + | Boolean of {value: bool value} + | NullLiteral + | UndefinedLiteral + | Array of {element_type: runtime_js_value value} + | Object of { + properties: object_property list; + can_have_unknown_properties: bool; + } + | Dict of {value_type: runtime_js_value list} + | Promise of {resolved_type: runtime_js_value value} + | Any + +let rec debug_print_runtime_value (value : runtime_js_value) = + match value with + | String {value = Known v} -> Printf.sprintf "String(%s)" v + | String {value = Unknown} -> "String" + | Number {value = Known v} -> Printf.sprintf "Number(%s)" v + | Number {value = Unknown} -> "Number" + | BigInt {value = Known v} -> Printf.sprintf "BigInt(%s)" v + | BigInt {value = Unknown} -> "BigInt" + | Boolean {value = Known v} -> Printf.sprintf "Boolean(%b)" v + | Boolean {value = Unknown} -> "Boolean" + | NullLiteral -> "Null" + | UndefinedLiteral -> "Undefined" + | Array {element_type = Known v} -> + Printf.sprintf "Array(%s)" (debug_print_runtime_value v) + | Array {element_type = Unknown} -> "Array" + | Object {properties} -> + Printf.sprintf "Object(%s)" + (properties + |> List.map (fun {key; value; optional} -> + Printf.sprintf "{key: %s, value: %s, optional: %b}" key + (match value with + | Known v -> + v |> List.map debug_print_runtime_value |> String.concat ", " + | Unknown -> "Unknown") + optional) + |> String.concat ", ") + | Promise {resolved_type = Known v} -> + Printf.sprintf "Promise(%s)" (debug_print_runtime_value v) + | Any -> "Any" + | _ -> "__other__" + +type runtime_representation = {possible_values: runtime_js_value list} + +let tag_type_to_possible_values (tag_type : Ast_untagged_variants.tag_type) : + runtime_js_value = + match tag_type with + | String v -> String {value = Known v} + | Int v -> Number {value = Known (string_of_int v)} + | Float v -> Number {value = Known v} + | BigInt v -> BigInt {value = Known v} + | Bool v -> Boolean {value = Known v} + | Null -> NullLiteral + | Undefined -> UndefinedLiteral + | Untagged (IntType | FloatType) -> Number {value = Unknown} + | Untagged StringType -> String {value = Unknown} + | Untagged BooleanType -> Boolean {value = Unknown} + | Untagged ObjectType -> + Object {properties = []; can_have_unknown_properties = true} + | Untagged UnknownType -> Any + | _ -> Any + +let process_fields fields env type_expr_to_possible_values = + fields + |> List.map (fun (label : Types.label_declaration) -> + { + optional = false (* TODO: Replicate existing rules*); + key = label.ld_id.name (* TODO: @as attribute *); + value = Known (type_expr_to_possible_values label.ld_type env); + }) + +let rec type_expr_to_possible_values (type_expr : Types.type_expr) (env : Env.t) + : runtime_js_value list = + match type_expr.desc with + (* Builtins *) + | Tconstr (p, _, _) when Path.same p Predef.path_string -> + [String {value = Unknown}] + | Tconstr (p, _, _) when Path.same p Predef.path_bool -> + [Boolean {value = Unknown}] + | Tconstr (p, _, _) + when Path.same p Predef.path_float || Path.same p Predef.path_int -> + [Number {value = Unknown}] + | Tconstr (p, [inner], _) when Path.same p Predef.path_option -> + [UndefinedLiteral] @ type_expr_to_possible_values inner env + | Tconstr (p, [inner], _) when Path.same p Predef.path_dict -> + [Dict {value_type = type_expr_to_possible_values inner env}] + (* Types needing lookup*) + | Tconstr (_, _, _) -> ( + try + match !extract_concrete_typedecl env type_expr with + | _, _, {type_kind = Type_abstract | Type_open} -> [Any] + | _, _, {type_kind = Type_record (fields, _)} -> + [ + Object + { + properties = process_fields fields env type_expr_to_possible_values; + can_have_unknown_properties = false; + }; + ] + | _, _, {type_kind = Type_variant consructors; type_attributes} -> + let _unboxed = Ast_untagged_variants.process_untagged type_attributes in + let tag_name = Ast_untagged_variants.process_tag_name type_attributes in + + consructors + |> List.map (fun (c : Types.constructor_declaration) -> + let tag_type = + Ast_untagged_variants.process_tag_type c.cd_attributes + in + match (c.cd_args, tag_type) with + | Cstr_tuple [], None -> String {value = Known c.cd_id.name} + | Cstr_tuple [], Some tag_type -> + tag_type_to_possible_values tag_type + | Cstr_tuple payloads, maybe_tag_type -> + let tag_value = + match maybe_tag_type with + | Some tag_type -> tag_type_to_possible_values tag_type + | None -> String {value = Known c.cd_id.name} + in + Object + { + properties = + [ + { + optional = false; + key = + (match tag_name with + | None -> "TAG" + | Some t -> t); + value = Known [tag_value]; + }; + ] + @ (payloads + |> List.mapi (fun index (payload : Types.type_expr) -> + { + optional = false; + key = "_" ^ string_of_int index; + value = + Known + (type_expr_to_possible_values payload env); + })); + can_have_unknown_properties = false; + } + | Cstr_record fields, maybe_tag_type -> + let tag_value = + match maybe_tag_type with + | Some tag_type -> tag_type_to_possible_values tag_type + | None -> String {value = Known c.cd_id.name} + in + Object + { + properties = + [ + { + optional = false; + key = + (match tag_name with + | None -> "TAG" + | Some t -> t); + value = Known [tag_value]; + }; + ] + @ process_fields fields env type_expr_to_possible_values; + can_have_unknown_properties = false; + }) + with Not_found -> [Any]) + (* Polyvariants *) + | Tvariant {row_fields; row_closed} -> + row_fields + |> List.map (fun ((label, field) : string * Types.row_field) -> + match field with + | Rpresent None -> [String {value = Known label}] + | Rpresent (Some inner) -> + [ + Object + { + can_have_unknown_properties = not row_closed; + properties = + [ + { + key = "NAME"; + value = Known [String {value = Known label}]; + optional = false; + }; + { + key = "VAL"; + optional = false; + value = Known (type_expr_to_possible_values inner env); + }; + ]; + }; + ] + | _ -> []) + |> List.concat + | _ -> [] + +let runtime_values_match (a : runtime_js_value) (b : runtime_js_value) = + match (a, b) with + | String {value = Known a_value}, String {value = Known b_value} -> + a_value = b_value + | Number {value = Known a_value}, Number {value = Known b_value} -> + a_value = b_value + | BigInt {value = Known a_value}, BigInt {value = Known b_value} -> + a_value = b_value + | Boolean {value = Known a_value}, Boolean {value = Known b_value} -> + a_value = b_value + | NullLiteral, NullLiteral -> true + | UndefinedLiteral, UndefinedLiteral -> true + | _ -> false + +let a_can_be_represented_as_b (a : runtime_js_value list) + (b : runtime_js_value list) = + a + |> List.for_all (fun a_value -> + b |> List.exists (fun b_value -> runtime_values_match a_value b_value)) + +let log t1 t2 env = + Printf.sprintf "Can be coerced: %b\n\nt1 dump: %s\n\nt2 dump: %s\n" + (a_can_be_represented_as_b + (type_expr_to_possible_values t1 env) + (type_expr_to_possible_values t2 env)) + (type_expr_to_possible_values t1 env + |> List.map debug_print_runtime_value + |> String.concat " | ") + (type_expr_to_possible_values t2 env + |> List.map debug_print_runtime_value + |> String.concat " | ") diff --git a/tst.res b/tst.res new file mode 100644 index 0000000000..79c3639c60 --- /dev/null +++ b/tst.res @@ -0,0 +1,12 @@ +type x = [#One | #Two] + +@tag("kind") +type y = | @as("one") One({hello: [#hello]}) | @as(null) Two + +let x: x = #One + +let xx = #One({"hello": "hi"}) + +let y: y = One({hello: #hello}) + +let z = (x :> y) From d49a23157867d073b75292d29779fe8120209558 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Wed, 11 Sep 2024 20:38:59 +0200 Subject: [PATCH 2/4] rename fn --- jscomp/ml/runtime_representation.ml | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/jscomp/ml/runtime_representation.ml b/jscomp/ml/runtime_representation.ml index 5f6ed35f10..d610860afa 100644 --- a/jscomp/ml/runtime_representation.ml +++ b/jscomp/ml/runtime_representation.ml @@ -76,16 +76,16 @@ let tag_type_to_possible_values (tag_type : Ast_untagged_variants.tag_type) : | Untagged UnknownType -> Any | _ -> Any -let process_fields fields env type_expr_to_possible_values = +let process_fields fields env to_runtime_representation = fields |> List.map (fun (label : Types.label_declaration) -> { optional = false (* TODO: Replicate existing rules*); key = label.ld_id.name (* TODO: @as attribute *); - value = Known (type_expr_to_possible_values label.ld_type env); + value = Known (to_runtime_representation label.ld_type env); }) -let rec type_expr_to_possible_values (type_expr : Types.type_expr) (env : Env.t) +let rec to_runtime_representation (type_expr : Types.type_expr) (env : Env.t) : runtime_js_value list = match type_expr.desc with (* Builtins *) @@ -97,9 +97,9 @@ let rec type_expr_to_possible_values (type_expr : Types.type_expr) (env : Env.t) when Path.same p Predef.path_float || Path.same p Predef.path_int -> [Number {value = Unknown}] | Tconstr (p, [inner], _) when Path.same p Predef.path_option -> - [UndefinedLiteral] @ type_expr_to_possible_values inner env + [UndefinedLiteral] @ to_runtime_representation inner env | Tconstr (p, [inner], _) when Path.same p Predef.path_dict -> - [Dict {value_type = type_expr_to_possible_values inner env}] + [Dict {value_type = to_runtime_representation inner env}] (* Types needing lookup*) | Tconstr (_, _, _) -> ( try @@ -109,7 +109,7 @@ let rec type_expr_to_possible_values (type_expr : Types.type_expr) (env : Env.t) [ Object { - properties = process_fields fields env type_expr_to_possible_values; + properties = process_fields fields env to_runtime_representation; can_have_unknown_properties = false; }; ] @@ -152,7 +152,7 @@ let rec type_expr_to_possible_values (type_expr : Types.type_expr) (env : Env.t) key = "_" ^ string_of_int index; value = Known - (type_expr_to_possible_values payload env); + (to_runtime_representation payload env); })); can_have_unknown_properties = false; } @@ -175,7 +175,7 @@ let rec type_expr_to_possible_values (type_expr : Types.type_expr) (env : Env.t) value = Known [tag_value]; }; ] - @ process_fields fields env type_expr_to_possible_values; + @ process_fields fields env to_runtime_representation; can_have_unknown_properties = false; }) with Not_found -> [Any]) @@ -200,7 +200,7 @@ let rec type_expr_to_possible_values (type_expr : Types.type_expr) (env : Env.t) { key = "VAL"; optional = false; - value = Known (type_expr_to_possible_values inner env); + value = Known (to_runtime_representation inner env); }; ]; }; @@ -232,11 +232,11 @@ let a_can_be_represented_as_b (a : runtime_js_value list) let log t1 t2 env = Printf.sprintf "Can be coerced: %b\n\nt1 dump: %s\n\nt2 dump: %s\n" (a_can_be_represented_as_b - (type_expr_to_possible_values t1 env) - (type_expr_to_possible_values t2 env)) - (type_expr_to_possible_values t1 env + (to_runtime_representation t1 env) + (to_runtime_representation t2 env)) + (to_runtime_representation t1 env |> List.map debug_print_runtime_value |> String.concat " | ") - (type_expr_to_possible_values t2 env + (to_runtime_representation t2 env |> List.map debug_print_runtime_value |> String.concat " | ") From 1f1acaae67982297c817c48b7ce6b3351b3b10b5 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Wed, 11 Sep 2024 20:45:08 +0200 Subject: [PATCH 3/4] expand to literal --- jscomp/ml/runtime_representation.ml | 68 +++++++++++++++-------------- 1 file changed, 36 insertions(+), 32 deletions(-) diff --git a/jscomp/ml/runtime_representation.ml b/jscomp/ml/runtime_representation.ml index d610860afa..9eac9afd5f 100644 --- a/jscomp/ml/runtime_representation.ml +++ b/jscomp/ml/runtime_representation.ml @@ -10,10 +10,14 @@ type object_property = { optional: bool; } and runtime_js_value = - | String of {value: string value} - | Number of {value: string value} - | BigInt of {value: string value} - | Boolean of {value: bool value} + | StringLiteral of {value: string} + | String + | NumberLiteral of {value: string} + | Number + | BigIntLiteral of {value: string} + | BigInt + | BooleanLiteral of {value: bool} + | Boolean | NullLiteral | UndefinedLiteral | Array of {element_type: runtime_js_value value} @@ -27,14 +31,14 @@ and runtime_js_value = let rec debug_print_runtime_value (value : runtime_js_value) = match value with - | String {value = Known v} -> Printf.sprintf "String(%s)" v - | String {value = Unknown} -> "String" - | Number {value = Known v} -> Printf.sprintf "Number(%s)" v - | Number {value = Unknown} -> "Number" - | BigInt {value = Known v} -> Printf.sprintf "BigInt(%s)" v - | BigInt {value = Unknown} -> "BigInt" - | Boolean {value = Known v} -> Printf.sprintf "Boolean(%b)" v - | Boolean {value = Unknown} -> "Boolean" + | StringLiteral {value = v} -> Printf.sprintf "StringLiteral(%s)" v + | String -> "String" + | NumberLiteral {value = v} -> Printf.sprintf "Number(%s)" v + | Number -> "Number" + | BigIntLiteral {value = v} -> Printf.sprintf "BigInt(%s)" v + | BigInt -> "BigInt" + | BooleanLiteral {value = v} -> Printf.sprintf "Boolean(%b)" v + | Boolean -> "Boolean" | NullLiteral -> "Null" | UndefinedLiteral -> "Undefined" | Array {element_type = Known v} -> @@ -61,16 +65,16 @@ type runtime_representation = {possible_values: runtime_js_value list} let tag_type_to_possible_values (tag_type : Ast_untagged_variants.tag_type) : runtime_js_value = match tag_type with - | String v -> String {value = Known v} - | Int v -> Number {value = Known (string_of_int v)} - | Float v -> Number {value = Known v} - | BigInt v -> BigInt {value = Known v} - | Bool v -> Boolean {value = Known v} + | String v -> StringLiteral {value = v} + | Int v -> NumberLiteral {value = (string_of_int v)} + | Float v -> NumberLiteral {value = v} + | BigInt v -> BigIntLiteral {value = v} + | Bool v -> BooleanLiteral {value = v} | Null -> NullLiteral | Undefined -> UndefinedLiteral - | Untagged (IntType | FloatType) -> Number {value = Unknown} - | Untagged StringType -> String {value = Unknown} - | Untagged BooleanType -> Boolean {value = Unknown} + | Untagged (IntType | FloatType) -> Number + | Untagged StringType -> String + | Untagged BooleanType -> Boolean | Untagged ObjectType -> Object {properties = []; can_have_unknown_properties = true} | Untagged UnknownType -> Any @@ -90,12 +94,12 @@ let rec to_runtime_representation (type_expr : Types.type_expr) (env : Env.t) match type_expr.desc with (* Builtins *) | Tconstr (p, _, _) when Path.same p Predef.path_string -> - [String {value = Unknown}] + [String] | Tconstr (p, _, _) when Path.same p Predef.path_bool -> - [Boolean {value = Unknown}] + [Boolean] | Tconstr (p, _, _) when Path.same p Predef.path_float || Path.same p Predef.path_int -> - [Number {value = Unknown}] + [Number] | Tconstr (p, [inner], _) when Path.same p Predef.path_option -> [UndefinedLiteral] @ to_runtime_representation inner env | Tconstr (p, [inner], _) when Path.same p Predef.path_dict -> @@ -123,14 +127,14 @@ let rec to_runtime_representation (type_expr : Types.type_expr) (env : Env.t) Ast_untagged_variants.process_tag_type c.cd_attributes in match (c.cd_args, tag_type) with - | Cstr_tuple [], None -> String {value = Known c.cd_id.name} + | Cstr_tuple [], None -> StringLiteral {value = c.cd_id.name} | Cstr_tuple [], Some tag_type -> tag_type_to_possible_values tag_type | Cstr_tuple payloads, maybe_tag_type -> let tag_value = match maybe_tag_type with | Some tag_type -> tag_type_to_possible_values tag_type - | None -> String {value = Known c.cd_id.name} + | None -> StringLiteral {value = c.cd_id.name} in Object { @@ -160,7 +164,7 @@ let rec to_runtime_representation (type_expr : Types.type_expr) (env : Env.t) let tag_value = match maybe_tag_type with | Some tag_type -> tag_type_to_possible_values tag_type - | None -> String {value = Known c.cd_id.name} + | None -> StringLiteral {value = c.cd_id.name} in Object { @@ -184,7 +188,7 @@ let rec to_runtime_representation (type_expr : Types.type_expr) (env : Env.t) row_fields |> List.map (fun ((label, field) : string * Types.row_field) -> match field with - | Rpresent None -> [String {value = Known label}] + | Rpresent None -> [StringLiteral {value = label}] | Rpresent (Some inner) -> [ Object @@ -194,7 +198,7 @@ let rec to_runtime_representation (type_expr : Types.type_expr) (env : Env.t) [ { key = "NAME"; - value = Known [String {value = Known label}]; + value = Known [StringLiteral {value = label}]; optional = false; }; { @@ -211,13 +215,13 @@ let rec to_runtime_representation (type_expr : Types.type_expr) (env : Env.t) let runtime_values_match (a : runtime_js_value) (b : runtime_js_value) = match (a, b) with - | String {value = Known a_value}, String {value = Known b_value} -> + | StringLiteral {value = a_value}, StringLiteral {value = b_value} -> a_value = b_value - | Number {value = Known a_value}, Number {value = Known b_value} -> + | NumberLiteral {value = a_value}, NumberLiteral {value = b_value} -> a_value = b_value - | BigInt {value = Known a_value}, BigInt {value = Known b_value} -> + | BigIntLiteral {value = a_value}, BigIntLiteral {value = b_value} -> a_value = b_value - | Boolean {value = Known a_value}, Boolean {value = Known b_value} -> + | BooleanLiteral {value = a_value}, BooleanLiteral {value = b_value} -> a_value = b_value | NullLiteral, NullLiteral -> true | UndefinedLiteral, UndefinedLiteral -> true From 44c3fef8255793bbebb23fa662e9c754c003fcb0 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Wed, 11 Sep 2024 21:38:38 +0200 Subject: [PATCH 4/4] broken poc of how one could leverage the runtime representation for error messages --- jscomp/ml/printtyp.ml | 16 ++++++++++++++++ jscomp/ml/runtime_representation.ml | 8 ++++++++ tst.res | 14 ++++---------- 3 files changed, 28 insertions(+), 10 deletions(-) diff --git a/jscomp/ml/printtyp.ml b/jscomp/ml/printtyp.ml index 41664610f1..46e420ecbd 100644 --- a/jscomp/ml/printtyp.ml +++ b/jscomp/ml/printtyp.ml @@ -1523,6 +1523,22 @@ let report_subtyping_error ppf env tr1 txt1 tr2 = let tr1 = List.map prepare_expansion tr1 and tr2 = List.map prepare_expansion tr2 in fprintf ppf "@[%a" (trace true (tr2 = []) txt1) tr1; + (match tr1 with + | [(t1, _); (_, t2)] -> + let a_runtime_representation = Runtime_representation.to_runtime_representation t2 env in + let b_runtime_representation = Runtime_representation.to_runtime_representation t1 env in + a_runtime_representation |> List.iter( + fun a_value -> + b_runtime_representation |> List.iter( + fun b_value -> + if Runtime_representation.runtime_values_match a_value b_value then ( + () + ) + else Runtime_representation.explain_why_not_matching a_value b_value + |> List.iter(fun s -> fprintf ppf "@ %s" s) + )) + | _ -> () + ); if tr2 = [] then fprintf ppf "@]" else let mis = mismatch tr2 in fprintf ppf "%a%t@]" diff --git a/jscomp/ml/runtime_representation.ml b/jscomp/ml/runtime_representation.ml index 9eac9afd5f..326e9a7a18 100644 --- a/jscomp/ml/runtime_representation.ml +++ b/jscomp/ml/runtime_representation.ml @@ -213,6 +213,14 @@ let rec to_runtime_representation (type_expr : Types.type_expr) (env : Env.t) |> List.concat | _ -> [] +let explain_why_not_matching (a : runtime_js_value) (b : runtime_js_value) = + match (a, b) with + | StringLiteral {value = a_value}, StringLiteral {value = b_value} when a_value != b_value -> + [Printf.sprintf "The left hand is will be the string '%s' in runtime, and the right hand will be '%s'." b_value a_value] + | Any, _ -> ["We don't know what value left hand side would have at runtime."] + | _, Any -> ["We don't know what value right hand side would have at runtime."] + | _ -> [] + let runtime_values_match (a : runtime_js_value) (b : runtime_js_value) = match (a, b) with | StringLiteral {value = a_value}, StringLiteral {value = b_value} -> diff --git a/tst.res b/tst.res index 79c3639c60..43b9aac435 100644 --- a/tst.res +++ b/tst.res @@ -1,12 +1,6 @@ -type x = [#One | #Two] +type one = OK +type two = NOPE -@tag("kind") -type y = | @as("one") One({hello: [#hello]}) | @as(null) Two +let one: one = OK -let x: x = #One - -let xx = #One({"hello": "hi"}) - -let y: y = One({hello: #hello}) - -let z = (x :> y) +let two = (one :> two)