src/aeso_ast_to_fcode.erl

@@ -75,6 +75,7 @@
                | {switch, fsplit()}
                | {set_state, state_reg(), fexpr()}
                | {get_state, state_reg()}
+               | {loop, fexpr(), var_name(), fexpr()} | {continue, fexpr()} | {break, fexpr()}
                %% The following (unapplied top-level functions/builtins and
                %% lambdas) are generated by the fcode compiler, but translated
                %% to closures by the lambda lifter.
@@ -651,11 +652,22 @@ expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Rec, Fields}) ->
 expr_to_fcode(Env, _Type, {list, _, Es}) ->
     lists:foldr(fun(E, L) -> {op, '::', [expr_to_fcode(Env, E), L]} end,
                 nil, Es);
-
 expr_to_fcode(Env, _Type, {app, _, {'..', _}, [A, B]}) ->
-    {def_u, FromTo, _} = resolve_fun(Env, ["ListInternal", "from_to"]),
+    AV = fresh_name(), % var to keep B
-    {def, FromTo, [expr_to_fcode(Env, A), expr_to_fcode(Env, B)]};
+    WithA = fun(X) -> {'let', AV, expr_to_fcode(Env, A), X} end,
-
+    St = fresh_name(), % loop state
+    ItProj = {proj, {var, St}, 1},
+    AcProj = {proj, {var, St}, 0},
+    Init = {tuple, [nil, expr_to_fcode(Env, B)]},
+    Loop = {loop, Init, St,
+            make_if(
+              {op, '>=', [ItProj, {var, AV}]},
+              {continue, {tuple, [{op, '::', [ItProj, AcProj]},
+                                  {op, '-', [ItProj, {lit, {int, 1}}]}
+                                 ]}},
+              {break, AcProj}
+             )},
+    WithA(Loop);
 expr_to_fcode(Env, _Type, {list_comp, _, Yield, []}) ->
     {op, '::', [expr_to_fcode(Env, Yield), nil]};
 expr_to_fcode(Env, _Type, {list_comp, As, Yield, [{comprehension_bind, Pat = {typed, _, _, PatType}, BindExpr}|Rest]}) ->
@@ -1338,6 +1350,9 @@ lambda_lift_expr(Layout, Expr) ->
         {proj, A, I}           -> {proj, lambda_lift_expr(Layout, A), I};
         {set_proj, A, I, B}    -> {set_proj, lambda_lift_expr(Layout, A), I, lambda_lift_expr(Layout, B)};
         {op, Op, As}           -> {op, Op, lambda_lift_exprs(Layout, As)};
+        {loop, Init, I, Body}  -> {loop, lambda_lift_expr(Layout, Init), I, lambda_lift_expr(Layout, Body)};
+        {break, E}             -> {break, lambda_lift_expr(Layout, E)};
+        {continue, E}          -> {continue, lambda_lift_expr(Layout, E)};
         {'let', X, A, B}       -> {'let', X, lambda_lift_expr(Layout, A), lambda_lift_expr(Layout, B)};
         {funcall, A, Bs}       -> {funcall, lambda_lift_expr(Layout, A), lambda_lift_exprs(Layout, Bs)};
         {set_state, R, A}      -> {set_state, R, lambda_lift_expr(Layout, A)};
@@ -1653,6 +1668,9 @@ read_only({switch, Split})         -> read_only(Split);
 read_only({split, _, _, Cases})    -> read_only(Cases);
 read_only({nosplit, E})            -> read_only(E);
 read_only({'case', _, Split})      -> read_only(Split);
+read_only({loop, Init, _, Body})   -> read_only(Init) andalso read_only(Body);
+read_only({break, E})              -> read_only(E);
+read_only({continue, E})           -> read_only(E);
 read_only({'let', _, A, B})        -> read_only([A, B]);
 read_only({funcall, _, _})         -> false;
 read_only({closure, _, _})         -> internal_error(no_closures_here);
@@ -1850,6 +1868,9 @@ free_vars(Expr) ->
         {proj, A, _}         -> free_vars(A);
         {set_proj, A, _, B}  -> free_vars([A, B]);
         {op, _, As}          -> free_vars(As);
+        {loop, Init, Var, Body} -> free_vars(Init) ++ (free_vars(Body) -- [Var]);
+        {break, E}           -> free_vars(E);
+        {continue, E}        -> free_vars(E);
         {'let', X, A, B}     -> free_vars([A, {lam, [X], B}]);
         {funcall, A, Bs}     -> free_vars([A | Bs]);
         {set_state, _, A}    -> free_vars(A);
