Compile list patterns

src/aeso_ast_to_fcode.erl

@@ -40,10 +40,12 @@
 
 -type fcase() :: {'case', fsplit_pat(), fsplit()}.
 
--type fsplit_pat()  :: {bool, false | true}
+-type fsplit_pat()  :: {var, var_name()}
+                     | {bool, false | true}
                      | {int, integer()}
-                     | {tuple, [var_name()]}
+                     | nil
-                     | {var, var_name()}.
+                     | {'::', var_name(), var_name()}
+                     | {tuple, [var_name()]}.
 
 -type ftype() :: integer
                | boolean
@@ -261,6 +263,7 @@ alts_to_fcode(Env, Type, X, Alts) ->
 -type fpat() :: {var, var_name()}
               | {bool, false | true}
               | {int, integer()}
+              | nil | {'::', fpat(), fpat()}
               | {tuple, [fpat()]}.
 
 %% %% Invariant: the number of variables matches the number of patterns in each falt.
@@ -295,13 +298,15 @@ merge_alts(I, X, Alts, Alts1) ->
         when Alts :: [{fsplit_pat(), [falt()]}].
 merge_alt(_, _, {P, A}, []) -> [{P, [A]}];
 merge_alt(I, X, {P, A}, [{Q, As} | Rest]) ->
-    Match = fun({var, _}, {var, _})     -> match;
+    Match = fun({var, _}, {var, _})         -> match;
-               ({tuple, _}, {tuple, _}) -> match;
+               ({tuple, _}, {tuple, _})     -> match;
-               ({bool, B}, {bool, B})   -> match;
+               ({bool, B}, {bool, B})       -> match;
-               ({int, N},  {int, N})    -> match;
+               ({int, N},  {int, N})        -> match;
-               ({var, _}, _)            -> expand;
+               (nil,       nil)             -> match;
-               (_, {var, _})            -> insert;
+               ({'::', _, _}, {'::', _, _}) -> match;
-               (_, _)                   -> mismatch
+               ({var, _}, _)                -> expand;
+               (_, {var, _})                -> insert;
+               (_, _)                       -> mismatch
             end,
     case Match(P, Q) of
         match    -> [{Q, [A | As]} | Rest];
@@ -317,11 +322,18 @@ expand(I, X, P, Q, Case = {'case', Ps, E}) ->
     {Ps0r, Ren1} = rename_pats([{Y, X} || Y /= X], Ps0),
     {Ps1r, Ren2} = rename_pats(Ren1, Ps1),
     E1 = rename(Ren2, E),
-    Splice = fun(Qs) -> Ps0r ++ Qs ++ Ps1r end,
+    Splice = fun(N) -> Ps0r ++ lists:duplicate(N, {var, "_"}) ++ Ps1r end,
-    case Q of
+    Type = fun({tuple, Xs})  -> {tuple, length(Xs)};
-        {tuple, Xs} -> {[{Q,         {'case', Splice([{var, "_"} || _ <- Xs]), E1}}], []};
+              ({bool, _})    -> bool;
-        {bool, _}   -> {[{{bool, B}, {'case', Splice([]), E1}} || B <- [false, true]], []};
+              ({int, _})     -> int;
-        {int, _}    -> {[{Q,         {'case', Splice([]), E1}}], [{P, Case}]}
+              (nil)          -> list;
+              ({'::', _, _}) -> list end,
+    MkCase = fun(Pat, Vars) -> {Pat, {'case', Splice(Vars), E1}} end,
+    case Type(Q) of
+        {tuple, N} -> {[MkCase(Q, N)], []};
+        bool       -> {[MkCase({bool, B}, 0) || B <- [false, true]], []};
+        int        -> {[MkCase(Q, 0)], [{P, Case}]};
+        list       -> {[MkCase(nil, 0), MkCase({'::', fresh_name(), fresh_name()}, 2)], []}
     end.
 
 -spec split_alt(integer(), falt()) -> {fsplit_pat(), falt()}.
@@ -334,13 +346,17 @@ split_alt(I, {'case', Pats, Body}) ->
 split_pat(P = {var, _})  -> {{var, fresh_name()}, [P]};
 split_pat({bool, B})     -> {{bool, B}, []};
 split_pat({int, N})      -> {{int, N}, []};
+split_pat(nil) -> {nil, []};
+split_pat({'::', P, Q}) -> {{'::', fresh_name(), fresh_name()}, [P, Q]};
 split_pat({tuple, Pats}) ->
     Xs = [fresh_name() || _ <- Pats],
     {{tuple, Xs}, Pats}.
 
 -spec split_vars(fsplit_pat(), ftype()) -> [{var_name(), ftype()}].
-split_vars({bool, _}, boolean) -> [];
+split_vars({bool, _}, boolean)       -> [];
-split_vars({int, _},  integer) -> [];
+split_vars({int, _},  integer)       -> [];
+split_vars(nil,       {list, _})     -> [];
+split_vars({'::', X, Xs}, {list, T}) -> [{X, T}, {Xs, {list, T}}];
 split_vars({tuple, Xs}, {tuple, Ts}) ->
     lists:zip(Xs, Ts);
 split_vars({var, X}, T) -> [{X, T}].
