Skip to content

Commit

Permalink
Merge pull request #116 from j14159/fix-113
Browse files Browse the repository at this point in the history 
Concrete type parameters for types as type members
  • Loading branch information
@j14159
j14159 committed Jan 30, 2017
2 parents 31fe2d9 + bc29876 commit a39cdff
Show file tree
Hide file tree
Showing 4 changed files with 159 additions and 12 deletions.
3 changes: 2 additions & 1 deletion src/alpaca_ast.hrl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -231,7 +231,8 @@
line=0 :: integer(),
module=undefined :: atom(),
name={type_name, -1, ""} :: alpaca_type_name(),
vars=[] :: list(alpaca_type_var()),
vars=[] :: list(alpaca_type_var()
| {alpaca_type_var(), typ()}),
members=[] :: list(alpaca_constructor()
| alpaca_type_var()
| alpaca_types())
Expand Down
14 changes: 11 additions & 3 deletions src/alpaca_ast_gen.erl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1616,7 +1616,10 @@ ambiguous_type_expressions_test() ->
vars=[],
members=[#alpaca_type{
name={type_name,1,"foo"},
vars=[],
vars=[{_, #alpaca_type{
name={type_name, _, "bar"}}},
{_, #alpaca_type{
name={type_name, _, "baz"}}}],
members=[#alpaca_type{
name={type_name,1,"bar"},
vars=[],
Expand All @@ -1631,10 +1634,15 @@ ambiguous_type_expressions_test() ->
vars=[],
members=[#alpaca_type{
name={type_name,1,"foo"},
vars=[],
vars=[{_,
#alpaca_type{
name={type_name, _, "bar"},
vars=[{_,
#alpaca_type{
name={_, _, "baz"}}}]}}],
members=[#alpaca_type{
name={type_name,1,"bar"},
vars=[],
vars=[_],
members=[#alpaca_type{
name={type_name,1,"baz"},
vars=[],
Expand Down
20 changes: 18 additions & 2 deletions src/alpaca_parser.yrl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -133,7 +133,10 @@ type_expressions -> sub_type_expr type_expressions : ['$1'|'$2'].
poly_type -> symbol type_expressions :
{symbol, L, N} = '$1',
Members = '$2',
Vars = [V || {type_var, _, _}=V <- Members],

%% Any concrete type in the type_expressions gets a synthesized variable name:
Vars = make_vars_for_concrete_types('$2', L),

#alpaca_type{
line = L,
name = {type_name, L, N},
Expand Down Expand Up @@ -164,11 +167,14 @@ module_qualified_type -> module_qualified_type_name :

module_qualified_type -> module_qualified_type_name type_expressions:
{module_qualified_type_name, L, Mod, Name} = '$1',
%% Any concrete type in the type_expressions gets a synthesized variable name:
Vars = make_vars_for_concrete_types('$2', L),

#alpaca_type{
line = L,
module = list_to_atom(Mod),
name = {type_name, L, Name},
vars = [V || {type_var, _, _}=V <- '$2']}.
vars = Vars}.

