Skip to content

Print jkind on locally abstract type #2115

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
16 changes: 10 additions & 6 deletions ocaml/typing/ctype.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1322,7 +1322,7 @@ let get_new_abstract_name env s =
let index = Misc.find_first_mono check in
name index

let new_local_type ?(loc = Location.none) ?manifest_and_scope jkind =
let new_local_type ?(loc = Location.none) ?manifest_and_scope jkind ~jkind_annot =
let manifest, expansion_scope =
match manifest_and_scope with
None -> None, Btype.lowest_level
Expand All @@ -1333,7 +1333,7 @@ let new_local_type ?(loc = Location.none) ?manifest_and_scope jkind =
type_arity = 0;
type_kind = Type_abstract Abstract_def;
type_jkind = jkind;
type_jkind_annotation = None;
type_jkind_annotation = jkind_annot;
type_private = Public;
type_manifest = manifest;
type_variance = [];
Expand Down Expand Up @@ -1371,7 +1371,7 @@ let instance_constructor existential_treatment cstr =
(* Existential row variable *)
| _ -> assert false
in
let decl = new_local_type jkind in
let decl = new_local_type jkind ~jkind_annot:None in
let name = existential_name cstr existential in
let (id, new_env) =
Env.enter_type (get_new_abstract_name !env name) decl !env
Expand Down Expand Up @@ -2613,7 +2613,7 @@ let reify env t =
let fresh_constr_scope = get_gadt_equations_level () in
let create_fresh_constr lev name jkind =
let name = match name with Some s -> "$'"^s | _ -> "$" in
let decl = new_local_type jkind in
let decl = new_local_type jkind ~jkind_annot:None in
let (id, new_env) =
Env.enter_type (get_new_abstract_name !env name) decl !env
~scope:fresh_constr_scope in
Expand Down Expand Up @@ -2975,7 +2975,8 @@ let jkind_of_abstract_type_declaration env p =
which guards the case of unify3 that reaches this function. Would be
nice to eliminate the duplication, but is seems tricky to do so without
complicating unify3. *)
(Env.find_type p env).type_jkind
let typ = Env.find_type p env in
typ.type_jkind, typ.type_jkind_annotation
with
Not_found -> assert false

Expand Down Expand Up @@ -3015,10 +3016,13 @@ let add_gadt_equation env source destination =
(* Recording the actual jkind here is required, not just for efficiency.
When we check the jkind later, we may not be able to see the local
equation because of its scope. *)
let jkind = jkind_of_abstract_type_declaration !env source in
let jkind, jkind_annot =
jkind_of_abstract_type_declaration !env source
in
add_jkind_equation ~reason:(Gadt_equation source) env destination jkind;
let decl =
new_local_type ~manifest_and_scope:(destination, expansion_scope) jkind
~jkind_annot
in
env := Env.add_local_type source decl !env;
cleanup_abbrev ()
Expand Down
2 changes: 1 addition & 1 deletion ocaml/typing/ctype.mli
Original file line number Diff line number Diff line change
Expand Up @@ -176,7 +176,7 @@ val instance_list: type_expr list -> type_expr list
(* Take an instance of a list of type schemes *)
val new_local_type:
?loc:Location.t -> ?manifest_and_scope:(type_expr * int) ->
Jkind.t -> type_declaration
Jkind.t -> jkind_annot:Jkind.annotation option -> type_declaration
val existential_name: constructor_description -> type_expr -> string

type existential_treatment =
Expand Down
3 changes: 2 additions & 1 deletion ocaml/typing/typecore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1402,6 +1402,7 @@ let solve_constructor_annotation tps env name_list sty ty_args ty_ex =
annotations on explicitly quantified vars in gadt constructors.
See: https://github.com/ocaml/ocaml/pull/9584/ *)
let decl = new_local_type ~loc:name.loc
~jkind_annot:None
(Jkind.value ~why:Existential_type_variable) in
let (id, new_env) =
Env.enter_type ~scope:expansion_scope name.txt decl !env in
Expand Down Expand Up @@ -7656,7 +7657,7 @@ and type_newtype ~loc ~env ~expected_mode ~rue ~attributes
(* Use [with_local_level] just for scoping *)
let body, ety = with_local_level begin fun () ->
(* Create a fake abstract type declaration for name. *)
let decl = new_local_type ~loc jkind in
let decl = new_local_type ~loc jkind ~jkind_annot in
let scope = create_scope () in
let (id, new_env) = Env.enter_type ~scope name decl env in

Expand Down