Skip to content

Commit

Permalink
Labellize Typedecl.transl_with_constraints
Browse files Browse the repository at this point in the history
make the optional row_fixed_path argument more explicit
  • Loading branch information
Octachron committed Nov 7, 2019
1 parent d8f0da6 commit 481c60a
Show file tree
Hide file tree
Showing 3 changed files with 10 additions and 9 deletions.
4 changes: 2 additions & 2 deletions typing/typedecl.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1430,7 +1430,7 @@ let transl_value_decl env loc valdecl =

(* Translate a "with" constraint -- much simplified version of
transl_type_decl. *)
let transl_with_constraint env id row_path orig_decl sdecl =
let transl_with_constraint env id ?fixed_row_path orig_decl sdecl =
Env.mark_type_used (Ident.name id) orig_decl;
reset_type_variables();
Ctype.begin_def();
Expand Down Expand Up @@ -1489,7 +1489,7 @@ let transl_with_constraint env id row_path orig_decl sdecl =
type_unboxed;
}
in
Option.iter (fun p -> set_fixed_row env p decl) row_path;
Option.iter (fun p -> set_fixed_row env p decl) fixed_row_path;
begin match Ctype.closed_type_decl decl with None -> ()
| Some ty -> raise(Error(sdecl.ptype_loc, Unbound_type_var(ty,decl)))
end;
Expand Down
6 changes: 3 additions & 3 deletions typing/typedecl.mli
Original file line number Diff line number Diff line change
Expand Up @@ -38,10 +38,10 @@ val transl_value_decl:
Env.t -> Location.t ->
Parsetree.value_description -> Typedtree.value_description * Env.t

(* If a [Path.t] optional argument is provided, the [Parsetree.type_declaration]
argument should satisfy [is_fixed_type] *)
(* If the [fixed_row_path] optional argument is provided,
the [Parsetree.type_declaration] argument should satisfy [is_fixed_type] *)
val transl_with_constraint:
Env.t -> Ident.t -> Path.t option -> Types.type_declaration ->
Env.t -> Ident.t -> ?fixed_row_path:Path.t -> Types.type_declaration ->
Parsetree.type_declaration -> Typedtree.type_declaration

val abstract_type_decl: int -> type_declaration
Expand Down
9 changes: 5 additions & 4 deletions typing/typemod.ml
Original file line number Diff line number Diff line change
Expand Up @@ -496,8 +496,9 @@ let merge_constraint initial_env remove_aliases loc sg constr =
let initial_env =
Env.add_type ~check:false id_row decl_row initial_env
in
let tdecl = Typedecl.transl_with_constraint
initial_env id (Some(Pident id_row)) decl sdecl in
let tdecl =
Typedecl.transl_with_constraint
initial_env id ~fixed_row_path:(Pident id_row) decl sdecl in
let newdecl = tdecl.typ_type in

This comment has been minimized.

Copy link
@gasche

gasche Nov 7, 2019

Member

Naive question, probably for @trefis or @garrigue: instead of passing ~fixed_row_path:(Pident id_row) here, why can't we just call set_fixed_row env tdecl.type_loc newdecl (Pident id_row) here? (I suppose that some of the stuff that happens in transl_with_constraint may interact with the set_fixed_row call?)

This comment has been minimized.

Copy link
@garrigue

garrigue Nov 8, 2019

Contributor

Modifying a definition after the fact in another module doesn't look like a good design.
Moreover, the original declaration would be invalid. It contains an unbound free variable.

This comment has been minimized.

Copy link
@gasche

gasche Nov 8, 2019

Member

I don't understand what the code does but the API feels strange to me. This optional parameter is only used once, and setting it is invalid for many parts of the input space: it is only valid if the preconditions to set_fixed_row are verified. The caller has more information on the fact that set_fixed_row is permissible at the callsite -- indeed, we checked is_fixed_type above, which is precisely the same precondition. The whole thing smells like it would be nicer if the logic to set the row type was done here, rather than within transl_with_constraint; it could be done by changing decl or sdecl in some way, or by transforming the result after the fact.

This is a minor point and it's probably not worth spending a lot of effort on it, but the current API is bad and the face-lifting that @Octachron performed is only making things superficially better.

check_type_decl env sdecl.ptype_loc id row_id newdecl decl rs rem;
let decl_row = {decl_row with type_params = newdecl.type_params} in
Expand All @@ -509,7 +510,7 @@ let merge_constraint initial_env remove_aliases loc sg constr =
| (Sig_type(id, decl, rs, priv) :: rem , [s], Pwith_type (_, sdecl))
when Ident.name id = s ->
let tdecl =
Typedecl.transl_with_constraint initial_env id None decl sdecl in
Typedecl.transl_with_constraint initial_env id decl sdecl in
let newdecl = tdecl.typ_type in
check_type_decl env sdecl.ptype_loc id row_id newdecl decl rs rem;
(Pident id, lid, Twith_type tdecl),
Expand All @@ -521,7 +522,7 @@ let merge_constraint initial_env remove_aliases loc sg constr =
when Ident.name id = s ->
(* Check as for a normal with constraint, but discard definition *)
let tdecl =
Typedecl.transl_with_constraint initial_env id None decl sdecl in
Typedecl.transl_with_constraint initial_env id decl sdecl in
let newdecl = tdecl.typ_type in
check_type_decl env sdecl.ptype_loc id row_id newdecl decl rs rem;
real_ids := [Pident id];
Expand Down

0 comments on commit 481c60a

Please sign in to comment.