diff --git a/compiler/ml/typetexp.ml b/compiler/ml/typetexp.ml index 53758e26c1..f05b252d7e 100644 --- a/compiler/ml/typetexp.ml +++ b/compiler/ml/typetexp.ml @@ -206,6 +206,7 @@ let create_package_mty fake loc env (p, l) = (* Translation of type expressions *) let type_variables = ref (Tbl.empty : (string, type_expr) Tbl.t) +let type_param_names = ref ([] : string list) let univars = ref ([] : (string * type_expr) list) let pre_univars = ref ([] : type_expr list) let used_variables = ref (Tbl.empty : (string, type_expr * Location.t) Tbl.t) @@ -213,7 +214,8 @@ let used_variables = ref (Tbl.empty : (string, type_expr * Location.t) Tbl.t) let reset_type_variables () = reset_global_level (); Ctype.reset_reified_var_counter (); - type_variables := Tbl.empty + type_variables := Tbl.empty; + type_param_names := [] let narrow () = (increase_global_level (), !type_variables) @@ -252,6 +254,7 @@ let transl_type_param env styp = with Not_found -> let v = new_global_var ~name () in type_variables := Tbl.add name v !type_variables; + type_param_names := !type_param_names @ [name]; v in { @@ -565,8 +568,133 @@ and transl_type_aux env policy styp = pack_txt = p; }) ty - | Ptyp_extension ext -> - raise (Error_forward (Builtin_attributes.error_of_extension ext)) + | Ptyp_extension ext -> ( + match ext with + | {txt = "typeof"; loc = ext_loc}, payload -> ( + (* %typeof payload must be a single identifier *) + match Ast_payload.as_ident payload with + | Some ({txt = lid; loc = lid_loc} as _ident) -> + (* Lookup the value and embed its (generalized) type. + Important: avoid manufacturing polymorphism from a monomorphic + (weak) type, which would violate the value restriction. We only + allow %typeof on values whose type is a closed type scheme. *) + let _path, desc = find_value env lid_loc lid in + let ty0 = desc.val_type in + let () = + if not (Ctype.closed_schema env ty0) then + let msg = + "Cannot use %typeof on this value, because its type is not fully \ + known yet.\n\n" + ^ "%typeof needs a value whose type is completely determined at \ + this point.\n" + ^ "For example, [] or ref([]) don't say what element type they \ + hold yet.\n\n" ^ "How to fix:\n" + ^ "- Add a type annotation to the value (e.g. let u: array \ + = [];).\n" + ^ "- Or define the value in a way that makes its type known \ + immediately.\n\n" + ^ "Note: This is related to the value restriction \ + (non-generalizable type variables)." + in + raise (Error_forward (Location.error ~loc:ext_loc msg)) + in + (match !type_param_names with + | [] -> () + | lhs_params -> + let rhs_vars = Ctype.free_variables ty0 in + let rhs_names_opt = + List.map + (fun v -> + match (Ctype.repr v).desc with + | Tvar (Some n) | Tunivar (Some n) -> Some n + | _ -> None) + rhs_vars + in + let mk_params_string names = + match names with + | [] -> "< >" + | _ -> + let parts = List.map (fun n -> "'" ^ n) names in + Printf.sprintf "<%s>" (String.concat ", " parts) + in + let error msg = + raise (Error_forward (Location.error ~loc:ext_loc msg)) + in + if List.mem None rhs_names_opt then + error + "This %typeof(...) expression refers to a polymorphic value \ + whose type variables have no names.\n\ + Name the type variables in the value's type annotation (e.g. \ + promise<'response>), and use the same names here in the type \ + definition."; + let rhs_named = + List.filter_map + (fun v -> + match (Ctype.repr v).desc with + | Tvar (Some n) | Tunivar (Some n) -> Some (n, v) + | _ -> None) + rhs_vars + in + let rhs_names = List.map fst rhs_named in + let module S = Set.Make (String) in + let s_lhs = + List.fold_left (fun s x -> S.add x s) S.empty lhs_params + in + let s_rhs = List.fold_left (fun s x -> S.add x s) S.empty rhs_names in + (if not (S.equal s_lhs s_rhs) then + let missing = S.elements (S.diff s_rhs s_lhs) in + let extra = S.elements (S.diff s_lhs s_rhs) in + let parts = + ( [] |> fun acc -> + if missing <> [] then + acc + @ [ + Printf.sprintf "Missing on the left: %s" + (mk_params_string missing); + ] + else acc ) + |> fun acc -> + if extra <> [] then + acc + @ [ + Printf.sprintf "Remove from the left: %s" + (mk_params_string extra); + ] + else acc + in + let header = + Printf.sprintf + "This identifier `%s` has type variables %s, but your type \ + parameters are %s." + (Longident.last lid) + (mk_params_string rhs_names) + (mk_params_string lhs_params) + in + error + (if parts = [] then header + else header ^ "\n\n" ^ String.concat "\n" parts)); + (* Tie variables: unify each LHS param with the corresponding RHS var by name. + %typeof reuses the value's scheme whose vars are distinct; tying + ensures the alias shares those vars (passes closedness, keeps names). *) + List.iter + (fun lhs_name -> + let lhs_param = Tbl.find lhs_name !type_variables in + let rhs_var = List.assoc lhs_name rhs_named in + Ctype.unify_var env lhs_param rhs_var) + lhs_params); + (* Preserve type variable names so that typedecl can enforce exact + name/order mapping against LHS parameters. Since we already ensured + the scheme is closed, we can reuse the original scheme here. *) + let ty = ty0 in + (* Build a core_type node carrying the looked up type; we mark the + desc as any since downstream only consults ctyp_type for typing. *) + ctyp Ttyp_any ty + | None -> + let msg = + "%%typeof expects an identifier. Example: type t = %typeof(x)" + in + raise (Error_forward (Location.error ~loc:ext_loc msg))) + | _ -> raise (Error_forward (Builtin_attributes.error_of_extension ext))) and transl_poly_type env policy t = transl_type env policy (Ast_helper.Typ.force_poly t) diff --git a/tests/analysis_tests/tests/src/Hover.res b/tests/analysis_tests/tests/src/Hover.res index bd40d4e712..737bddaba4 100644 --- a/tests/analysis_tests/tests/src/Hover.res +++ b/tests/analysis_tests/tests/src/Hover.res @@ -281,3 +281,13 @@ module Arr = Belt.Array type aliased = variant // ^hov + +let myFn = (a, b) => a ++ b->Int.toString + +type fnType = %typeof(myFn) +// ^hov + +let myFnPartial = myFn("hello", ...) + +type fnTypePartial = %typeof(myFnPartial) +// ^hov diff --git a/tests/analysis_tests/tests/src/expected/Hover.res.txt b/tests/analysis_tests/tests/src/expected/Hover.res.txt index f9f1746e15..a23e090621 100644 --- a/tests/analysis_tests/tests/src/expected/Hover.res.txt +++ b/tests/analysis_tests/tests/src/expected/Hover.res.txt @@ -348,3 +348,9 @@ Hover src/Hover.res 278:8 Hover src/Hover.res 281:6 {"contents": {"kind": "markdown", "value": "```rescript\ntype aliased = variant\n```\n\n---\n\n```\n \n```\n```rescript\ntype variant = CoolVariant | OtherCoolVariant\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22Hover.res%22%2C251%2C0%5D)\n"}} +Hover src/Hover.res 286:6 +{"contents": {"kind": "markdown", "value": "```rescript\ntype fnType = (string, int) => string\n```"}} + +Hover src/Hover.res 291:6 +{"contents": {"kind": "markdown", "value": "```rescript\ntype fnTypePartial = int => string\n```"}} + diff --git a/tests/build_tests/super_errors/expected/typeof_mismatch.res.expected b/tests/build_tests/super_errors/expected/typeof_mismatch.res.expected new file mode 100644 index 0000000000..b4c28afc92 --- /dev/null +++ b/tests/build_tests/super_errors/expected/typeof_mismatch.res.expected @@ -0,0 +1,13 @@ + + We've found a bug for you! + /.../fixtures/typeof_mismatch.res:6:28 + + 4 │ + 5 │ let f: fnType = myFn + 6 │ let ff: fnType = (a, b) => a->Int.toString + b + 7 │ + + This has type: string + But this function argument is expecting: int + + You can convert string to int with Int.fromString. \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/typeof_non_generalized.res.expected b/tests/build_tests/super_errors/expected/typeof_non_generalized.res.expected new file mode 100644 index 0000000000..01cb91d10d --- /dev/null +++ b/tests/build_tests/super_errors/expected/typeof_non_generalized.res.expected @@ -0,0 +1,19 @@ + + We've found a bug for you! + /.../fixtures/typeof_non_generalized.res:3:10-16 + + 1 │ let u = [] + 2 │ + 3 │ type t = %typeof(u) + 4 │ + + Cannot use %typeof on this value, because its type is not fully known yet. + +%typeof needs a value whose type is completely determined at this point. +For example, [] or ref([]) don't say what element type they hold yet. + +How to fix: +- Add a type annotation to the value (e.g. let u: array = [];). +- Or define the value in a way that makes its type known immediately. + +Note: This is related to the value restriction (non-generalizable type variables). \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/typeof_non_ident.res.expected b/tests/build_tests/super_errors/expected/typeof_non_ident.res.expected new file mode 100644 index 0000000000..befeb10555 --- /dev/null +++ b/tests/build_tests/super_errors/expected/typeof_non_ident.res.expected @@ -0,0 +1,8 @@ + + We've found a bug for you! + /.../fixtures/typeof_non_ident.res:1:10-16 + + 1 │ type t = %typeof(1 + 2) + 2 │ + + %%typeof expects an identifier. Example: type t = %typeof(x) \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/typeof_param_count_mismatch.res.expected b/tests/build_tests/super_errors/expected/typeof_param_count_mismatch.res.expected new file mode 100644 index 0000000000..e5810722f3 --- /dev/null +++ b/tests/build_tests/super_errors/expected/typeof_param_count_mismatch.res.expected @@ -0,0 +1,12 @@ + + We've found a bug for you! + /.../fixtures/typeof_param_count_mismatch.res:3:29-35 + + 1 │ external fetch: string => promise<'response> = "fetch" + 2 │ + 3 │ type fetch<'response, 'x> = %typeof(fetch) + 4 │ + + This identifier `fetch` has type variables <'response>, but your type parameters are <'response, 'x>. + +Remove from the left: <'x> \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/typeof_param_name_mismatch.res.expected b/tests/build_tests/super_errors/expected/typeof_param_name_mismatch.res.expected new file mode 100644 index 0000000000..fe59ae7c38 --- /dev/null +++ b/tests/build_tests/super_errors/expected/typeof_param_name_mismatch.res.expected @@ -0,0 +1,13 @@ + + We've found a bug for you! + /.../fixtures/typeof_param_name_mismatch.res:3:21-27 + + 1 │ external fetch: string => promise<'response> = "fetch" + 2 │ + 3 │ type fetch<'resp> = %typeof(fetch) + 4 │ + + This identifier `fetch` has type variables <'response>, but your type parameters are <'resp>. + +Missing on the left: <'response> +Remove from the left: <'resp> \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/typeof_mismatch.res b/tests/build_tests/super_errors/fixtures/typeof_mismatch.res new file mode 100644 index 0000000000..784ac0b97d --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/typeof_mismatch.res @@ -0,0 +1,6 @@ +let myFn = (a, b) => a ++ b->Int.toString + +type fnType = %typeof(myFn) + +let f: fnType = myFn +let ff: fnType = (a, b) => a->Int.toString + b diff --git a/tests/build_tests/super_errors/fixtures/typeof_non_generalized.res b/tests/build_tests/super_errors/fixtures/typeof_non_generalized.res new file mode 100644 index 0000000000..90f181f96a --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/typeof_non_generalized.res @@ -0,0 +1,3 @@ +let u = [] + +type t = %typeof(u) diff --git a/tests/build_tests/super_errors/fixtures/typeof_non_ident.res b/tests/build_tests/super_errors/fixtures/typeof_non_ident.res new file mode 100644 index 0000000000..36602691e9 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/typeof_non_ident.res @@ -0,0 +1 @@ +type t = %typeof(1 + 2) diff --git a/tests/build_tests/super_errors/fixtures/typeof_param_count_mismatch.res b/tests/build_tests/super_errors/fixtures/typeof_param_count_mismatch.res new file mode 100644 index 0000000000..b77b3e45b9 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/typeof_param_count_mismatch.res @@ -0,0 +1,3 @@ +external fetch: string => promise<'response> = "fetch" + +type fetch<'response, 'x> = %typeof(fetch) diff --git a/tests/build_tests/super_errors/fixtures/typeof_param_name_mismatch.res b/tests/build_tests/super_errors/fixtures/typeof_param_name_mismatch.res new file mode 100644 index 0000000000..b925c94a49 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/typeof_param_name_mismatch.res @@ -0,0 +1,3 @@ +external fetch: string => promise<'response> = "fetch" + +type fetch<'resp> = %typeof(fetch) diff --git a/tests/tests/src/Typeof.mjs b/tests/tests/src/Typeof.mjs new file mode 100644 index 0000000000..9ae61f8347 --- /dev/null +++ b/tests/tests/src/Typeof.mjs @@ -0,0 +1,14 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE + + +function myFn(a, b) { + return a + b.toString(); +} + +let f = myFn; + +export { + myFn, + f, +} +/* No side effect */ diff --git a/tests/tests/src/Typeof.res b/tests/tests/src/Typeof.res new file mode 100644 index 0000000000..cd684b5ce2 --- /dev/null +++ b/tests/tests/src/Typeof.res @@ -0,0 +1,9 @@ +let myFn = (a, b) => a ++ b->Int.toString + +type fnType = %typeof(myFn) + +let f: fnType = myFn + +external fetch: string => promise<'response> = "fetch" + +type fetch<'response> = %typeof(fetch)