@@ -384,6 +400,11 @@ rename_pats(Ren, [P | Ps]) ->
 
 rename_pat(Ren, P = {bool, _}) -> {P, Ren};
 rename_pat(Ren, P = {int, _})  -> {P, Ren};
+rename_pat(Ren, P = nil)       -> {P, Ren};
+rename_pat(Ren, {'::', P, Q}) ->
+    {P1, Ren1} = rename_pat(Ren, P),
+    {Q1, Ren2} = rename_pat(Ren1, Q),
+    {{'::', P1, Q1}, Ren2};
 rename_pat(Ren, {var, X}) ->
     {Z, Ren1} = rename_binding(Ren, X),
     {{var, Z}, Ren1};
@@ -425,6 +446,12 @@ pat_to_fcode(_Env, _Type, {bool, _, B}) ->
     {bool, B};
 pat_to_fcode(_Env, _Type, {int, _, N}) ->
     {int, N};
+pat_to_fcode(Env, _Type, {list, _, Ps}) ->
+    lists:foldr(fun(P, Qs) ->
+                    {'::', pat_to_fcode(Env, P), Qs}
+                end, nil, Ps);
+pat_to_fcode(Env, _Type, {app, _, {'::', _}, [P, Q]}) ->
+    {'::', pat_to_fcode(Env, P), pat_to_fcode(Env, Q)};
 pat_to_fcode(_Env, Type, Pat) -> {todo, Pat, ':', Type}.
 
 -spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr().
@@ -588,6 +615,7 @@ pp_case({'case', Pat, Split}) ->
     pp_above(pp_beside(pp_pat(Pat), pp_text(" =>")),
              prettypr:nest(2, pp_split(Split))).
 
-pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, X} || X <- Xs]});
+pp_pat({tuple, Xs})   -> pp_fexpr({tuple, [{var, X} || X <- Xs]});
-pp_pat(Pat) -> pp_fexpr(Pat).
+pp_pat({'::', X, Xs}) -> pp_fexpr({binop, list, '::', {var, X}, {var, Xs}});
+pp_pat(Pat)           -> pp_fexpr(Pat).
 

src/aeso_fcode_to_fate.erl

@@ -56,6 +56,10 @@
      Op =:= 'ELEMENT' orelse
      Op =:= 'CONS')).
 
+-define(IsUnOp(Op),
+    (Op =:= 'HD' orelse
+     Op =:= 'TL')).
+
 -record(env, { vars = [], locals = [], tailpos = true }).
 
 %% -- Debugging --------------------------------------------------------------
@@ -192,6 +196,24 @@ split_to_scode(Env, {split, boolean, X, Alts}) ->
     SAlts = [GetAlt(false), GetAlt(true)],
     [aeb_fate_code:push(lookup_var(Env, X)),
      {switch, boolean, SAlts, Def}];
+split_to_scode(Env, {split, {list, _}, X, Alts}) ->
+    {Def, Alts1} = catchall_to_scode(Env, X, Alts),
+    Arg = lookup_var(Env, X),
+    GetAlt = fun(P) ->
+                 case [C || C = {'case', Pat, _} <- Alts1, Pat == P orelse is_tuple(Pat) andalso element(1, Pat) == P] of
+                     []      -> missing;
+                     [{'case', nil, S} | _]           -> split_to_scode(Env, S);
+                     [{'case', {'::', Y, Z}, S} | _] ->
+                         {I, Env1} = bind_local(Y, Env),
+                         {J, Env2} = bind_local(Z, Env1),
+                         [aeb_fate_code:hd({var, I}, Arg),
+                          aeb_fate_code:tl({var, J}, Arg),
+                          split_to_scode(Env2, S)]
+                 end
+             end,
+    SAlts = [GetAlt('::'), GetAlt(nil)],
+    [aeb_fate_code:is_nil(?a, Arg),
+     {switch, boolean, SAlts, Def}];
 split_to_scode(Env, {split, integer, X, Alts}) ->
     {Def, Alts1} = catchall_to_scode(Env, X, Alts),
     literal_split_to_scode(Env, integer, X, Alts1, Def);
@@ -572,6 +594,8 @@ rules() ->
     ].
 
 %% Removing pushes that are immediately consumed.
