Fix compiler crash on missing let body

This commit is contained in:
Ulf Norell 2019-06-21 14:16:26 +02:00
parent d38367e023
commit 7fa98892a8
3 changed files with 34 additions and 4 deletions

View File

@ -1134,7 +1134,13 @@ infer_expr(Env, {lam, Attrs, Args, Body}) ->
{'case', _, {typed, _, {tuple, _, NewArgPatterns}, _}, NewBody} = {'case', _, {typed, _, {tuple, _, NewArgPatterns}, _}, NewBody} =
infer_case(Env, Attrs, {tuple, Attrs, ArgPatterns}, {tuple_t, Attrs, ArgTypes}, Body, ResultType), infer_case(Env, Attrs, {tuple, Attrs, ArgPatterns}, {tuple_t, Attrs, ArgTypes}, Body, ResultType),
NewArgs = [{arg, As, NewPat, NewT} || {typed, As, NewPat, NewT} <- NewArgPatterns], NewArgs = [{arg, As, NewPat, NewT} || {typed, As, NewPat, NewT} <- NewArgPatterns],
{typed, Attrs, {lam, Attrs, NewArgs, NewBody}, {fun_t, Attrs, [], ArgTypes, ResultType}}. {typed, Attrs, {lam, Attrs, NewArgs, NewBody}, {fun_t, Attrs, [], ArgTypes, ResultType}};
infer_expr(Env, Let = {letval, Attrs, _, _, _}) ->
type_error({missing_body_for_let, Attrs}),
infer_expr(Env, {block, Attrs, [Let, abort_expr(Attrs, "missing body")]});
infer_expr(Env, Let = {letfun, Attrs, _, _, _, _}) ->
type_error({missing_body_for_let, Attrs}),
infer_expr(Env, {block, Attrs, [Let, abort_expr(Attrs, "missing body")]}).
infer_named_arg(Env, NamedArgs, {named_arg, Ann, Id, E}) -> infer_named_arg(Env, NamedArgs, {named_arg, Ann, Id, E}) ->
CheckedExpr = {typed, _, _, ArgType} = infer_expr(Env, E), CheckedExpr = {typed, _, _, ArgType} = infer_expr(Env, E),
@ -1208,6 +1214,8 @@ infer_case(Env, Attrs, Pattern, ExprType, Branch, SwitchType) ->
%% NewStmts = infer_block(Env, Attrs, Stmts, BlockType) %% NewStmts = infer_block(Env, Attrs, Stmts, BlockType)
infer_block(_Env, Attrs, [], BlockType) -> infer_block(_Env, Attrs, [], BlockType) ->
error({impossible, empty_block, Attrs, BlockType}); error({impossible, empty_block, Attrs, BlockType});
infer_block(Env, _, [E], BlockType) ->
[check_expr(Env, E, BlockType)];
infer_block(Env, Attrs, [Def={letfun, Ann, _, _, _, _}|Rest], BlockType) -> infer_block(Env, Attrs, [Def={letfun, Ann, _, _, _, _}|Rest], BlockType) ->
{{Name, TypeSig}, LetFun} = infer_letfun(Env, Def), {{Name, TypeSig}, LetFun} = infer_letfun(Env, Def),
FunT = freshen_type(typesig_to_fun_t(TypeSig)), FunT = freshen_type(typesig_to_fun_t(TypeSig)),
@ -1218,8 +1226,6 @@ infer_block(Env, _, [{letval, Attrs, Pattern, Type, E}|Rest], BlockType) ->
{'case', _, NewPattern, {typed, _, {block, _, NewRest}, _}} = {'case', _, NewPattern, {typed, _, {block, _, NewRest}, _}} =
infer_case(Env, Attrs, Pattern, PatType, {block, Attrs, Rest}, BlockType), infer_case(Env, Attrs, Pattern, PatType, {block, Attrs, Rest}, BlockType),
[{letval, Attrs, NewPattern, Type, NewE}|NewRest]; [{letval, Attrs, NewPattern, Type, NewE}|NewRest];
infer_block(Env, _, [E], BlockType) ->
[check_expr(Env, E, BlockType)];
infer_block(Env, Attrs, [E|Rest], BlockType) -> infer_block(Env, Attrs, [E|Rest], BlockType) ->
[infer_expr(Env, E)|infer_block(Env, Attrs, Rest, BlockType)]. [infer_expr(Env, E)|infer_block(Env, Attrs, Rest, BlockType)].
@ -1255,6 +1261,9 @@ infer_prefix({IntOp,As}) when IntOp =:= '-' ->
Int = {id, As, "int"}, Int = {id, As, "int"},
{fun_t, As, [], [Int], Int}. {fun_t, As, [], [Int], Int}.
abort_expr(Ann, Str) ->
{app, Ann, {id, Ann, "abort"}, [{string, Ann, Str}]}.
free_vars({int, _, _}) -> free_vars({int, _, _}) ->
[]; [];
free_vars({char, _, _}) -> free_vars({char, _, _}) ->
@ -2029,6 +2038,8 @@ pp_error({init_depends_on_state, Which, [_Init | Chain]}) ->
[if Which == put -> "write"; true -> "read" end, [if Which == put -> "write"; true -> "read" end,
[ io_lib:format(" - ~s (at ~s)~s\n", [Fun, pp_loc(Ann), WhichCalls(Fun)]) [ io_lib:format(" - ~s (at ~s)~s\n", [Fun, pp_loc(Ann), WhichCalls(Fun)])
|| {[_, Fun], Ann} <- Chain]]); || {[_, Fun], Ann} <- Chain]]);
pp_error({missing_body_for_let, Ann}) ->
io_lib:format("Let binding at ~s must be followed by an expression\n", [pp_loc(Ann)]);
pp_error(Err) -> pp_error(Err) ->
io_lib:format("Unknown error: ~p\n", [Err]). io_lib:format("Unknown error: ~p\n", [Err]).

View File

@ -208,7 +208,11 @@ failing_contracts() ->
<<"Repeated argument y to function repeated_arg (at line 44, column 12).">>, <<"Repeated argument y to function repeated_arg (at line 44, column 12).">>,
<<"No record type with fields y, z (at line 14, column 22)">>, <<"No record type with fields y, z (at line 14, column 22)">>,
<<"The field z is missing when constructing an element of type r2 (at line 15, column 24)">>, <<"The field z is missing when constructing an element of type r2 (at line 15, column 24)">>,
<<"Record type r2 does not have field y (at line 15, column 22)">>]} <<"Record type r2 does not have field y (at line 15, column 22)">>,
<<"Let binding at line 47, column 5 must be followed by an expression">>,
<<"Let binding at line 50, column 5 must be followed by an expression">>,
<<"Let binding at line 54, column 5 must be followed by an expression">>,
<<"Let binding at line 58, column 5 must be followed by an expression">>]}
, {"init_type_error", , {"init_type_error",
[<<"Cannot unify string\n" [<<"Cannot unify string\n"
" and map(int, int)\n" " and map(int, int)\n"

View File

@ -42,3 +42,18 @@ contract Test =
set_x(set_x(x, r), x) set_x(set_x(x, r), x)
function repeated_arg(x : int, y, x : string, y : bool) : string = x function repeated_arg(x : int, y, x : string, y : bool) : string = x
function missing1() =
let x = 0
function missing_fun1() =
let f(x) = x
function missing2() =
let x = 0
let y = 0
function missing_fun2() =
let f() = 0
let g() = f()