Type check and compile letfuns

This commit is contained in:
Ulf Norell 2019-05-10 12:28:45 +02:00
parent 251b876495
commit 1ae5974762
5 changed files with 26 additions and 3 deletions

View File

@ -1133,9 +1133,11 @@ 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, Attrs, [Def={letfun, _, _, _, _, _}|Rest], BlockType) -> infer_block(Env, Attrs, [Def={letfun, Ann, _, _, _, _}|Rest], BlockType) ->
NewDef = infer_letfun(Env, Def), {{Name, TypeSig}, LetFun} = infer_letfun(Env, Def),
[NewDef|infer_block(Env, Attrs, Rest, BlockType)]; FunT = freshen_type(typesig_to_fun_t(TypeSig)),
NewE = bind_var({id, Ann, Name}, FunT, Env),
[LetFun|infer_block(NewE, Attrs, Rest, BlockType)];
infer_block(Env, Attrs, [Def={letrec, _, _}|Rest], BlockType) -> infer_block(Env, Attrs, [Def={letrec, _, _}|Rest], BlockType) ->
NewDef = infer_letrec(Env, Def), NewDef = infer_letrec(Env, Def),
[NewDef|infer_block(Env, Attrs, Rest, BlockType)]; [NewDef|infer_block(Env, Attrs, Rest, BlockType)];

View File

@ -722,6 +722,9 @@ decision_tree_to_fcode({'if', A, Then, Else}) ->
-spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr(). -spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr().
stmts_to_fcode(Env, [{letval, _, {typed, _, {id, _, X}, _}, _, Expr} | Stmts]) -> stmts_to_fcode(Env, [{letval, _, {typed, _, {id, _, X}, _}, _, Expr} | Stmts]) ->
{'let', X, expr_to_fcode(Env, Expr), stmts_to_fcode(bind_var(Env, X), Stmts)}; {'let', X, expr_to_fcode(Env, Expr), stmts_to_fcode(bind_var(Env, X), Stmts)};
stmts_to_fcode(Env, [{letfun, Ann, {id, _, X}, Args, _Type, Expr} | Stmts]) ->
{'let', X, expr_to_fcode(Env, {lam, Ann, Args, Expr}),
stmts_to_fcode(bind_var(Env, X), Stmts)};
stmts_to_fcode(Env, [Expr]) -> stmts_to_fcode(Env, [Expr]) ->
expr_to_fcode(Env, Expr); expr_to_fcode(Env, Expr);
stmts_to_fcode(Env, [Expr | Stmts]) -> stmts_to_fcode(Env, [Expr | Stmts]) ->

View File

@ -530,6 +530,8 @@ ast_body({switch,_,A,Cases}, Icode) ->
ast_body({block,As,[{letval,_,Pat,_,E}|Rest]}, Icode) -> ast_body({block,As,[{letval,_,Pat,_,E}|Rest]}, Icode) ->
#switch{expr=ast_body(E, Icode), #switch{expr=ast_body(E, Icode),
cases=[{ast_body(Pat, Icode),ast_body({block,As,Rest}, Icode)}]}; cases=[{ast_body(Pat, Icode),ast_body({block,As,Rest}, Icode)}]};
ast_body({block, As, [{letfun, Ann, F, Args, _Type, Expr} | Rest]}, Icode) ->
ast_body({block, As, [{letval, Ann, F, unused, {lam, Ann, Args, Expr}} | Rest]}, Icode);
ast_body({block,_,[]}, _Icode) -> ast_body({block,_,[]}, _Icode) ->
#tuple{cpts=[]}; #tuple{cpts=[]};
ast_body({block,_,[E]}, Icode) -> ast_body({block,_,[E]}, Icode) ->

View File

@ -86,6 +86,7 @@ compilable_contracts() ->
"dutch_auction", "dutch_auction",
"environment", "environment",
"factorial", "factorial",
"functions",
"fundme", "fundme",
"identity", "identity",
"maps", "maps",

View File

@ -0,0 +1,15 @@
contract Functions =
private function curry(f : ('a, 'b) => 'c) =
(x) => (y) => f(x, y)
private function map(f : 'a => 'b, xs : list('a)) =
switch(xs)
[] => []
x :: xs => f(x) :: map(f, xs)
private function map'() = map
private function plus(x, y) = x + y
function test1(xs : list(int)) = map(curry(plus)(5), xs)
function test2(xs : list(int)) = map'()(((x) => (y) => ((x, y) => x + y)(x, y))(100), xs)
function test3(xs : list(int)) =
let m(f, xs) = map(f, xs)
m((x) => x + 1, xs)