+r_push_consume({i, Ann1, {'PUSH', A}}, [{i, Ann2, {Op, R, ?a}} | Code]) when ?IsUnOp(Op) ->
+    {[{i, merge_ann(Ann1, Ann2), {Op, R, A}}], Code};
 r_push_consume({i, Ann1, {'PUSH', A}}, [{i, Ann2, {Op, R, ?a, B}} | Code]) when ?IsBinOp(Op) ->
     {[{i, merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code};
 r_push_consume({i, Ann1, {'PUSH', B}}, [{i, Ann2, {Op, R, A, ?a}} | Code]) when A /= ?a, ?IsBinOp(Op) ->
@@ -584,6 +608,8 @@ r_push_consume({i, Ann1, {'PUSH', A}}, [{i, Ann2, {'POP', B}} | Code]) ->
         false -> {[], Code}
     end;
 %% Writing directly to memory instead of going through the accumulator.
+r_push_consume({i, Ann1, {Op, ?a, A}}, [{i, Ann2, {'STORE', R, ?a}} | Code]) when ?IsUnOp(Op) ->
+    {[{i, merge_ann(Ann1, Ann2), {Op, R, A}}], Code};
 r_push_consume({i, Ann1, {Op, ?a, A, B}}, [{i, Ann2, {'STORE', R, ?a}} | Code]) when ?IsBinOp(Op) ->
     {[{i, merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code};
 
@@ -654,49 +680,63 @@ r_inline_store(Acc, R, A, [{i, Ann, I} | Code]) ->
                         false -> {lists:reverse(Acc1), Code};
                         {New, Rest} -> {New, Rest}
                     end;
+                {Op, S, B} when ?IsUnOp(Op), B == R ->
+                    Acc1 = [{i, Ann, {Op, S, Inl(B)}} | Acc],
+                    case r_inline_store(Acc1, R, A, Code) of
+                        false -> {lists:reverse(Acc1), Code};
+                        {New, Rest} -> {New, Rest}
+                    end;
                 _ -> r_inline_store([{i, Ann, I} | Acc], R, A, Code)
             end
     end;
 r_inline_store(_Acc, _, _, _) -> false.
 
 %% Shortcut write followed by final read
-r_one_shot_var({i, Ann1, {Op, R = {var, _}, A, B}}, [{i, Ann2, J} | Code]) when ?IsBinOp(Op) ->
+r_one_shot_var({i, Ann1, I}, [{i, Ann2, J} | Code]) ->
-    Copy = case J of
+    case op_view(I) of
-               {'PUSH', R}     -> {write_to, ?a};
+        {Op, R, As} ->
-               {'STORE', S, R} -> {write_to, S};
+            Copy = case J of
-               _               -> false
+                       {'PUSH', R}     -> {write_to, ?a};
-           end,
+                       {'STORE', S, R} -> {write_to, S};
-    case {live_out(R, Ann2), Copy} of
+                       _               -> false
-        {false, {write_to, X}} ->
+                   end,
-            {[{i, merge_ann(Ann1, Ann2), {Op, X, A, B}}], Code};
+            case {live_out(R, Ann2), Copy} of
+                {false, {write_to, X}} ->
+                    {[{i, merge_ann(Ann1, Ann2), from_op_view({Op, X, As})}], Code};
+                _ -> false
+            end;
         _ -> false
     end;
 r_one_shot_var(_, _) -> false.
 
 %% Remove writes to dead variables
-r_write_to_dead_var({i, Ann, {Op, R = {var, _}, A, B}}, Code) when ?IsBinOp(Op) ->
+r_write_to_dead_var({i, Ann, I}, Code) ->
-    case live_out(R, Ann) of
+    case op_view(I) of
-        false ->
+        {_Op, R = {var, _}, As} ->
-            %% Subtle: we still have to pop the stack if any of the arguments
+            case live_out(R, Ann) of
-            %% came from there. In this case we pop to R, which we know is
+                false ->
-            %% unused.
+                    %% Subtle: we still have to pop the stack if any of the arguments
-            {[{i, Ann, {'POP', R}} || X <- [A, B], X == ?a], Code};
+                    %% came from there. In this case we pop to R, which we know is
-        true -> false
+                    %% unused.
-    end;
+                    {[{i, Ann, {'POP', R}} || X <- As, X == ?a], Code};
-r_write_to_dead_var({i, Ann, {'STORE', R = {var, _}, A}}, Code) when A /= ?a ->
+                true -> false
-    case live_out(R, Ann) of
-        false ->
-            case Code of
-                []                  -> {[], []};
-                [switch_body, {Ann1, I} | Code1] ->
-                    {[], [switch_body, {i, merge_ann(Ann, Ann1), I} | Code1]};
-                [{i, Ann1, I} | Code1] ->
-                    {[], [{merge_ann(Ann, Ann1), I} | Code1]}
             end;
-        true  -> false
+        _ -> false
     end;
 r_write_to_dead_var(_, _) -> false.
 
+op_view({Op, R, A, B}) when ?IsBinOp(Op) ->
+    {Op, R, [A, B]};
+op_view({Op, R, A}) when ?IsUnOp(Op) ->
+    {Op, R, [A]};
+op_view({'STORE', R, A}) ->
+    {'STORE', R, [A]};
+op_view({'NIL', R}) ->
+    {'NIL', R, []};
+op_view(_) ->
+    false.
+
+from_op_view({Op, R, As}) -> list_to_tuple([Op, R | As]).
 
 %% Desugar and specialize and remove annotations
 -spec unannotate(scode_a())  -> scode();