@@ -1881,6 +1902,9 @@ used_defs(Expr) ->
         {proj, A, _}         -> used_defs(A);
         {set_proj, A, _, B}  -> used_defs([A, B]);
         {op, _, As}          -> used_defs(As);
+        {loop, I, _, B}      -> used_defs(I) ++ used_defs(B);
+        {break, E}           -> used_defs(E);
+        {continue, E}        -> used_defs(E);
         {'let', _, A, B}     -> used_defs([A, B]);
         {funcall, A, Bs}     -> used_defs([A | Bs]);
         {set_state, _, A}    -> used_defs(A);
@@ -1917,6 +1941,9 @@ bottom_up(F, Env, Expr) ->
         {get_state, _}                   -> Expr;
         {closure, F, CEnv}               -> {closure, F, bottom_up(F, Env, CEnv)};
         {switch, Split}                  -> {switch, bottom_up(F, Env, Split)};
+        {loop, Init, Var, Body}          -> {loop, bottom_up(F, Env, Init), Var, bottom_up(F, Env, Body)};
+        {break, E}                       -> {break, bottom_up(F, Env, E)};
+        {continue, E}                    -> {continue, bottom_up(F, Env, E)};
         {lam, Xs, B}                     -> {lam, Xs, bottom_up(F, Env, B)};
         {'let', X, E, Body}              ->
             E1 = bottom_up(F, Env, E),
@@ -1978,6 +2005,11 @@ rename(Ren, Expr) ->
         {lam, Xs, B} ->
             {Zs, Ren1} = rename_bindings(Ren, Xs),
             {lam, Zs, rename(Ren1, B)};
+        {loop, Init, Var, Body} ->
+            {Z, Ren1} = rename_binding(Ren, Var),
+            {loop, rename(Ren, Init), Z, rename(Ren1, Body)};
+        {break, E}           -> {break, rename(Ren, E)};
+        {continue, E}        -> {continue, rename(Ren, E)};
         {'let', X, E, Body} ->
             {Z, Ren1} = rename_binding(Ren, X),
             {'let', Z, rename(Ren, E), rename(Ren1, Body)}
@@ -2169,6 +2201,13 @@ pp_fexpr({tuple, Es}) ->
     pp_parens(pp_par(pp_punctuate(pp_text(","), [pp_fexpr(E) || E <- Es])));
 pp_fexpr({proj, E, I}) ->
     pp_beside([pp_fexpr(E), pp_text("."), pp_int(I)]);
+pp_fexpr({loop, Init, Var, Body}) ->
+    pp_par(
+      [ pp_beside([pp_text("loop"), pp_fexpr(Init), pp_text("as"), pp_text(Var)])
+      , pp_fexpr(Body)
+      ]);
+pp_fexpr({break, E}) -> pp_beside([pp_text("break"), pp_fexpr(E)]);
+pp_fexpr({continue, E}) -> pp_beside([pp_text("continue"), pp_fexpr(E)]);
 pp_fexpr({lam, Xs, A}) ->
     pp_par([pp_fexpr({tuple, [{var, X} || X <- Xs]}), pp_text("=>"),
             prettypr:nest(2, pp_fexpr(A))]);

src/aeso_fcode_to_fate.erl

@@ -19,6 +19,7 @@
 
 -type scode()  :: [sinstr()].
 -type sinstr() :: {switch, arg(), stype(), [maybe_scode()], maybe_scode()}  %% last arg is catch-all
+                | {loop, scode(), var(), scode(), reference(), reference()}
                 | switch_body
                 | loop
                 | tuple() | atom().    %% FATE instruction
@@ -45,7 +46,7 @@
 -define(s(N), {store, N}).
 -define(void, {var, 9999}).
 