type_expr -> poly_type : '$1'.
type_expr -> module_qualified_type : '$1'.
Expand Down Expand Up @@ -767,3 +773,13 @@ add_qualifier(#alpaca_bits{}=B, {bin_text_encoding, Enc}) ->
B#alpaca_bits{type=list_to_atom(Enc)};
add_qualifier(#alpaca_bits{}=B, {bin_sign, _, S}) ->
B#alpaca_bits{sign=list_to_atom(S)}.

make_vars_for_concrete_types(Vars, Line) ->
F = fun({type_var, _, _}=V, {Vs, VarNum}) ->
{[V|Vs], VarNum};
(Expr, {Vs, VarNum}) ->
VN = ":SynthTypeVar_" ++ integer_to_list(VarNum),
{[{{type_var, Line, VN}, Expr}|Vs], VarNum + 1}
end,
{Vs, _} = lists:foldl(F, {[], 0}, Vars),
lists:reverse(Vs).
134 changes: 128 additions & 6 deletions src/alpaca_typer.erl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -657,14 +657,14 @@ unify_adt(_C1, _C2,
case lists:filter(MemberFilter(NB), UnpackMembers(MA)) of
[#adt{vars=ToCheck}] ->
UnifyFun = fun(_, {error, _}=Err) -> Err;
({{_, X}, {_, Y}}, ok) -> unify(L, X, Y, Env)
({{_, X}, {_, Y}}, ok) -> unify(X, Y, Env, L)
end,
lists:foldl(UnifyFun, ok, lists:zip(VarsB, ToCheck));
_ ->
case lists:filter(MemberFilter(NA), UnpackMembers(MB)) of
[#adt{vars=ToCheck}] ->
UnifyFun = fun(_, {error, _}=Err) -> Err;
({{_, X}, {_, Y}}, ok) -> unify(L, X, Y, Env)
({{_, X}, {_, Y}}, ok) -> unify(X, Y, Env, L)
end,
lists:foldl(UnifyFun, ok, lists:zip(VarsA, ToCheck));
_ ->
Expand Down Expand Up @@ -869,7 +869,12 @@ inst_type(Typ, EnvIn) ->
#alpaca_type{name={type_name, _, N}, module=Mod, vars=Vs, members=Ms} = Typ,
VarFolder = fun({type_var, _, VN}, {Vars, E}) ->
{TVar, E2} = new_var(0, E),
{[{VN, TVar}|Vars], E2}
{[{VN, TVar}|Vars], E2};
({{type_var, _, VN}, Expr}, {Vars, E}) ->
%% copy_cell/1 should put every nested member properly
%% into its own reference cell:
{Celled, _} = copy_cell(Expr, maps:new()),
{[{VN, Celled}|Vars], E}
end,
{Vars, Env} = lists:foldl(VarFolder, {[], EnvIn}, Vs),
ParentADT = #adt{name=N, module=Mod, vars=lists:reverse(Vars)},
Expand Down Expand Up @@ -940,6 +945,7 @@ inst_type_members(#adt{vars=Vs}=ADT, [{type_var, L, N}|T], Env, Memo) ->
{error, _}=Err -> Err;
Typ -> inst_type_members(ADT, T, Env, [Typ|Memo])
end;

inst_type_members(ADT, [#alpaca_type_tuple{members=Ms}|T], Env, Memo) ->
case inst_type_members(ADT, Ms, Env, []) of
{error, _}=Err ->
Expand Down Expand Up @@ -1104,10 +1110,15 @@ inst_constructor_arg(#alpaca_type{name={type_name, _, N}, vars=Vars, members=M1}
false -> Vars
end,

ADT_vars = [{VN, proplists:get_value(VN, Vs)} || {type_var, _, VN} <- VarsToUse],
F = fun({type_var, _, VN}) ->
{VN, proplists:get_value(VN, Vs)};
({{type_var, _, _}, _}=ConcreteType) ->
ConcreteType
end,
ADT_Vars = lists:map(F, VarsToUse),
Vs2 = replace_vars(M1, V2, Vs),
Members = lists:map(fun(M) -> inst_constructor_arg(M, Vs2, Types) end, M2),
new_cell(#adt{name=N, vars=ADT_vars, members=Members, module=Mod});
new_cell(#adt{name=N, vars=ADT_Vars, members=Members, module=Mod});

inst_constructor_arg({t_arrow, ArgTypes, RetType}, Vs, Types) ->
InstantiatedArgs = [ inst_constructor_arg(A, Vs, Types) || A <- ArgTypes ],
Expand Down Expand Up @@ -3210,7 +3221,7 @@ type_constructor_with_aliased_arrow_arg_test() ->
#adt{name="intbinop",
vars=[],
members=[#adt{name="binop",
vars=[{"a",undefined}],
vars=[{_, t_int}],
members=[{t_arrow,[t_int,t_int],t_int}]}]},
{t_arrow,[t_int,t_atom],t_rec}}},
module_typ_and_parse(Invalid)).
Expand Down Expand Up @@ -4669,4 +4680,115 @@ curry_applications_test_() ->
end
].

%% For issue #113, we want to be able to define a polymorphic type and use it
%% as a member in another type but with a concrete type rather than variables,
%% e.g.
%%
%% type option 'a = Some 'a | None
%% type int_option = option 'a
%%
concrete_type_parameters_test_() ->
[fun() ->
Code =
"module concrete_option\n"
"type opt 'a = Some 'a | None\n"
"type uses_opt = Uses opt int\n"
"let f () = Uses Some 1",
?assertMatch({ok, #alpaca_module{}},
module_typ_and_parse(Code))
end,
fun() ->
Code =
"module should_not_unify "
"type opt 'a = Some 'a | None "
"type uses_opt = Uses opt int "
"let f () = Uses Some 1.0",
?assertMatch({error, {cannot_unify, _, _, t_float, t_int}},
module_typ_and_parse(Code))
end,
fun() ->
Option =
"module option "
"export_type option "
"type option 'a = Some 'a | None",

UsesOption =
"module uses_option "
"type int_opt = IntOpt option.option int "
"let make_opt x = IntOpt option.Some x",

ImportsOption =
"module imports_option "
"import_type option.option "
"type int_opt = IntOpt option int "
"let make_opt x = IntOpt Some x",

Mods1 = alpaca_ast_gen:make_modules([Option, UsesOption]),
Mods2 = alpaca_ast_gen:make_modules([Option, ImportsOption]),

?assertMatch({ok,
[#alpaca_module{
name=uses_option,
types=[#alpaca_type{
members=[#alpaca_constructor{
arg=#alpaca_type{
name={_, _, "option"},
module=option,
vars=[{_, t_int}]
}}]}],
functions=[#alpaca_fun_def{
type={t_arrow,
[t_int],
#adt{
name="int_opt",
module=uses_option
}}
}]
},
#alpaca_module{}]},
type_modules(Mods1)),
?assertMatch({ok,
[#alpaca_module{
name=imports_option,
types=[#alpaca_type{
members=[#alpaca_constructor{
arg=#alpaca_type{
name={_, _, "option"},
vars=[{_, t_int}]
}}]}],
functions=[#alpaca_fun_def{
type={t_arrow,
[t_int],
#adt{
name="int_opt",
module=imports_option
}}
}]
},
#alpaca_module{}]},
type_modules(Mods2))
end,
%% From @danabr's example on PR #116
fun() ->
Code =
"module int_opt \n"
"type opt 'a = Some 'a | None \n"
"type int_opt = opt int \n"
"type indirect = Indirect int_opt \n"
"let deconstruct (Indirect opt) = \n"
"match opt with \n"
"(Some 1) -> :blah \n",

?assertMatch({ok,
#alpaca_module{
functions=[#alpaca_fun_def{
type={t_arrow,
[#adt{name="indirect"}],
t_atom}
}]
}},
module_typ_and_parse(Code))
end
].

-endif.

0 comments on commit a39cdff

Please sign in to comment.