Current section
Files
Jump to
Current section
Files
src/lfe_translate.erl
%% Copyright (c) 2008-2021 Robert Virding
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%% http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%% File : lfe_trans.erl
%% Author : Robert Virding
%% Purpose : Lisp Flavoured Erlang translator.
%%% Translate LFE code to/from vanilla Erlang AST.
%%%
%%% Note that we don't really check code here as such, we assume the
%%% input is correct. If there is an error in the input we just fail.
%%% This allows us to accept forms which are actually illegal but we
%%% may special case, for example functions call in patterns which
%%% will become macro expansions.
%%%
%%% Having import from and rename forces us to explicitly convert the
%%% call as we can't use an import attribute to do this properly for
%%% us. Hence we collect the imports in lfe_codegen and pass them onto
%%% us.
%%%
%%% Module aliases are collected in lfe_codegen and passed on to us.
-module(lfe_translate).
-export([from_expr/1,from_expr/2,from_body/1,from_body/2,from_lit/1]).
-export([to_expr/2,to_expr/3,to_exprs/2,to_exprs/3,to_lit/2]).
-import(lists, [map/2,foldl/3,mapfoldl/3,foldr/3,splitwith/2]).
-include("lfe.hrl").
-record(from, {vc=0 %Variable counter
}).
%% from_expr(AST) -> Sexpr.
%% from_expr(AST, Variables) -> {Sexpr,Variables}.
%% from_body([AST]) -> Sexpr.
%% from_body([AST], Variables) -> {Sexpr,Variables}.
%% Translate a vanilla Erlang expression into LFE. The main
%% difficulty is in the handling of variables. The implicit matching
%% of known variables in vanilla must be translated into explicit
%% equality tests in guards (which is what the compiler does
%% internally). For this we need to keep track of visible variables
%% and detect when they reused in patterns.
from_expr(E) ->
{S,_,_} = from_expr(E, ordsets:new(), #from{}),
S.
from_expr(E, Vs0) ->
Vt0 = ordsets:from_list(Vs0), %We are clean
{S,Vt1,_} = from_expr(E, Vt0, #from{}),
{S,ordsets:to_list(Vt1)}.
from_body(Es) ->
{Les,_,_} = from_body(Es, ordsets:new(), #from{}),
[progn|Les].
from_body(Es, Vs0) ->
Vt0 = ordsets:from_list(Vs0), %We are clean
{Les,Vt1,_} = from_body(Es, Vt0, #from{}),
{[progn|Les],ordsets:to_list(Vt1)}.
%% from_expr(AST, VarTable, State) -> {Sexpr,VarTable,State}.
from_expr({var,_,V}, Vt, St) -> {V,Vt,St}; %Unquoted atom
from_expr({nil,_}, Vt, St) -> {[],Vt,St};
from_expr({integer,_,I}, Vt, St) -> {I,Vt,St};
from_expr({float,_,F}, Vt, St) -> {F,Vt,St};
from_expr({atom,_,A}, Vt, St) -> {?Q(A),Vt,St}; %Quoted atom
from_expr({string,_,S}, Vt, St) -> {?Q(S),Vt,St}; %Quoted string
from_expr({cons,_,H,T}, Vt0, St0) ->
{Car,Vt1,St1} = from_expr(H, Vt0, St0),
{Cdr,Vt2,St2} = from_expr(T, Vt1, St1),
{from_cons(Car, Cdr),Vt2,St2};
%% {[cons,Car,Cdr],Vt2,St2};
from_expr({tuple,_,Es}, Vt0, St0) ->
{Ss,Vt1,St1} = from_expr_list(Es, Vt0, St0),
{[tuple|Ss],Vt1,St1};
from_expr({bin,_,Segs}, Vt0, St0) ->
{Ss,Vt1,St1} = from_bitsegs(Segs, Vt0, St0),
{[binary|Ss],Vt1,St1};
from_expr({map,_,Assocs}, Vt0, St0) -> %Build a map
{Ps,Vt1,St1} = from_map_assocs(Assocs, Vt0, St0),
{[map|Ps],Vt1,St1};
from_expr({map,_,Map,Assocs}, Vt0, St0) -> %Update a map
{Lm,Vt1,St1} = from_expr(Map, Vt0, St0),
from_map_update(Assocs, nul, Lm, Vt1, St1);
%% Record special forms.
from_expr({record,_,Name,Fs}, Vt0, St0) ->
{Lfs,Vt1,St1} = from_rec_fields(Fs, Vt0, St0),
{['make-record',Name|Lfs],Vt1,St1};
from_expr({record_index,_,Name,{atom,_,F}}, Vt, St) -> %We KNOW!
{['record-index',Name,F],Vt,St};
from_expr({record_field,_,E,Name,{atom,_,F}}, Vt0, St0) -> %We KNOW!
{Le,Vt1,St1} = from_expr(E, Vt0, St0),
{['record-field',Le,Name,F],Vt1,St1};
from_expr({record,_,E,Name,Fs}, Vt0, St0) ->
{Le,Vt1,St1} = from_expr(E, Vt0, St0),
{Lfs,Vt2,St2} = from_rec_fields(Fs, Vt1, St1),
{['record-update',Le,Name|Lfs],Vt2,St2};
from_expr({record_field,_,_,_}=M, Vt, St) -> %Pre R16 packages
from_package_module(M, Vt, St);
%% Function special forms.
from_expr({'fun',_,{clauses,Cls}}, Vt, St0) ->
{Lcls,St1} = from_fun_cls(Cls, Vt, St0),
{['match-lambda'|Lcls],Vt,St1}; %Don't bother using lambda
from_expr({'fun',_,{function,F,A}}, Vt, St) ->
%% These are just literal values.
{[function,F,A],Vt,St};
from_expr({'fun',_,{function,M,F,A}}, Vt, St) ->
%% These are abstract values.
{[function,from_lit(M),from_lit(F),from_lit(A)],Vt,St};
%% Core control special forms.
from_expr({match,_,_,_}=Match, Vt, St) ->
from_match(Match, Vt, St);
from_expr({block,_,Es}, Vt, St) ->
from_block(Es, Vt, St);
from_expr({'if',_,Cls}, Vt0, St0) -> %This is the Erlang if
{Lcls,Vt1,St1} = from_icrt_cls(Cls, Vt0, St0),
{['case',[]|Lcls],Vt1,St1};
from_expr({'case',_,E,Cls}, Vt0, St0) ->
{Le,Vt1,St1} = from_expr(E, Vt0, St0),
{Lcls,Vt2,St2} = from_icrt_cls(Cls, Vt1, St1),
{['case',Le|Lcls],Vt2,St2};
from_expr({'receive',_,Cls}, Vt0, St0) ->
{Lcls,Vt1,St1} = from_icrt_cls(Cls, Vt0, St0),
{['receive'|Lcls],Vt1,St1};
from_expr({'receive',_,Cls,Timeout,Body}, Vt0, St0) ->
{Lcls,Vt1,St1} = from_icrt_cls(Cls, Vt0, St0),
{Lt,Vt2,St2} = from_expr(Timeout, Vt1, St1),
{Lb,Vt3,St3} = from_body(Body, Vt2, St2),
{['receive'|Lcls ++ [['after',Lt|Lb]]],Vt3,St3};
from_expr({'catch',_,E}, Vt0, St0) ->
{Le,Vt1,St1} = from_expr(E, Vt0, St0),
{['catch',Le],Vt1,St1};
from_expr({'try',_,Es,Scs,Ccs,As}, Vt, St) ->
from_try(Es, Scs, Ccs, As, Vt, St);
%% More complex special forms. These become LFE macros.
from_expr({lc,_,E,Qs}, Vt0, St0) ->
{Lqs,Vt1,St1} = from_lc_quals(Qs, Vt0, St0),
{Le,Vt2,St2} = from_expr(E, Vt1, St1),
{[lc,Lqs,Le],Vt2,St2};
%% Function calls.
from_expr({call,_,{remote,_,M,F},As}, Vt0, St0) -> %Remote function call
{Lm,Vt1,St1} = from_expr(M, Vt0, St0),
{Lf,Vt2,St2} = from_expr(F, Vt1, St1),
{Las,Vt3,St3} = from_expr_list(As, Vt2, St2),
{[call,Lm,Lf|Las],Vt3,St3};
from_expr({call,_,{atom,_,F},As}, Vt0, St0) -> %Local function call
{Las,Vt1,St1} = from_expr_list(As, Vt0, St0),
{[F|Las],Vt1,St1};
from_expr({call,_,F,As}, Vt0, St0) -> %F not an atom or remote
{Lf,Vt1,St1} = from_expr(F, Vt0, St0),
{Las,Vt2,St2} = from_expr_list(As, Vt1, St1),
{[funcall,Lf|Las],Vt2,St2};
from_expr({op,_,Op,A}, Vt0, St0) ->
{La,Vt1,St1} = from_expr(A, Vt0, St0),
{[Op,La],Vt1,St1};
from_expr({op,_,Op,L,R}, Vt0, St0) ->
{Ll,Vt1,St1} = from_expr(L, Vt0, St0),
{Lr,Vt2,St2} = from_expr(R, Vt1, St1),
{[Op,Ll,Lr],Vt2,St2}.
from_cons(Car, [list|Es]) -> [list,Car|Es];
from_cons(Car, []) -> [list,Car];
from_cons(Car, Cdr) -> [cons,Car,Cdr].
%% from_body(Expressions, VarTable, State) -> {Body,VarTable,State}.
%% Handle '=' specially here and translate into let containing rest
%% of body.
from_body([{match,_,_,_}=Match], Vt0,St0) -> %Last match
{Lm,Vt1,St1} = from_expr(Match, Vt0, St0), %Must return pattern as value
{[Lm],Vt1,St1};
from_body([{match,_,P,E}|Es], Vt0, St0) ->
{Lp,Eqt,Vt1,St1} = from_pat(P, Vt0, St0),
{Le,Vt2,St2} = from_expr(E, Vt1, St1),
{Les,Vt3,St4} = from_body(Es, Vt2, St2),
Leg = from_eq_tests(Eqt), %Implicit guard tests
Lbody = from_add_guard(Leg, [Le]),
{[['let',[[Lp|Lbody]]|Les]],Vt3,St4};
from_body([E|Es], Vt0, St0) ->
{Le,Vt1,St1} = from_expr(E, Vt0, St0),
{Les,Vt2,St2} = from_body(Es, Vt1, St1),
{[Le|Les],Vt2,St2};
from_body([], Vt, St) -> {[],Vt,St}.
from_expr_list(Es, Vt, St) -> mapfoldl2(fun from_expr/3, Vt, St, Es).
%% from_block(Body, VarTable, State) -> {Block,State}.
from_block(Es, Vt0, St0) ->
case from_body(Es, Vt0, St0) of
{[Le],Vt1,St1} -> {Le,Vt1,St1};
{Les,Vt1,St1} -> {[progn|Les],Vt1,St1}
end.
%% from_add_guard(GuardTests, Body) -> Body.
%% Only prefix with a guard when there are tests.
from_add_guard([], Body) -> Body; %No guard tests
from_add_guard(Gts, Body) ->
[['when'|Gts]|Body].
%% from_match(Match, VarTable, State) -> {LetForm,State}.
%% Match returns the value of the expression. Use a let to do
%% matching with an alias which we return for value.
from_match({match,L,P,E}, Vt0, St0) ->
{Alias,St1} = new_from_var(St0), %Alias variable value
MP = {match,L,{var,L,Alias},P},
{Lp,Eqt,Vt1,St2} = from_pat(MP, Vt0, St1), %The alias pattern
{Le,Vt2,St3} = from_expr(E, Vt1, St2), %The expression
Leg = from_eq_tests(Eqt), %Implicit guard tests
Lbody = from_add_guard(Leg, [Le]), %Now build the whole body
{['let',[[Lp|Lbody]],Alias],Vt2,St3}.
%% from_bitsegs(Segs, VarTable, State) -> {Segs,VarTable,State}.
from_bitsegs([{bin_element,_,Seg,Size,Type}|Segs], Vt0, St0) ->
{S,Vt1,St1} = from_bitseg(Seg, Size, Type, Vt0, St0),
{Ss,Vt2,St2} = from_bitsegs(Segs, Vt1, St1),
{[S|Ss],Vt2,St2};
from_bitsegs([], Vt, St) -> {[],Vt,St}.
%% So it won't get confused with strings.
from_bitseg({integer,_,I}, default, default, Vt, St) -> {I,Vt,St};
from_bitseg({integer,_,I}, Size, Type, Vt0, St0) ->
{Lsize,Vt1,St1} = from_bitseg_size(Size, Vt0, St0),
{[I|from_bitseg_type(Type) ++ Lsize],Vt1,St1};
from_bitseg({float,_,F}, Size, Type, Vt0, St0) ->
{Lsize,Vt1,St1} = from_bitseg_size(Size, Vt0, St0),
{[F|from_bitseg_type(Type) ++ Lsize],Vt1,St1};
from_bitseg({string,_,S}, Size, Type, Vt0, St0) ->
{Lsize,Vt1,St1} = from_bitseg_size(Size, Vt0, St0),
{[S|from_bitseg_type(Type) ++ Lsize],Vt1,St1};
from_bitseg(E, Size, Type, Vt0, St0) ->
{Le,Vt1,St1} = from_expr(E, Vt0, St0),
{Lsize,Vt2,St2} = from_bitseg_size(Size, Vt1, St1),
{[Le|from_bitseg_type(Type) ++ Lsize],Vt2,St2}.
from_bitseg_size(default, Vt, St) -> {[],Vt,St};
from_bitseg_size(Size, Vt0, St0) ->
{Ssize,Vt1,St1} = from_expr(Size, Vt0, St0),
{[[size,Ssize]],Vt1,St1}.
from_bitseg_type(default) -> [];
from_bitseg_type(Ts) ->
map(fun ({unit,U}) -> [unit,U]; (T) -> T end, Ts).
%% from_map_assocs(MapAssocs, VarTable, State) -> {Pairs,VarTable,State}.
from_map_assocs([{_,_,Key,Val}|As], Vt0, St0) ->
{Lk,Vt1,St1} = from_expr(Key, Vt0, St0),
{Lv,Vt2,St2} = from_expr(Val, Vt1, St1),
{Las,Vt3,St3} = from_map_assocs(As, Vt2, St2),
{[Lk,Lv|Las],Vt3,St3};
from_map_assocs([], Vt, St) -> {[],Vt,St}.
%% from_map_update(MapAssocs, CurrAssoc, CurrMap, VarTable, State) ->
%% {Map,VarTable,State}.
%% We need to be a bit cunning here and do everything left-to-right
%% and minimize nested calls.
from_map_update([{Assoc,_,Key,Val}|As], Curr, Map0, Vt0, St0) ->
{Lk,Vt1,St1} = from_expr(Key, Vt0, St0),
{Lv,Vt2,St2} = from_expr(Val, Vt1, St1),
%% Check if can continue this mapping or need to start a new one.
Map1 = if Assoc =:= Curr -> Map0 ++ [Lk,Lv];
Assoc =:= map_field_assoc -> ['map-set',Map0,Lk,Lv];
Assoc =:= map_field_exact -> ['map-update',Map0,Lk,Lv]
end,
from_map_update(As, Assoc, Map1, Vt2, St2);
%% from_map_update([{Assoc,_,Key,Val}|Fs], Assoc, Map0, Vt0, St0) ->
%% {Lk,Vt1,St1} = from_expr(Key, Vt0, St0),
%% {Lv,Vt2,St2} = from_expr(Val, Vt1, St1),
%% from_map_update(Fs, Assoc, Map0 ++ [Lk,Lv], Vt2, St2);
%% from_map_update([{Assoc,_,Key,Val}|Fs], _, Map0, Vt0, St0) ->
%% {Lk,Vt1,St1} = from_expr(Key, Vt0, St0),
%% {Lv,Vt2,St2} = from_expr(Val, Vt1, St1),
%% Op = if Assoc =:= map_field_assoc -> 'map-set';
%% true -> 'map-update'
%% end,
%% from_map_update(Fs, Assoc, [Op,Map0,Lk,Lv], Vt2, St2);
from_map_update([], _, Map, Vt, St) -> {Map,Vt,St}.
%% from_rec_fields(Recfields, VarTable, State) -> {Recfields,VarTable,State}.
from_rec_fields([{record_field,_,{atom,_,F},V}|Fs], Vt0, St0) ->
{Lv,Vt1,St1} = from_expr(V, Vt0, St0),
{Lfs,Vt2,St2} = from_rec_fields(Fs, Vt1, St1),
{[F,Lv|Lfs],Vt2,St2};
from_rec_fields([{record_field,_,{var,_,F},V}|Fs], Vt0, St0) ->
%% Special case!!
{Lv,Vt1,St1} = from_expr(V, Vt0, St0),
{Lfs,Vt2,St2} = from_rec_fields(Fs, Vt1, St1),
{[F,Lv|Lfs],Vt2,St2};
from_rec_fields([], Vt, St) -> {[],Vt,St}.
%% from_icrt_cls(Clauses, VarTable, State) -> {Clauses,VarTable,State}.
%% from_icrt_cl(Clause, VarTable, State) -> {Clause,VarTable,State}.
%% If/case/receive/try clauses.
%% No ; in guards, so no guard sequence only one list of guard tests.
from_icrt_cls(Cls, Vt, St) -> from_cls(fun from_icrt_cl/3, Vt, St, Cls).
from_icrt_cl({clause,_,[],[G],B}, Vt0, St0) -> %If clause
{Lg,Vt1,St1} = from_body(G, Vt0, St0),
{Lb,Vt2,St2} = from_body(B, Vt1, St1),
Lbody = from_add_guard(Lg, Lb),
{['_'|Lbody],Vt2,St2};
from_icrt_cl({clause,_,H,[],B}, Vt0, St0) ->
{[Lh],Eqt,Vt1,St1} = from_pats(H, Vt0, St0), %List of one
{Lb,Vt2,St2} = from_body(B, Vt1, St1),
Leg = from_eq_tests(Eqt),
Lbody = from_add_guard(Leg, Lb),
{[Lh|Lbody],Vt2,St2};
from_icrt_cl({clause,_,H,[G],B}, Vt0, St0) ->
{[Lh],Eqt,Vt1,St1} = from_pats(H, Vt0, St0), %List of one
{Lg,Vt2,St2} = from_body(G, Vt1, St1),
{Lb,Vt3,St3} = from_body(B, Vt2, St2),
Leg = from_eq_tests(Eqt),
Lbody = from_add_guard(Leg ++ Lg, Lb),
{[Lh|Lbody],Vt3,St3}.
%% from_fun_cls(Clauses, VarTable, State) -> {Clauses,State}.
%% from_fun_cl(Clause, VarTable, State) -> {Clause,VarTable,State}.
%% Function clauses, all variables in the patterns are new variables
%% which shadow existing variables without equality tests.
from_fun_cls(Cls, Vt, St0) ->
{Lcls,_,St1} = from_cls(fun from_fun_cl/3, Vt, St0, Cls),
{Lcls,St1}.
from_fun_cl({clause,_,H,[],B}, Vt0, St0) ->
{Lh,Eqt,Vtp,St1} = from_pats(H, [], St0),
Vt1 = ordsets:union(Vtp, Vt0), %All variables so far
{Lb,Vt2,St2} = from_body(B, Vt1, St1),
Leg = from_eq_tests(Eqt),
Lbody = from_add_guard(Leg, Lb),
{[Lh|Lbody],Vt2,St2};
from_fun_cl({clause,_,H,[G],B}, Vt0, St0) ->
{Lh,Eqt,Vtp,St1} = from_pats(H, [], St0),
Vt1 = ordsets:union(Vtp, Vt0), %All variables so far
{Lg,Vt2,St2} = from_body(G, Vt1, St1),
{Lb,Vt3,St3} = from_body(B, Vt2, St2),
Leg = from_eq_tests(Eqt),
Lbody = from_add_guard(Leg ++ Lg, Lb),
{[Lh|Lbody],Vt3,St3}.
%% from_cls(ClauseFun, VarTable, State, Clauses) -> {Clauses,VarTable,State}.
%% Translate the clauses but only export variables that are defined
%% in all clauses, the intersection of the variables.
from_cls(Fun, Vt0, St0, [C]) ->
{Lc,Vt1,St1} = Fun(C, Vt0, St0),
{[Lc],Vt1,St1};
from_cls(Fun, Vt0, St0, [C|Cs]) ->
{Lc,Vtc,St1} = Fun(C, Vt0, St0),
{Lcs,Vtcs,St2} = from_cls(Fun, Vt0, St1, Cs),
{[Lc|Lcs],ordsets:intersection(Vtc, Vtcs),St2}.
from_eq_tests(Gs) -> [ ['=:=',V,V1] || {V,V1} <- Gs ].
%% from_try(Exprs, CaseClauses, CatchClauses, After, VarTable, State) ->
%% {Try,State}.
%% Only return the parts which have contents.
from_try(Es, Scs, Ccs, As, Vt, St0) ->
%% Try does not allow any exports!
{Les,_,St1} = from_body(Es, Vt, St0),
%% These maybe empty.
{Lscs,_,St2} = if Scs =:= [] -> {[],[],St1};
true -> from_icrt_cls(Scs, Vt, St1)
end,
{Lccs,_,St3} = if Ccs =:= [] -> {[],[],St2};
true -> from_icrt_cls(Ccs, Vt, St2)
end,
{Las,_,St4} = from_body(As, Vt, St3),
{['try',[progn|Les]|
from_maybe('case', Lscs) ++
from_maybe('catch', Lccs) ++
from_maybe('after', Las)],Vt,St4}.
from_maybe(_, []) -> [];
from_maybe(Tag, Es) -> [[Tag|Es]].
%% from_lc_quals(Qualifiers, VarTable, State) -> {Qualifiers,VarTable,State}.
from_lc_quals([{generate,_,P,E}|Qs], Vt0, St0) ->
{Lp,Eqt,Vt1,St1} = from_pat(P, Vt0, St0),
{Le,Vt2,St2} = from_expr(E, Vt1, St1),
{Lqs,Vt3,St3} = from_lc_quals(Qs, Vt2, St2),
Leg = from_eq_tests(Eqt),
Lbody = from_add_guard(Leg, Le),
{[['<-',Lp|Lbody]|Lqs],Vt3,St3};
from_lc_quals([T|Qs], Vt0, St0) ->
{Lt,Vt1,St1} = from_expr(T, Vt0, St0),
{Lqs,Vt2,St2} = from_lc_quals(Qs, Vt1, St1),
{[Lt|Lqs],Vt2,St2};
from_lc_quals([], Vt, St) -> {[],Vt,St}.
%% from_package_module(Module, VarTable, State) -> {Module,VarTable,State}.
%% We must handle the special case where in pre-R16 you could have
%% packages with a dotted module path. It used a special record_field
%% tuple. This does not work in R16 and later!
from_package_module({record_field,_,_,_}=M, Vt, St) ->
Segs = erl_parse:package_segments(M),
A = list_to_atom(packages:concat(Segs)),
{?Q(A),Vt,St}.
%% new_from_var(State) -> {VarName,State}.
new_from_var(#from{vc=C}=St) ->
V = list_to_atom(lists:concat(['-var-',C,'-'])),
{V,St#from{vc=C+1}}.
%% from_pat(Pattern, VarTable, State) ->
%% {Pattern,EqualVar,VarTable,State}.
from_pat({var,_,'_'}, Vt, St) -> {'_',[],Vt,St}; %Special case _
from_pat({var,_,V}, Vt, St0) -> %Unquoted atom
case ordsets:is_element(V, Vt) of %Is variable bound?
true ->
{V1,St1} = new_from_var(St0), %New var for pattern
{V1,[{V,V1}],Vt,St1}; %Add to guard tests
false ->
{V,[],ordsets:add_element(V, Vt),St0}
end;
from_pat({nil,_}, Vt, St) -> {[],[],Vt,St};
from_pat({integer,_,I}, Vt, St) -> {I,[],Vt,St};
from_pat({float,_,F}, Vt, St) -> {F,[],Vt,St};
from_pat({atom,_,A}, Vt, St) -> {?Q(A),[],Vt,St}; %Quoted atom
from_pat({string,_,S}, Vt, St) -> {?Q(S),[],Vt,St}; %Quoted string
from_pat({cons,_,H,T}, Vt0, St0) ->
{Car,Eqt1,Vt1,St1} = from_pat(H, Vt0, St0),
{Cdr,Eqt2,Vt2,St2} = from_pat(T, Vt1, St1),
{from_cons(Car, Cdr),Eqt1++Eqt2,Vt2,St2};
from_pat({tuple,_,Es}, Vt0, St0) ->
{Ss,Eqt,Vt1,St1} = from_pats(Es, Vt0, St0),
{[tuple|Ss],Eqt,Vt1,St1};
from_pat({bin,_,Segs}, Vt0, St0) ->
{Ss,Eqt,Vt1,St1} = from_pat_bitsegs(Segs, Vt0, St0),
{[binary|Ss],Eqt,Vt1,St1};
from_pat({map,_,Assocs}, Vt0, St0) ->
{Ps,Eqt,Vt1,St1} = from_pat_map_assocs(Assocs, Vt0, St0),
{[map|Ps],Eqt,Vt1,St1};
from_pat({record,_,Name,Fs}, Vt0, St0) -> %Match a record
{Sfs,Eqt,Vt1,St1} = from_pat_rec_fields(Fs, Vt0, St0),
{['make-record',Name|Sfs],Eqt,Vt1,St1};
from_pat({record_index,_,Name,{atom,_,F}}, Vt, St) -> %We KNOW!
{['record-index',Name,F],Vt,St};
from_pat({match,_,P1,P2}, Vt0, St0) -> %Pattern aliases
{Lp1,Eqt1,Vt1,St1} = from_pat(P1, Vt0, St0),
{Lp2,Eqt2,Vt2,St2} = from_pat(P2, Vt1, St1),
{['=',Lp1,Lp2],Eqt1++Eqt2,Vt2,St2};
%% Basically illegal syntax which maybe generated by internal tools.
from_pat({call,_,{atom,_,F},As}, Vt0, St0) ->
%% This will never occur in real code but for macro expansions.
{Las,Eqt,Vt1,St1} = from_pats(As, Vt0, St0),
{[F|Las],Eqt,Vt1,St1}.
from_pats([P|Ps], Vt0, St0) ->
{Lp,Eqt,Vt1,St1} = from_pat(P, Vt0, St0),
{Lps,Eqts,Vt2,St2} = from_pats(Ps, Vt1, St1),
{[Lp|Lps],Eqt++Eqts,Vt2,St2};
from_pats([], Vt, St) -> {[],[],Vt,St}.
%% from_pat_bitsegs(Segs, VarTable, State) -> {Segs,EqTable,VarTable,State}.
from_pat_bitsegs([{bin_element,_,Seg,Size,Type}|Segs], Vt0, St0) ->
{S,Eqt,Vt1,St1} = from_pat_bitseg(Seg, Size, Type, Vt0, St0),
{Ss,Eqts,Vt2,St2} = from_pat_bitsegs(Segs, Vt1, St1),
{[S|Ss],Eqt++Eqts,Vt2,St2};
from_pat_bitsegs([], Vt, St) -> {[],[],Vt,St}.
from_pat_bitseg({string,_,S}, Size, Type, Vt0, St0) ->
{Lsize,Vt1,St1} = from_pat_bitseg_size(Size, Vt0, St0),
{[S|from_bitseg_type(Type) ++ Lsize],[],Vt1,St1};
from_pat_bitseg(P, Size, Type, Vt0, St0) ->
{Lp,Eqt,Vt1,St1} = from_pat(P, Vt0, St0),
{Lsize,Vt2,St2} = from_pat_bitseg_size(Size, Vt1, St1),
{[Lp|from_bitseg_type(Type) ++ Lsize],Eqt,Vt2,St2}.
from_pat_bitseg_size(default, Vt, St) -> {[],Vt,St};
from_pat_bitseg_size({var,_,V}, Vt, St) -> %Size vars never match
{[[size,V]],Vt,St};
from_pat_bitseg_size(Size, Vt0, St0) ->
{Ssize,_,Vt1,St1} = from_pat(Size, Vt0, St0),
{[[size,Ssize]],Vt1,St1}.
%% from_pat_map_assocs(Fields, VarTable, State) ->
%% {Fields,EqTable,VarTable,State}.
from_pat_map_assocs([{map_field_exact,_,Key,Val}|As], Vt0, St0) ->
{Lk,Eqt1,Vt1,St1} = from_pat(Key, Vt0, St0),
{Lv,Eqt2,Vt2,St2} = from_pat(Val, Vt1, St1),
{Lfs,Eqt3,Vt3,St3} = from_pat_map_assocs(As, Vt2, St2),
{[Lk,Lv|Lfs],Eqt1 ++ Eqt2 ++ Eqt3,Vt3,St3};
from_pat_map_assocs([], Vt, St) -> {[],[],Vt,St}.
%% from_pat_rec_fields(Recfields, VarTable, State) ->
%% {Recfields,EqTable,VarTable,State}.
from_pat_rec_fields([{record_field,_,{atom,_,F},P}|Fs], Vt0, St0) ->
{Lp,Eqt,Vt1,St1} = from_pat(P, Vt0, St0),
{Lfs,Eqts,Vt2,St2} = from_pat_rec_fields(Fs, Vt1, St1),
{[F,Lp|Lfs],Eqt++Eqts,Vt2,St2};
from_pat_rec_fields([{record_field,_,{var,_,F},P}|Fs], Vt0, St0) ->
%% Special case!!
{Lp,Eqt,Vt1,St1} = from_pat(P, Vt0, St0),
{Lfs,Eqts,Vt2,St2} = from_pat_rec_fields(Fs, Vt1, St1),
{[F,Lp|Lfs],Eqt++Eqts,Vt2,St2};
from_pat_rec_fields([], Vt, St) -> {[],[],Vt,St}.
%% from_lit(Literal) -> Literal.
%% Build a literal value from AST. No quoting here.
from_lit(Lit) ->
erl_parse:normalise(Lit).
%% Converting LFE to Erlang AST.
%% This is relatively straightforward except for 2 things:
%% - No shadowing of variables so they must be uniquely named.
%% - Local functions must lifted to top level. This is difficult for
%% one expression so this is illegal here as we don't do it.
%%
%% We keep track of all existing variables so when we get a variable
%% in a pattern we can check if this variable has been used before. If
%% so then we must create a new unique variable, add a guard test and
%% add the old-new mapping to the variable table. The existence is
%% global while the mapping is local to that scope. Multiple
%% occurences of variables in an LFE pattern map directly to multiple
%% occurrences in the Erlang AST.
%% Use macros for key-value tables if they exist.
-ifdef(HAS_FULL_KEYS).
-define(NEW_VT, #{}).
-define(VT_GET(K, Vt), maps:get(K, Vt)).
-define(VT_GET(K, Vt, Def), maps:get(K, Vt, Def)).
-define(VT_IS_KEY(K, Vt), maps:is_key(K, Vt)).
-define(VT_PUT(K, V, Vt), Vt#{K => V}).
-else.
-define(NEW_VT, orddict:new()).
-define(VT_GET(K, Vt), orddict:fetch(K, Vt)).
-define(VT_GET(K, Vt, Def),
%% Safe as no new variables created.
case orddict:is_key(K, Vt) of
true -> orddict:fetch(K, Vt);
false -> Def
end).
-define(VT_IS_KEY(K, Vt), orddict:is_key(K, Vt)).
-define(VT_PUT(K, V, Vt), orddict:store(K, V, Vt)).
-endif.
%% safe_fetch(Key, Dict, Default) -> Value.
%% Fetch a value with a default if it doesn't exist.
%% safe_fetch(Key, Dict, Def) ->
%% case orddict:find(Key, Dict) of
%% {ok,Val} -> Val;
%% error -> Def
%% end.
-record(to, {vs=[], %Existing variables
vc=?NEW_VT, %Variable counter
imports=[], %Function renames
aliases=[] %Module aliases
}).
%% to_expr(Expr, LineNumber) -> ErlExpr.
%% to_expr(Expr, LineNumber, {Imports, Aliases}) -> ErlExpr.
%% to_exprs(Expr, LineNumber) -> ErlExprs.
%% to_exprs(Expr, LineNumber, {Imports, Aliases}) -> ErlExprs.
to_expr(E, L) ->
to_expr(E, L, {[],[]}).
to_expr(E, L, {Imports,Aliases}) ->
{Ee,_} = to_expr(E, L, ?NEW_VT, #to{imports=Imports,aliases=Aliases}),
Ee.
to_exprs(Es, L) ->
to_exprs(Es, L, {[],[]}).
to_exprs(Es, L, {Imports,Aliases}) ->
{Ees,_} = to_exprs(Es, L, ?NEW_VT, #to{imports=Imports,aliases=Aliases}),
Ees.
%% to_expr(Expr, LineNumber, VarTable, State) -> {ErlExpr,State}.
%% Core data special forms.
to_expr(?Q(Lit), L, _, St) -> {to_lit(Lit, L),St};
to_expr([cons,H,T], L, Vt, St0) ->
{Eh,St1} = to_expr(H, L, Vt, St0),
{Et,St2} = to_expr(T, L, Vt, St1),
{{cons,L,Eh,Et},St2};
to_expr([car,E], L, Vt, St0) ->
{Ee,St1} = to_expr(E, L, Vt, St0),
{{call,L,{atom,L,hd},[Ee]},St1};
to_expr([cdr,E], L, Vt, St0) ->
{Ee,St1} = to_expr(E, L, Vt, St0),
{{call,L,{atom,L,tl},[Ee]},St1};
to_expr([list|Es], L, Vt, St) ->
Fun = fun (E, {Tail,St0}) ->
{Ee,St1} = to_expr(E, L, Vt, St0),
{{cons,L,Ee,Tail},St1}
end,
foldr(Fun, {{nil,L},St}, Es);
to_expr(['list*'|Es], L, Vt, St) -> %Macro
to_exprs_s(fun to_expr/4, L, Vt, St, Es);
to_expr([tuple|Es], L, Vt, St0) ->
{Ees,St1} = to_exprs(Es, L, Vt, St0),
{{tuple,L,Ees},St1};
to_expr([tref,T,I], L, Vt, St0) ->
{Et,St1} = to_expr(T, L, Vt, St0),
{Ei,St2} = to_expr(I, L, Vt, St1),
%% Get the argument order correct.
{{call,L,{atom,L,element},[Ei,Et]},St2};
to_expr([tset,T,I,V], L, Vt, St0) ->
{Et,St1} = to_expr(T, L, Vt, St0),
{Ei,St2} = to_expr(I, L, Vt, St1),
{Ev,St2} = to_expr(V, L, Vt, St2),
%% Get the argument order correct.
{{call,L,{atom,L,setelement},[Ei,Et,Ev]},St2};
to_expr([binary|Segs], L, Vt, St0) ->
{Esegs,St1} = to_bitsegs(Segs, L, Vt, St0),
{{bin,L,Esegs},St1};
to_expr([map|Pairs], L, Vt, St0) ->
{Eps,St1} = to_map_pairs(Pairs, map_field_assoc, L, Vt, St0),
{{map,L,Eps},St1};
to_expr([msiz,Map], L, Vt, St) ->
to_expr([map_size,Map], L, Vt, St);
to_expr([mref,Map,Key], L, Vt, St) ->
to_map_get(Map, Key, L, Vt, St);
to_expr([mset,Map|Pairs], L, Vt, St) ->
to_map_set(Map, Pairs, L, Vt, St);
to_expr([mupd,Map|Pairs], L, Vt, St) ->
to_map_update(Map, Pairs, L, Vt, St);
to_expr([mrem,Map|Keys], L, Vt, St) ->
to_map_remove(Map, Keys, L, Vt, St);
to_expr(['map-size',Map], L, Vt, St) ->
to_expr([map_size,Map], L, Vt, St);
to_expr(['map-get',Map,Key], L, Vt, St) ->
to_map_get(Map, Key, L, Vt, St);
to_expr(['map-set',Map|Pairs], L, Vt, St) ->
to_map_set(Map, Pairs, L, Vt, St);
to_expr(['map-update',Map|Pairs], L, Vt, St) ->
to_map_update(Map, Pairs, L, Vt, St);
to_expr(['map-remove',Map|Keys], L, Vt, St) ->
to_map_remove(Map, Keys, L, Vt, St);
%% Record special forms.
to_expr(['make-record',Name|Fs], L, Vt, St0) ->
{Efs,St1} = to_rec_fields(Fs, L, Vt, St0),
{{record,L,Name,Efs},St1};
to_expr(['record-index',Name,F], L, _, St) ->
{{record_index,L,Name,{atom,L,F}},St};
to_expr(['record-field',E,Name,F], L, Vt, St0) ->
{Ee,St1} = to_expr(E, L, Vt, St0),
{{record_field,L,Ee,Name,{atom,L,F}},St1};
to_expr(['record-update',E,Name|Fs], L, Vt, St0) ->
{Ee,St1} = to_expr(E, L, Vt, St0),
{Efs,St2} = to_rec_fields(Fs, L, Vt, St1),
{{record,L,Ee,Name,Efs},St2};
%% Function forms.
to_expr([function,F,Ar], L, Vt, St) ->
%% Must handle the special cases here.
case lfe_internal:is_erl_bif(F, Ar) of
true -> to_expr([function,erlang,F,Ar], L, Vt, St);
false ->
case lfe_internal:is_lfe_bif(F, Ar) of
true -> to_expr([function,lfe,F,Ar], L, Vt, St);
false -> {{'fun',L,{function,F,Ar}},St}
end
end;
to_expr([function,M,F,Ar], L, _, St) ->
%% Need the abstract values here.
{{'fun',L,{function,to_lit(M, L),to_lit(F, L),to_lit(Ar, L)}},St};
%% Special known data type operations.
to_expr(['andalso'|Es], L, Vt, St) ->
to_lazy_logic(Es, 'andalso', L, Vt, St);
to_expr(['orelse'|Es], L, Vt, St) ->
to_lazy_logic(Es, 'orelse', L, Vt, St);
%% Core closure special forms.
to_expr([lambda,Args|Body], L, Vt, St) ->
to_lambda(Args, Body, L, Vt, St);
to_expr(['match-lambda'|Cls], L, Vt, St0) ->
{Ecls,St1} = to_fun_cls(Cls, L, Vt, St0),
{{'fun',L,{clauses,Ecls}},St1};
to_expr(['let',Lbs|B], L, Vt, St) ->
to_let(Lbs, B, L, Vt, St);
to_expr(['let-function'|_], L, _, _) -> %Can't do this efficently
illegal_code_error(L, 'let-function');
to_expr(['letrec-function'|_], L, _, _) -> %Can't do this efficently
illegal_code_error(L, 'letrec-function');
%% Core control special forms.
to_expr([progn|B], L, Vt, St) ->
to_block(B, L, Vt, St);
to_expr(['if'|Body], L, Vt, St) ->
to_if(Body, L, Vt, St);
to_expr(['case'|Body], L, Vt, St) ->
to_case(Body, L, Vt, St);
to_expr(['receive'|Cls], L, Vt, St) ->
to_receive(Cls, L, Vt, St);
to_expr(['catch'|B], L, Vt, St0) ->
{Eb,St1} = to_block(B, L, Vt, St0),
{{'catch',L,Eb},St1};
to_expr(['try'|Try], L, Vt, St) -> %Can't do this yet
%% lfe_io:format("try ~w\n~p\n", [L,['try'|Try]]),
to_try(Try, L, Vt, St);
to_expr([funcall,F|As], L, Vt, St0) ->
{Ef,St1} = to_expr(F, L, Vt, St0),
{Eas,St2} = to_exprs(As, L, Vt, St1),
{{call,L,Ef,Eas},St2};
%% Special known macros.
to_expr([lc,Qs|Es], L, Vt0, St0) ->
{Eqs,Vt1,St1} = to_lc_quals(Qs, L, Vt0, St0),
{Ees,St2} = to_block(Es, L, Vt1, St1),
{{lc,L,Ees,Eqs},St2};
%% General function calls.
to_expr([call,?Q(erlang),?Q(F)|As], L, Vt, St0) ->
%% This is semantically the same but some tools behave differently
%% (qlc_pt).
{Eas,St1} = to_exprs(As, L, Vt, St0),
case is_erl_op(F, length(As)) of
true -> {list_to_tuple([op,L,F|Eas]),St1};
false ->
to_remote_call({atom,L,erlang}, {atom,L,F}, Eas, L, St1)
end;
to_expr([call,?Q(M0),F|As], L, Vt, St0) ->
%% Alias modules are literals.
Mod = case orddict:find(M0, St0#to.aliases) of
{ok,M1} -> M1;
error -> M0
end,
{Ef,St1} = to_expr(F, L, Vt, St0),
{Eas,St2} = to_exprs(As, L, Vt, St1),
to_remote_call({atom,L,Mod}, Ef, Eas, L, St2);
to_expr([call,M,F|As], L, Vt, St0) ->
{Em,St1} = to_expr(M, L, Vt, St0),
{Ef,St2} = to_expr(F, L, Vt, St1),
{Eas,St3} = to_exprs(As, L, Vt, St2),
to_remote_call(Em, Ef, Eas, L, St3);
%% General function call.
to_expr([F|As], L, Vt, St0) when is_atom(F) ->
{Eas,St1} = to_exprs(As, L, Vt, St0),
Ar = length(As), %Arity
%% Check for import.
case orddict:find({F,Ar}, St1#to.imports) of
{ok,{Mod,R}} -> %Imported
to_remote_call({atom,L,Mod}, {atom,L,R}, Eas, L, St1);
error -> %Not imported
case is_erl_op(F, Ar) of
true -> {list_to_tuple([op,L,F|Eas]),St1};
false ->
case lfe_internal:is_lfe_bif(F, Ar) of
true ->
to_remote_call({atom,L,lfe}, {atom,L,F}, Eas, L, St1);
false ->
{{call,L,{atom,L,F},Eas},St1}
end
end
end;
to_expr([_|_]=List, L, _, St) ->
case lfe_lib:is_posint_list(List) of
true -> {{string,L,List},St};
false ->
illegal_code_error(L, list) %Not right!
end;
to_expr(V, L, Vt, St) when is_atom(V) -> %Unquoted atom
to_expr_var(V, L, Vt, St);
to_expr(Lit, L, _, St) -> %Everything else is a literal
{to_lit(Lit, L),St}.
to_expr_var(V, L, Vt, St) ->
Var = ?VT_GET(V, Vt, V), %Hmm
{{var,L,Var},St}.
to_remote_call(M, F, As, L, St) ->
{{call,L,{remote,L,M,F},As},St}.
%% is_erl_op(Op, Arity) -> bool().
%% Is Op/Arity one of the known Erlang operators?
is_erl_op(Op, Ar) ->
erl_internal:arith_op(Op, Ar)
orelse erl_internal:bool_op(Op, Ar)
orelse erl_internal:comp_op(Op, Ar)
orelse erl_internal:list_op(Op, Ar)
orelse erl_internal:send_op(Op, Ar).
to_body(Es, L, Vt, St) ->
Fun = fun (E, St0) -> to_expr(E, L, Vt, St0) end,
mapfoldl(Fun, St, Es).
to_exprs(Es, L, Vt, St) ->
Fun = fun (E, St0) -> to_expr(E, L, Vt, St0) end,
mapfoldl(Fun, St, Es).
to_exprs_s(Fun, L, Vt, St, [E]) -> Fun(E, L, Vt, St);
to_exprs_s(Fun, L, Vt, St0, [E|Es]) ->
{Les,St1} = to_exprs_s(Fun, L, Vt, St0, Es),
{Le,St2} = Fun(E, L, Vt, St1),
{{cons,L,Le,Les},St2};
to_exprs_s(_, L, _, St, []) -> {{nil,L},St}.
to_pats_s(Fun, L, Pvs, Vt, St, [E]) -> Fun(E, L, Pvs, Vt, St);
to_pats_s(Fun, L, Pvs0, Vt0, St0, [E|Es]) ->
{Les,Pvs1,Vt1,St1} = to_pats_s(Fun, L, Pvs0, Vt0, St0, Es),
{Le,Pvs2, Vt2,St2} = Fun(E, L, Pvs1, Vt1, St1),
{{cons,L,Le,Les},Pvs2,Vt2,St2};
to_pats_s(_, L, Pvs, Vt, St, []) -> {{nil,L},Pvs,Vt,St}.
%% to_bitsegs(Segs, LineNumber, VarTable, State) -> {Segs,State}.
%% We don't do any real checking here but just assume that everything
%% is correct and in worst case pass the buck to the Erlang compiler.
to_bitsegs(Ss, L, Vt, St) ->
Fun = fun (S, St0) -> to_bitseg(S, L, Vt, St0) end,
mapfoldl(Fun, St, Ss).
%% to_bitseg(Seg, LineNumber, VarTable, State) -> {Seg,State}.
%% We must specially handle the case where the segment is a string.
to_bitseg([Val|Specs]=Seg, L, Vt, St) ->
case lfe_lib:is_posint_list(Seg) of
true ->
{{bin_element,L,{string,L,Seg},default,default},St};
false ->
to_bin_element(Val, Specs, L, Vt, St)
end;
to_bitseg(Val, L, Vt, St) ->
to_bin_element(Val, [], L, Vt, St).
to_bin_element(Val, Specs, L, Vt, St0) ->
{Eval,St1} = to_expr(Val, L, Vt, St0),
{Size,Type} = to_bitseg_type(Specs, default, []),
{Esiz,St2} = to_bin_size(Size, L, Vt, St1),
{{bin_element,L,Eval,Esiz,Type},St2}.
to_bitseg_type([[size,Size]|Specs], _, Type) ->
to_bitseg_type(Specs, Size, Type);
to_bitseg_type([[unit,Unit]|Specs], Size, Type) ->
to_bitseg_type(Specs, Size, Type ++ [{unit,Unit}]);
to_bitseg_type([Spec|Specs], Size, Type) ->
to_bitseg_type(Specs, Size, Type ++ [Spec]);
to_bitseg_type([], Size, []) -> {Size,default};
to_bitseg_type([], Size, Type) -> {Size,Type}.
to_bin_size(all, _, _, St) -> {default,St};
to_bin_size(default, _, _, St) -> {default,St};
to_bin_size(undefined, _, _, St) -> {default,St};
to_bin_size(Size, L, Vt, St) -> to_expr(Size, L, Vt, St).
%% to_map_get(Map, Key, L, Vt, State) -> {MapGet, State}.
%% Check if there is a BIF and in that case use it as this will also
%% work in a guard. The linter has checked if map_get is guardable.
to_map_get(Map, Key, L, Vt, St0) ->
{Eas,St1} = to_exprs([Key,Map], L, Vt, St0),
case erlang:function_exported(erlang, map_get, 2) of
true -> {{call,L,{atom,L,map_get},Eas},St1};
false ->
to_remote_call({atom,L,maps}, {atom,L,get}, Eas, L, St1)
end.
%% to_map_set(Map, Pairs, L, Vt, State) -> {MapSet,State}.
%% to_map_update(Map, Pairs, L, Vt, State) -> {MapUpdate,State}.
%% to_map_remove(Map, Keys, L, Vt, State) -> {MapRemove,State}.
to_map_set(Map, Pairs, L, Vt, St0) ->
{Em,St1} = to_expr(Map, L, Vt, St0),
{Eps,St2} = to_map_pairs(Pairs, map_field_assoc, L, Vt, St1),
{{map,L,Em,Eps},St2}.
to_map_update(Map, Pairs, L, Vt, St0) ->
{Em,St1} = to_expr(Map, L, Vt, St0),
{Eps,St2} = to_map_pairs(Pairs, map_field_exact, L, Vt, St1),
{{map,L,Em,Eps},St2}.
to_map_remove(Map, Keys, L, Vt, St0) ->
{Em,St1} = to_expr(Map, L, Vt, St0),
{Eks,St2} = to_exprs(Keys, L, Vt, St1),
Fun = fun (K, {F,St}) ->
to_remote_call({atom,L,maps}, {atom,L,remove}, [K,F], L, St)
end,
lists:foldl(Fun, {Em,St2}, Eks).
%% to_map_pairs(Pairs, FieldType, LineNumber, VarTable, State) ->
%% {Fields,State}.
to_map_pairs([K,V|Ps], Field, L, Vt, St0) ->
{Ek,St1} = to_expr(K, L, Vt, St0),
{Ev,St2} = to_expr(V, L, Vt, St1),
{Eps,St3} = to_map_pairs(Ps, Field, L, Vt, St2),
{[{Field,L,Ek,Ev}|Eps],St3};
to_map_pairs([], _, _, _, St) -> {[],St}.
%% to_rec_fields(Fields, LineNumber, VarTable, State) -> {Fields,State}.
to_rec_fields(['_',V|Fs], L, Vt, St0) ->
%% Special case!!
{Ev,St1} = to_expr(V, L, Vt, St0),
{Efs,St2} = to_rec_fields(Fs, L, Vt, St1),
{[{record_field,L,{var,L,'_'},Ev}|Efs],St2};
to_rec_fields([F,V|Fs], L, Vt, St0) ->
{Ev,St1} = to_expr(V, L, Vt, St0),
{Efs,St2} = to_rec_fields(Fs, L, Vt, St1),
{[{record_field,L,{atom,L,F},Ev}|Efs],St2};
to_rec_fields([], _, _, St) -> {[],St}.
%% to_fun_cls(Clauses, LineNumber) -> Clauses.
%% to_fun_cl(Clause, LineNumber) -> Clause.
%% Function clauses.
to_fun_cls(Cls, L, Vt, St) ->
Fun = fun (Cl, St0) -> to_fun_cl(Cl, L, Vt, St0) end,
mapfoldl(Fun, St, Cls).
to_fun_cl([As,['when']|B], L, Vt0, St0) ->
{Eas,Vt1,St1} = to_pats(As, L, Vt0, St0),
{Eb,St2} = to_body(B, L, Vt1, St1),
{{clause,L,Eas,[],Eb},St2};
to_fun_cl([As,['when'|G]|B], L, Vt0, St0) ->
{Eas,Vt1,St1} = to_pats(As, L, Vt0, St0),
{Eg,St2} = to_body(G, L, Vt1, St1),
{Eb,St3} = to_body(B, L, Vt1, St2),
{{clause,L,Eas,[Eg],Eb},St3};
to_fun_cl([As|B], L, Vt0, St0) ->
{Eas,Vt1,St1} = to_pats(As, L, Vt0, St0),
{Eb,St2} = to_body(B, L, Vt1, St1),
{{clause,L,Eas,[],Eb},St2}.
%% to_lazy_logic(Exprs, Type, LineNumber, VarTable, State) -> {Logic,State}.
%% These go pairwise right-to-left.
to_lazy_logic([E1,E2], Type, L, Vt, St0) ->
{Ee1,St1} = to_expr(E1, L, Vt, St0),
{Ee2,St2} = to_expr(E2, L, Vt, St1),
{{op,L,Type,Ee1,Ee2},St2};
to_lazy_logic([E1|Es], Type, L, Vt, St0) ->
{Ee1,St1} = to_expr(E1, L, Vt, St0),
{Ees,St2} = to_lazy_logic(Es, Type, L, Vt, St1),
{{op,L,Type,Ee1,Ees},St2}.
%% to_lambda(Args, Body, LineNumber, VarTable, State) -> {Lambda,State}.
to_lambda(As, B, L, Vt, St0) ->
{Ecl,St1} = to_fun_cl([As|B], L, Vt, St0),
{{'fun',L,{clauses,[Ecl]}},St1}.
%% to_let(VarBindings, Body, LineNumber, VarTable, State) -> {Block,State}.
to_let(Lbs, B, L, Vt0, St0) ->
{Ebs,Vt1,St1} = to_let_bindings(Lbs, L, Vt0, St0),
{Eb,St2} = to_body(B, L, Vt1, St1),
{{block,L,Ebs ++ Eb},St2}.
%% to_let_bindings(Bindings, LineNumber, VarTable, State) ->
%% {Block,VarTable,State}.
%% When we have a guard translate into a case but special case where
%% we have an empty guard as erlang compiler doesn't like this.
to_let_bindings(Lbs, L, Vt, St) ->
Fun = fun ([P,E], Vt0, St0) ->
{Ep,Vt1,St1} = to_pat(P, L, Vt0, St0),
{Ee,St2} = to_expr(E, L, Vt0, St1),
{{match,L,Ep,Ee},Vt1,St2};
([P,['when'],E], Vt0, St0) -> %Just to keep it short
{Ep,Vt1,St1} = to_pat(P, L, Vt0, St0),
{Ee,St2} = to_expr(E, L, Vt0, St1),
{{match,L,Ep,Ee},Vt1,St2};
([P,['when'|G],E], Vt0, St0) ->
{Ep,Vt1,St1} = to_pat(P, L, Vt0, St0),
{Eg,St2} = to_body(G, L, Vt1, St1),
{Ee,St3} = to_expr(E, L, Vt1, St2),
{{'case',L,Ee,[{clause,L,[Ep],[Eg],[Ep]}]},Vt1,St3}
end,
mapfoldl2(Fun, Vt, St, Lbs).
%% to_block(Expressions, LineNumber, VarTable, State) -> {Block,State}.
%% Specially check for empty block and then just return (), and for
%% block with one expression and then just return that expression.
to_block(Es, L, Vt, St0) ->
case to_exprs(Es, L, Vt, St0) of
{[Ee],St1} -> {Ee,St1}; %No need to wrap
{[],St1} -> {{nil,L},St1}; %Returns ()
{Ees,St1} -> {{block,L,Ees},St1} %Must wrap
end.
%% to_if(IfBody, LineNumber, VarTable, State) -> {ErlCase,State}.
to_if([Test,True], L, Vt, St) ->
to_if(Test, True, ?Q(false), L, Vt, St);
to_if([Test,True,False], L, Vt, St) ->
to_if(Test, True, False, L, Vt, St);
to_if(_, L, _, _) ->
illegal_code_error(L, 'if').
to_if(Test, True, False, L, Vt, St0) ->
{Etest,St1} = to_expr(Test, L, Vt, St0),
{Ecls,St2} = to_icr_cls([[?Q(true),True],[?Q(false),False]], L, Vt, St1),
{{'case',L,Etest,Ecls},St2}.
%% to_case(CaseBody, LineNumber, VarTable, State) -> {ErlCase,State}.
to_case([E|Cls], L, Vt, St0) ->
{Ee,St1} = to_expr(E, L, Vt, St0),
{Ecls,St2} = to_icr_cls(Cls, L, Vt, St1),
{{'case',L,Ee,Ecls},St2};
to_case(_, L, _, _) ->
illegal_code_error(L, 'case').
%% to_receive(RecClauses, LineNumber, VarTable, State) -> {ErlRec,State}.
to_receive(Cls0, L, Vt, St0) ->
%% Get the right receive form depending on whether there is an after.
{Cls1,A} = splitwith(fun (['after'|_]) -> false; (_) -> true end, Cls0),
{Ecls,St1} = to_icr_cls(Cls1, L, Vt, St0),
case A of
[['after',T|B]] ->
{Et,St2} = to_expr(T, L, Vt, St1),
{Eb,St3} = to_body(B, L, Vt, St2),
{{'receive',L,Ecls,Et,Eb},St3};
[] ->
{{'receive',L,Ecls},St1}
end.
%% to_icr_cls(Clauses, LineNumber, VarTable, State) -> {Clauses,State}.
%% to_icr_cl(Clause, LineNumber, VarTable, State) -> {Clause,State}.
%% If/case/receive clauses.
to_icr_cls(Cls, L, Vt, St) ->
Fun = fun (Cl, St0) -> to_icr_cl(Cl, L, Vt, St0) end,
mapfoldl(Fun, St, Cls).
to_icr_cl([P,['when']|B], L, Vt0, St0) ->
{Ep,Vt1,St1} = to_pat(P, L, Vt0, St0),
{Eb,St2} = to_body(B, L, Vt1, St1),
{{clause,L,[Ep],[],Eb},St2};
to_icr_cl([P,['when'|G]|B], L, Vt0, St0) ->
{Ep,Vt1,St1} = to_pat(P, L, Vt0, St0),
{Eg,St2} = to_body(G, L, Vt1, St1),
{Eb,St3} = to_body(B, L, Vt1, St2),
{{clause,L,[Ep],[Eg],Eb},St3};
to_icr_cl([P|B], L, Vt0, St0) ->
{Ep,Vt1,St1} = to_pat(P, L, Vt0, St0),
{Eb,St2} = to_body(B, L, Vt1, St1),
{{clause,L,[Ep],[],Eb},St2}.
%% to_try(Try, LineNumber, VarTable, State) -> {ErlTry,State}.
%% Step down the try body doing each section separately then put them
%% together. We expand _ catch pattern to {_,_,_}. We remove wrapping
%% progn in try expression which is not really necessary.
to_try([E|Try], L, Vt, St0) ->
{Ee,St1} = to_try_expr(E, L, Vt, St0),
{Ecase,Ecatch,Eafter,St2} = to_try(Try, L, Vt, St1, [], [], []),
{{'try',L,Ee,Ecase,Ecatch,Eafter},St2}.
to_try_expr([progn|Exprs], L, Vt, St) ->
to_exprs(Exprs, L, Vt, St);
to_try_expr(Expr, L, Vt, St) ->
to_exprs([Expr], L, Vt, St).
to_try([['case'|Case]|Try], L, Vt, St0, _, Ecatch, Eafter) ->
{Ecase,St1} = to_icr_cls(Case, L, Vt, St0),
to_try(Try, L, Vt, St1, Ecase, Ecatch, Eafter);
to_try([['catch'|Catch]|Try], L, Vt, St0, Ecase, _, Eafter) ->
{Ecatch,St1} = to_try_cls(Catch, L, Vt, St0),
to_try(Try, L, Vt, St1, Ecase, Ecatch, Eafter);
to_try([['after'|After]|Try], L, Vt, St0, Ecase, Ecatch, _) ->
{Eafter,St1} = to_exprs(After, L, Vt, St0),
to_try(Try, L, Vt, St1, Ecase, Ecatch, Eafter);
to_try([], _, _, St, Ecase, Ecatch, Eafter) ->
{Ecase,Ecatch,Eafter,St}.
to_try_cls(Cls, L, Vt, St) ->
Fun = fun (Cl, St0) -> to_try_cl(Cl, L, Vt, St0) end,
lists:mapfoldl(Fun, St, Cls).
to_try_cl(['_'|Body], L, Vt, St) ->
to_try_cl([[tuple,'_','_','_']|Body], L, Vt, St);
to_try_cl(Cl, L, Vt, St) ->
to_icr_cl(Cl, L, Vt, St).
%% to_lc_quals(Qualifiers, LineNumber, VarTable, State) ->
%% {Qualifiers,VarTable,State}.
%% Can't use mapfoldl2 as guard habling modifies Qualifiers.
to_lc_quals([['<-',P,E]|Qs], L, Vt0, St0) ->
{Ep,Vt1,St1} = to_pat(P, L, Vt0, St0),
{Ee,St2} = to_expr(E, L, Vt1, St1),
{Eqs,Vt2,St3} = to_lc_quals(Qs, L, Vt1, St2),
{[{generate,L,Ep,Ee}|Eqs],Vt2,St3};
to_lc_quals([['<-',P,['when'],E]|Qs], L, Vt, St) ->
to_lc_quals([['<-',P,E]|Qs], L, Vt, St); %Skip empty guard
to_lc_quals([['<-',P,['when'|G],E]|Qs], L, Vt, St) ->
to_lc_quals([['<-',P,E]|G ++ Qs], L, Vt, St); %Move guards to tests
to_lc_quals([T|Qs], L, Vt0, St0) ->
{Et,St1} = to_expr(T, L, Vt0, St0),
{Eqs,Vt1,St2} = to_lc_quals(Qs, L, Vt0, St1),
{[Et|Eqs],Vt1,St2};
to_lc_quals([], _, Vt, St) -> {[],Vt,St}.
%% new_to_var(Base, State) -> {VarName, State}.
%% Each base has it's own counter which makes it easier to keep track
%% of a series. We make sure the variable actually is new and update
%% the state.
new_to_var(Base, #to{vs=Vs,vc=Vct}=St) ->
C = ?VT_GET(Base, Vct, 0),
new_to_var_loop(Base, C, Vs, Vct, St).
new_to_var_loop(Base, C, Vs, Vct, St) ->
V = list_to_atom(lists:concat(["-",Base,"-",C,"-"])),
case lists:member(V, Vs) of
true -> new_to_var_loop(Base, C+1, Vs, Vct, St);
false ->
{V,St#to{vs=[V|Vs],vc=?VT_PUT(Base, C+1, Vct)}}
end.
%% to_pat(Pattern, LineNumber, VarTable, State) -> {Pattern,VarTable,State}.
%% to_pat(Pattern, LineNumber, PatVars, VarTable, State) ->
%% {Pattern,VarTable,State}.
to_pat(Pat, L, Vt0, St0) ->
{Epat,_Pvs,Vt1,St1} = to_pat(Pat, L, [], Vt0, St0),
{Epat,Vt1,St1}.
to_pat([], L, Pvs, Vt, St) -> {{nil,L},Pvs,Vt,St};
to_pat(I, L, Pvs, Vt, St) when is_integer(I) ->
{{integer,L,I},Pvs,Vt,St};
to_pat(F, L, Pvs, Vt, St) when is_float(F) ->
{{float,L,F},Pvs,Vt,St};
to_pat(V, L, Pvs, Vt, St) when is_atom(V) -> %Unquoted atom
to_pat_var(V, L, Pvs, Vt, St);
to_pat(T, L, Pvs, Vt, St) when is_tuple(T) -> %Tuple literal
{to_lit(T, L),Pvs,Vt,St};
to_pat(B, L, Pvs, Vt, St) when is_binary(B) -> %Binary literal
{to_lit(B, L),Pvs,Vt,St};
to_pat(M, L, Pvs, Vt, St) when ?IS_MAP(M) -> %Map literal
{to_lit(M, L),Pvs,Vt,St};
to_pat(?Q(P), L, Pvs, Vt, St) -> %Everything quoted here
{to_lit(P, L),Pvs,Vt,St};
to_pat([cons,H,T], L, Pvs0, Vt0, St0) ->
{[Eh,Et],Pvs1,Vt1,St1} = to_pats([H,T], L, Pvs0, Vt0, St0),
{{cons,L,Eh,Et},Pvs1,Vt1,St1};
to_pat([list|Es], L, Pvs, Vt, St) ->
Fun = fun (E, {Tail,Pvs0,Vt0,St0}) ->
{Ee,Pvs1,Vt1,St1} = to_pat(E, L, Pvs0, Vt0, St0),
{{cons,L,Ee,Tail},Pvs1,Vt1,St1}
end,
foldr(Fun, {{nil,L},Pvs,Vt,St}, Es);
to_pat(['list*'|Es], L, Pvs, Vt, St) -> %Macro
to_pats_s(fun to_pat/5, L, Pvs, Vt, St, Es);
to_pat([tuple|Es], L, Pvs0, Vt0, St0) ->
{Ees,Pvs1,Vt1,St1} = to_pats(Es, L, Pvs0, Vt0, St0),
{{tuple,L,Ees},Pvs1,Vt1,St1};
to_pat([binary|Segs], L, Pvs0, Vt0, St0) ->
{Esegs,Pvs1,Vt1,St1} = to_pat_bitsegs(Segs, L, Pvs0, Vt0, St0),
{{bin,L,Esegs},Pvs1,Vt1,St1};
to_pat([map|Pairs], L, Pvs0, Vt0, St0) ->
{As,Pvs1,Vt1,St1} = to_pat_map_pairs(Pairs, L, Pvs0, Vt0, St0),
{{map,L,As},Pvs1,Vt1,St1};
to_pat(['make-record',R|Fs], L, Pvs0, Vt0, St0) ->
{Efs,Pvs1,Vt1,St1} = to_pat_rec_fields(Fs, L, Pvs0, Vt0, St0),
{{record,L,R,Efs},Pvs1,Vt1,St1};
to_pat(['record-index',R,F], L, Pvs, Vt, St) ->
{{record_index,L,R,{atom,L,F}},Pvs,Vt,St};
to_pat(['=',P1,P2], L, Pvs0, Vt0, St0) -> %Alias
{Ep1,Pvs1,Vt1,St1} = to_pat(P1, L, Pvs0, Vt0, St0),
{Ep2,Pvs2,Vt2,St2} = to_pat(P2, L, Pvs1, Vt1, St1),
{{match,L,Ep1,Ep2},Pvs2, Vt2,St2};
to_pat([_|_]=List, L, Pvs, Vt, St) ->
case lfe_lib:is_posint_list(List) of
true -> {to_lit(List, L),Pvs,Vt,St};
false -> illegal_code_error(L, string)
end.
to_pats(Ps, L, Vt0, St0) ->
{Eps,_Pvs1,Vt1,St1} = to_pats(Ps, L, [], Vt0, St0),
{Eps,Vt1,St1}.
to_pats(Ps, L, Pvs, Vt, St) ->
Fun = fun (P, Pvs0, Vt0, St0) -> to_pat(P, L, Pvs0, Vt0, St0) end,
mapfoldl3(Fun, Pvs, Vt, St, Ps).
to_pat_var('_', L, Pvs, Vt, St) -> %Don't need to handle _
{{var,L,'_'},Pvs,Vt,St};
to_pat_var(V, L, Pvs, Vt0, St0) ->
case lists:member(V, Pvs) of
true -> %Have seen this var in pattern
V1 = ?VT_GET(V, Vt0), % so reuse it
{{var,L,V1},Pvs,Vt0,St0};
false ->
{V1,St1} = new_to_var(V, St0),
Vt1 = ?VT_PUT(V, V1, Vt0),
{{var,L,V1},[V|Pvs],Vt1,St1}
end.
%% to_pat_map_pairs(MapPairs, LineNumber, PatVars, VarTable, State) ->
%% {Args,PatVars,VarTable,State}.
to_pat_map_pairs([K,V|Ps], L, Pvs0, Vt0, St0) ->
{Ek,Pvs1,Vt1,St1} = to_pat(K, L, Pvs0, Vt0, St0),
{Ev,Pvs2,Vt2,St2} = to_pat(V, L, Pvs1, Vt1, St1),
{Eps,Pvs3,Vt3,St3} = to_pat_map_pairs(Ps, L, Pvs2, Vt2, St2),
{[{map_field_exact,L,Ek,Ev}|Eps],Pvs3,Vt3,St3};
to_pat_map_pairs([], _, Pvs, Vt, St) -> {[],Pvs,Vt,St}.
%% to_pat_bitsegs(Segs, LineNumber, PatVars, VarTable, State) ->
%% {Segs,PatVars,VarTable,State}.
%% We don't do any real checking here but just assume that everything
%% is correct and in worst case pass the buck to the Erlang compiler.
to_pat_bitsegs(Ss, L, Pvs, Vt, St) ->
Fun = fun (S, Pvs0, Vt0, St0) -> to_pat_bitseg(S, L, Pvs0, Vt0, St0) end,
mapfoldl3(Fun, Pvs, Vt, St, Ss).
%% to_pat_bitseg(Seg, LineNumber, PatVars, VarTable, State) ->
%% {Seg,PatVars,VarTable,State}.
%% We must specially handle the case where the segment is a string.
to_pat_bitseg([Val|Specs]=Seg, L, Pvs, Vt, St) ->
case lfe_lib:is_posint_list(Seg) of
true ->
{{bin_element,L,{string,L,Seg},default,default},Pvs,Vt,St};
false ->
to_pat_bin_element(Val, Specs, L, Pvs, Vt, St)
end;
to_pat_bitseg(Val, L, Pvs, Vt, St) ->
to_pat_bin_element(Val, [], L, Pvs, Vt, St).
to_pat_bin_element(Val, Specs, L, Pvs0, Vt0, St0) ->
{Eval,Pvs1,Vt1,St1} = to_pat(Val, L, Pvs0, Vt0, St0),
{Size,Type} = to_bitseg_type(Specs, default, []),
{Esiz,Pvs2,Vt2,St2} = to_pat_bin_size(Size, L, Pvs1, Vt1, St1),
{{bin_element,L,Eval,Esiz,Type},Pvs2,Vt2,St2}.
to_pat_bin_size(all, _, Pvs, Vt, St) -> {default,Pvs,Vt,St};
to_pat_bin_size(default, _, Pvs, Vt, St) -> {default,Pvs,Vt,St};
to_pat_bin_size(undefined, _, Pvs, Vt, St) -> {default,Pvs,Vt,St};
to_pat_bin_size(Size, L, Pvs, Vt, St) -> to_pat(Size, L, Pvs, Vt, St).
%% to_pat_rec_fields(Fields, LineNumber, PatVars, VarTable, State) ->
%% {Fields,PatVars,VarTable,State}.
to_pat_rec_fields(['_',P|Fs], L, Pvs0, Vt0, St0) ->
%% Special case!!
{Ep,Pvs1,Vt1,St1} = to_pat(P, L, Pvs0, Vt0, St0),
{Efs,Pvs2,Vt2,St2} = to_pat_rec_fields(Fs, L, Pvs1, Vt1, St1),
{[{record_field,L,{var,L,'_'},Ep}|Efs],Pvs2,Vt2,St2};
to_pat_rec_fields([F,P|Fs], L, Pvs0, Vt0, St0) ->
{Ep,Pvs1,Vt1,St1} = to_pat(P, L, Pvs0, Vt0, St0),
{Efs,Pvs2,Vt2,St2} = to_pat_rec_fields(Fs, L, Pvs1, Vt1, St1),
{[{record_field,L,{atom,L,F},Ep}|Efs],Pvs2,Vt2,St2};
to_pat_rec_fields([], _, Pvs, Vt, St) -> {[],Pvs,Vt,St}.
%% to_lit(Literal, LineNumber) -> ErlLiteral.
%% Convert a literal value. Note that we KNOW it is a literal value.
to_lit(Lit, L) ->
%% This does all the work for us.
erl_parse:abstract(Lit, L).
%% mapfoldl2(Fun, Acc1, Acc2, List) -> {List,Acc1,Acc2}.
%% Like normal mapfoldl but with 2 accumulators.
mapfoldl2(Fun, A0, B0, [E0|Es0]) ->
{E1,A1,B1} = Fun(E0, A0, B0),
{Es1,A2,B2} = mapfoldl2(Fun, A1, B1, Es0),
{[E1|Es1],A2,B2};
mapfoldl2(_, A, B, []) -> {[],A,B}.
mapfoldl3(Fun, A0, B0, C0, [E0|Es0]) ->
{E1,A1,B1,C1} = Fun(E0, A0, B0, C0),
{Es1,A2,B2,C2} = mapfoldl3(Fun, A1, B1, C1, Es0),
{[E1|Es1],A2,B2,C2};
mapfoldl3(_, A, B, C, []) -> {[],A,B,C}.
illegal_code_error(Line, Error) ->
error({illegal_code,Line,Error}).