--record(env, { contract, vars = [], locals = [], current_function, tailpos = true, child_contracts = #{}, options = []}).
+-record(env, { contract, vars = [], locals = [], break_ref = none, cont_ref = none, loop_it = none, current_function, tailpos = true, child_contracts = #{}, options = []}).
 
 %% -- Debugging --------------------------------------------------------------
 
@@ -159,6 +160,9 @@ init_env(ChildContracts, ContractName, FunNames, Name, Args, Options) ->
 next_var(#env{ vars = Vars }) ->
     1 + lists:max([-1 | [J || {_, {var, J}} <- Vars]]).
 
+bind_loop(ContRef, BreakRef, It, Env) ->
+    Env#env{break_ref = BreakRef, cont_ref = ContRef, loop_it = It}.
+
 bind_var(Name, Var, Env = #env{ vars = Vars }) ->
     Env#env{ vars = [{Name, Var} | Vars] }.
 
@@ -368,7 +372,21 @@ to_scode1(Env, {set_state, Reg, Val}) ->
 
 to_scode1(Env, {closure, Fun, FVs}) ->
     to_scode(Env, {tuple, [{lit, {string, make_function_id(Fun)}}, FVs]});
-
+to_scode1(Env, {loop, Init, It, Expr}) ->
+    ContRef = make_ref(),
+    BreakRef = make_ref(),
+    {ItV, Env1} = bind_local(It, Env),
+    InitS = [to_scode(notail(Env), Init),
+             {jump, ContRef}],
+    ExprS = [aeb_fate_ops:store({var, ItV}, {stack, 0}),
+             to_scode(bind_loop(ContRef, BreakRef, ItV, Env1), Expr),
+             {jump, BreakRef}],
+    [{loop, InitS, It, ExprS, ContRef, BreakRef}];
+to_scode1(Env = #env{cont_ref = ContRef}, {continue, Expr}) ->
+    [to_scode1(notail(Env), Expr),
+     {jump, ContRef}];
+to_scode1(Env, {break, Expr}) ->
+    to_scode1(Env, Expr);
 to_scode1(Env, {switch, Case}) ->
     split_to_scode(Env, Case).
 
@@ -712,6 +730,8 @@ flatten(Code)    -> lists:map(fun flatten_s/1, lists:flatten(Code)).
 
 flatten_s({switch, Arg, Type, Alts, Catch}) ->
     {switch, Arg, Type, [flatten(Alt) || Alt <- Alts], flatten(Catch)};
+flatten_s({loop, Init, It, Body, BRef, CRef}) ->
+    {loop, flatten(Init), It, flatten(Body), BRef, CRef};
 flatten_s(I) -> I.
 
 -define(MAX_SIMPL_ITERATIONS, 10).
@@ -808,6 +828,11 @@ ann_live1(LiveTop, {switch, Arg, Type, Alts, Def}, LiveOut) ->
     {Def1,  LiveDef}  = ann_live(LiveTop, Def, LiveOut),
     LiveIn = ordsets:union([Read, LiveDef | LiveAlts]),
     {{switch, Arg, Type, Alts1, Def1}, LiveIn};
+ann_live1(LiveTop, {loop, Init, It, Body, BRef, CRef}, LiveOut) ->
+    {Init1, LiveInit} = ann_live(LiveTop, Init, LiveOut),
+    {Body1, LiveBody} = ann_live(LiveTop, Body, LiveOut),
+    LiveIn = ordsets:union([It, LiveInit, LiveBody]), % TODO not sure about this
+    {{loop, Init1, It, Body1, BRef, CRef}, LiveIn};
 ann_live1(_LiveTop, I, LiveOut) ->
     #{ read := Reads0, write := W } = attributes(I),
     Reads   = lists:filter(fun is_reg/1, Reads0),
@@ -834,6 +859,7 @@ attributes(I) ->
     case I of
         loop                                  -> Impure(pc, []);
         switch_body                           -> Pure(none, []);
+        {jump, _}                             -> Impure(pc, []);
         'RETURN'                              -> Impure(pc, []);
         {'RETURNR', A}                        -> Impure(pc, A);
         {'CALL', A}                           -> Impure(?a, [A]);
@@ -1023,6 +1049,7 @@ var_writes(I) ->
 -spec independent(sinstr_a(), sinstr_a()) -> boolean().
 %% independent({switch, _, _, _, _}, _) -> false;       %% Commented due to Dialyzer whinging
 independent(_, {switch, _, _, _, _}) -> false;
+independent(_, {loop, _, _, _, _, _}) -> false;
 independent({i, _, I}, {i, _, J}) ->
     #{ write := WI, read := RI, pure := PureI } = attributes(I),
     #{ write := WJ, read := RJ, pure := PureJ } = attributes(J),
@@ -1061,6 +1088,8 @@ live_in(R, {i, Ann, _}) -> live_in(R, Ann);
 live_in(R, [I = {i, _, _} | _]) -> live_in(R, I);
 live_in(R, [{switch, A, _, Alts, Def} | _]) ->
     R == A orelse lists:any(fun(Code) -> live_in(R, Code) end, [Def | Alts]);
+live_in(R, [{loop, Init, Var, Expr, _, _}]) ->
+    live_in(Var, Init) orelse (R /= Var andalso live_in(R, Expr));
 live_in(_, missing) -> false;
 live_in(_, []) -> false.
 
@@ -1076,6 +1105,8 @@ simplify([I | Code], Options) ->
 
 simpl_s({switch, Arg, Type, Alts, Def}, Options) ->
     {switch, Arg, Type, [simplify(A, Options) || A <- Alts], simplify(Def, Options)};
+simpl_s({loop, Init, Var, Expr, ContRef, BreakRef}, Options) ->
+    {loop, simplify(Init, Options), Var, simplify(Expr, Options), ContRef, BreakRef};
 simpl_s(I, _) -> I.
 
 %% Safe-guard against loops in the rewriting. Shouldn't happen so throw an
@@ -1378,6 +1409,8 @@ does_abort({i, _, {'EXIT', _}}) -> true;
 does_abort(missing) -> true;
 does_abort({switch, _, _, Alts, Def}) ->
     lists:all(fun does_abort/1, [Def | Alts]);
+does_abort({loop, Init, _, Expr, _, _}) ->
+    does_abort(Init) orelse does_abort(Expr);
 does_abort(_) -> false.
 
 %% STORE R A, SWITCH R --> SWITCH A
@@ -1505,6 +1538,8 @@ from_op_view(Op, R, As) -> list_to_tuple([Op, R | As]).
                 (missing)    -> missing.
 unannotate({switch, Arg, Type, Alts, Def}) ->
     [{switch, Arg, Type, [unannotate(A) || A <- Alts], unannotate(Def)}];
+unannotate({loop, Init, It, Body, BRef, CRef}) ->
+    [{loop, unannotate(Init), It, unannotate(Body), BRef, CRef}];
 unannotate(missing) -> missing;
 unannotate(Code) when is_list(Code) ->
     lists:flatmap(fun unannotate/1, Code);
@@ -1521,6 +1556,8 @@ desugar({'STORE', ?a, A})       -> [aeb_fate_ops:push(desugar_arg(A))];
 desugar({'STORE', R, ?a})       -> [aeb_fate_ops:pop(desugar_arg(R))];
 desugar({switch, Arg, Type, Alts, Def}) ->
     [{switch, desugar_arg(Arg), Type, [desugar(A) || A <- Alts], desugar(Def)}];
+desugar({loop, Init, Var, Expr, ContRef, BreakRef}) ->
+    [{loop, desugar(Init), Var, desugar(Expr), ContRef, BreakRef}];
 desugar(missing) -> missing;
 desugar(Code) when is_list(Code) ->
     lists:flatmap(fun desugar/1, Code);
@@ -1567,7 +1604,7 @@ bb(_Name, Code) ->
 -type bb()     :: {bbref(), bcode()}.
 -type bcode()  :: [binstr()].
 -type binstr() :: {jump, bbref()}
-                | {jumpif, bbref()}
+                | {jumpif, term(), bbref()}
                 | tuple().   %% FATE instruction
 
 -spec blocks(scode()) -> [bb()].
@@ -1581,25 +1618,29 @@ blocks([], Acc) ->
 blocks([Blk | Blocks], Acc) ->
     block(Blk, [], Blocks, Acc).
 
+fresh_block(C, Ca) ->
+    R = make_ref(),
+    {R, [#blk{ref = R, code = C, catchall = Ca}]}.
+
 -spec block(#blk{}, bcode(), [#blk{}], [bb()]) -> [bb()].
 block(#blk{ref = Ref, code = []}, CodeAcc, Blocks, BlockAcc) ->
     blocks(Blocks, [{Ref, lists:reverse(CodeAcc)} | BlockAcc]);
+block(Blk = #blk{code = [{loop, Init, _, Expr, ContRef, BreakRef} | Code], catchall = Catchall}, Acc, Blocks, BlockAcc) ->
+    LoopBlock = #blk{ref = ContRef, code = Expr, catchall = none},
+    BreakBlock = #blk{ref = BreakRef, code = Code, catchall = Catchall},
+    block(Blk#blk{code = Init}, Acc, [LoopBlock, BreakBlock | Blocks], BlockAcc);
 block(Blk = #blk{code = [switch_body | Code]}, Acc, Blocks, BlockAcc) ->
     %% Reached the body of a switch. Clear catchall ref.
     block(Blk#blk{code = Code, catchall = none}, Acc, Blocks, BlockAcc);
 block(Blk = #blk{code     = [{switch, Arg, Type, Alts, Default} | Code],
                  catchall = Catchall}, Acc, Blocks, BlockAcc) ->
-    FreshBlk = fun(C, Ca) ->
+    {RestRef, RestBlk} = fresh_block(Code, Catchall),
-                   R = make_ref(),
-                   {R, [#blk{ref = R, code = C, catchall = Ca}]}
-               end,
-    {RestRef, RestBlk} = FreshBlk(Code, Catchall),
     {DefRef, DefBlk} =
         case Default of
             missing when Catchall == none ->
-                FreshBlk([aeb_fate_ops:abort(?i(<<"Incomplete patterns">>))], none);
+                fresh_block([aeb_fate_ops:abort(?i(<<"Incomplete patterns">>))], none);
             missing -> {Catchall, []};
-            _       -> FreshBlk(Default ++ [{jump, RestRef}], Catchall)
+            _       -> fresh_block(Default ++ [{jump, RestRef}], Catchall)
                        %% ^ fall-through to the outer catchall
         end,
     %% If we don't generate a switch, we need to pop the argument if on the stack.
@@ -1611,7 +1652,7 @@ block(Blk = #blk{code     = [{switch, Arg, Type, Alts, Default} | Code],
                 {ThenRef, ThenBlk} =
                     case TrueCode of
                         missing -> {DefRef, []};
-                        _       -> FreshBlk(TrueCode ++ [{jump, RestRef}], DefRef)
+                        _       -> fresh_block(TrueCode ++ [{jump, RestRef}], DefRef)
                     end,
                 ElseCode =
                     case FalseCode of
@@ -1646,7 +1687,7 @@ block(Blk = #blk{code     = [{switch, Arg, Type, Alts, Default} | Code],
                     true  -> {Blk#blk{code = Pop ++ [{jump, DefRef}]}, [], []};
                     false ->
                         MkBlk = fun(missing) -> {DefRef, []};
-                                   (ACode)   -> FreshBlk(ACode ++ [{jump, RestRef}], DefRef)
+                                   (ACode)   -> fresh_block(ACode ++ [{jump, RestRef}], DefRef)
                                 end,
                         {AltRefs, AltBs} = lists:unzip(lists:map(MkBlk, Alts)),
                         {Blk#blk{code = []}, [{switch, Arg, AltRefs}], lists:append(AltBs)}
@@ -1662,7 +1703,7 @@ block(Blk = #blk{code = [I | Code]}, Acc, Blocks, BlockAcc) ->
 optimize_blocks(Blocks) ->
     %% We need to look at the last instruction a lot, so reverse all blocks.
     Rev       = fun(Bs) -> [ {Ref, lists:reverse(Code)} || {Ref, Code} <- Bs ] end,
-    RBlocks   = Rev(Blocks),
+    RBlocks   =  [{Ref, crop_jumps(Code)} || {Ref, Code} <- Blocks],
     RBlockMap = maps:from_list(RBlocks),
     RBlocks1  = reorder_blocks(RBlocks, []),
     RBlocks2  = [ {Ref, inline_block(RBlockMap, Ref, Code)} || {Ref, Code} <- RBlocks1 ],
@@ -1744,6 +1785,18 @@ tweak_returns(['RETURN' | Code = [{'EXIT', _} | _]])   -> Code;
 tweak_returns(['RETURN' | Code = [loop | _]])          -> Code;
 tweak_returns(Code) -> Code.
 
+%% -- Remove instructions that appear after jumps. Returns reversed code.
+%% This is useful for example when bb emitter adds continuation jumps
+%% for switch expressions, but some of the branches
+crop_jumps(Code) ->
+    crop_jumps(Code, []).
+crop_jumps([], Acc) ->
+    Acc;
+crop_jumps([I = {jump, _}|_], Acc) ->
+    [I|Acc];
+crop_jumps([I|Code], Acc) ->
+    crop_jumps(Code, [I|Acc]).
+
 %% -- Split basic blocks at CALL instructions --
 %%  Calls can only return to a new basic block. Also splits at JUMPIF instructions.