Current section
Files
Jump to
Current section
Files
src/lfe_translate.erl
%% -*- mode: erlang; indent-tabs-mode: nil -*-
%% Copyright (c) 2008-2025 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]).
-export([to_gexpr/2,to_gexpr/3,to_gexprs/2,to_gexprs/3,to_lit/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}.
%% Convert one expression from Erlang AST to an LFE form.
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, though some are function calls in Erlang.
from_expr({record,_,Name,Fs}, Vt0, St0) ->
{Lfs,Vt1,St1} = from_record_fields(Fs, Vt0, St0),
{['record',Name|Lfs],Vt1,St1};
from_expr({call,_,{atom,_,is_record},[E,{atom,_,Name}]}, Vt0, St0) ->
{Le,Vt1,St1} = from_expr(E, Vt0, St0),
{['is-record',Le,Name],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_record_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({'maybe',_,Body}, Vt, St) ->
from_maybe(Body, none, Vt, St);
from_expr({'maybe',_,Body,Else}, Vt, St) ->
from_maybe(Body, Else, Vt, St);
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);
%% List/binary comprensions.
from_expr({lc,_,E,Qs}, Vt, St) ->
from_list_comp(E, Qs, Vt, St);
from_expr({bc,_,Seg,Qs}, Vt, St) ->
from_binary_comp(Seg, Qs, Vt, St);
%% 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,VarTable,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_maybe(Body, Else, VarTable, State) -> {Maybe,VarTable,State)
from_maybe(Body, Else, Vt0, St0) ->
{Lb,Vt1,St1} = from_maybe_body(Body, Vt0, St0),
{Le,Vt2,St2} = from_maybe_else(Else, Vt1, St1),
{['maybe' | Lb ++ Le], Vt2, St2}.
from_maybe_body([{'maybe_match',_L,Ep,Ee}|Es], Vt0, St0) ->
{Le,Vt1,St1} = from_expr(Ee, Vt0, St0),
{Lp,[],Vt2,St2} = from_pat(Ep, Vt1, St1),
Lmm = ['?=',Lp,Le],
{Les,Vt3,St3} = from_maybe_body(Es, Vt2, St2),
{[Lmm | Les],Vt3,St3};
from_maybe_body([{match,_L,Ep,Ee}|Es], Vt0, St0) ->
{Le,Vt1,St1} = from_expr(Ee, Vt0, St0),
{Lp,[],Vt2,St2} = from_pat(Ep, Vt1, St1),
{Les,Vt3,St3} = from_maybe_body(Es, Vt2, St2),
{[['let',[[Lp,Le]]|Les]],Vt3,St3};
from_maybe_body([E|Es], Vt0, St0) ->
{Le,Vt1,St1} = from_expr(E, Vt0, St0),
{Les,Vt2,St2} = from_maybe_body(Es, Vt1, St1),
{[Le | Les],Vt2,St2};
from_maybe_body([], Vt, St) -> {[],Vt,St}.
from_maybe_else(none, Vt, St) ->
{[],Vt,St};
from_maybe_else({'else',_,Ecls}, Vt0, St0) ->
{Lcls,Vt1,St1} = from_icrt_cls(Ecls, Vt0, St0),
{['else' | Lcls],Vt1,St1}.
%% 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) ->
lists: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_record_fields(Recfields, VarTable, State) -> {Recfields,VarTable,State}.
from_record_fields([{record_field,_,{atom,_,F},V}|Fs], Vt0, St0) ->
{Lv,Vt1,St1} = from_expr(V, Vt0, St0),
{Lfs,Vt2,St2} = from_record_fields(Fs, Vt1, St1),
{[F,Lv|Lfs],Vt2,St2};
from_record_fields([{record_field,_,{var,_,F},V}|Fs], Vt0, St0) ->
%% Special case!!
{Lv,Vt1,St1} = from_expr(V, Vt0, St0),
{Lfs,Vt2,St2} = from_record_fields(Fs, Vt1, St1),
{[F,Lv|Lfs],Vt2,St2};
from_record_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, Cls, Vt, St).
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, Cls, Vt, St0),
{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, Clauses, VarTable, State) -> {Clauses,VarTable,State}.
%% Translate the clauses but only export variables that are defined
%% in all clauses, the intersection of the variables.
from_cls(Fun, [C], Vt0, St0) ->
{Lc,Vt1,St1} = Fun(C, Vt0, St0),
{[Lc],Vt1,St1};
from_cls(Fun, [C|Cs], Vt0, St0) ->
{Lc,Vtc,St1} = Fun(C, Vt0, St0),
{Lcs,Vtcs,St2} = from_cls(Fun, Cs, Vt0, St1),
{[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_try_maybe('case', Lscs) ++
from_try_maybe('catch', Lccs) ++
from_try_maybe('after', Las)],Vt,St4}.
from_try_maybe(_, []) -> [];
from_try_maybe(Tag, Es) -> [[Tag|Es]].
%% from_list_comp(Expr, Qualifiers, VarTable, State) -> {Listcomp,State}.
from_list_comp(E, Qs, Vt0, St0) ->
{Lqs,Vt1,St1} = from_comp_quals(Qs, Vt0, St0),
{Le,Vt2,St2} = from_expr(E, Vt1, St1),
{['list-comp',Lqs,Le],Vt2,St2}.
%% from_binary_comp(BitStringExpr, Qualifiers, VarTable, State) ->
%% {BinaryComp,State}.
from_binary_comp(E, Qs, Vt0, St0) ->
{Lqs,Vt1,St1} = from_comp_quals(Qs, Vt0, St0),
{Le,Vt2,St2} = from_expr(E, Vt1, St1),
{['binary-comp',Lqs,Le],Vt2,St2}.
%% from_comp_quals(Qualifiers, VarTable, State) -> {Qualifiers,VarTable,State}.
%% from_comp_qual(Pattern, Expr, VarTable, State) -> {Qualifier,VarTable,State}.
%% Qualifiers, all variables in the patterns are new variables which
%% shadow existing variables without equality tests.
from_comp_quals([{generate,_,P,E}|Qs], Vt0, St0) ->
{Lp,Lbody,Vt1,St1} = from_comp_qual(P, E, Vt0, St0),
{Lqs,Vt2,St2} = from_comp_quals(Qs, Vt1, St1),
{[['<-',Lp|Lbody]|Lqs],Vt2,St2};
from_comp_quals([{b_generate,_,P,E}|Qs], Vt0, St0) ->
{Lp,Lbody,Vt1,St1} = from_comp_qual(P, E, Vt0, St0),
{Lqs,Vt2,St2} = from_comp_quals(Qs, Vt1, St1),
{[['<=',Lp|Lbody]|Lqs],Vt2,St2};
from_comp_quals([Test|Qs], Vt0, St0) ->
{Ltest,Vt1,St1} = from_expr(Test, Vt0, St0),
{Lqs,Vt2,St2} = from_comp_quals(Qs, Vt1, St1),
{[Ltest|Lqs],Vt2,St2};
from_comp_quals([], Vt, St) -> {[],Vt,St}.
from_comp_qual(Pat, Exp, Vt0, St0) ->
{Lpat,Eqt,Vtp,St1} = from_pat(Pat, [], St0),
Vt1 = ordsets:union(Vtp, Vt0),
{Lexp,Vt2,St2} = from_expr(Exp, Vt1, St1),
Leg = from_eq_tests(Eqt),
Lbody = from_add_guard(Leg, [Lexp]),
{Lpat,Lbody,Vt2,St2}.
%% 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,_,_}=V, Vt, St) ->
from_pat_var(V, Vt, St);
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),
{['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_var({var,_,'_'}, Vt, St) -> %Don't need to handle _
{'_',[],Vt,St};
from_pat_var({var,_,V}, Vt, St0) ->
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_bitsegs(Segs, VarTable, State) -> {Segs,EqTable,VarTable,State}.
from_pat_bitsegs([Seg|Segs], Vt0, St0) ->
{S,Eqt,Vt1,St1} = from_pat_bitseg(Seg, 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({bin_element,_,Seg,Size,Type}, Vt, St) ->
from_pat_bitseg(Seg, Size, Type, 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.
%% Define how () should look in Erlang.
-define(TO_NIL(Line), {nil,Line}).
%% 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 counters
imports=[], %Function renames
aliases=[] %Module aliases
}).
%% to_expr(Expr, LineNumber) -> ErlExpr.
%% to_expr(Expr, LineNumber, {Imports, Aliases}) -> ErlExpr.
%% to_exprs(Exprs, LineNumber) -> ErlExprs.
%% to_exprs(Exprs, LineNumber, {Imports, Aliases}) -> ErlExprs.
to_expr(E, L) ->
to_expr(E, L, {[],[]}).
to_expr(E, L, {Imports,Aliases}) ->
ToSt = #to{imports=Imports,aliases=Aliases},
{Ee,_} = to_expr(E, L, ?NEW_VT, ToSt),
Ee.
to_exprs(Es, L) ->
to_exprs(Es, L, {[],[]}).
to_exprs(Es, L, {Imports,Aliases}) ->
ToSt = #to{imports=Imports,aliases=Aliases},
{Ees,_} = to_expr_list(Es, L, ?NEW_VT, ToSt),
Ees.
to_gexpr(E, L) ->
to_gexpr(E, L, {[],[]}).
to_gexpr(E, L, {Imports,Aliases}) ->
ToSt = #to{imports=Imports,aliases=Aliases},
{Ee,_} = to_gexpr(E, L, ?NEW_VT, ToSt),
Ee.
to_gexprs(Es, L) ->
to_gexprs(Es, L, {[],[]}).
to_gexprs(Es, L, {Imports,Aliases}) ->
ToSt = #to{imports=Imports,aliases=Aliases},
{Ees,_} = to_gexpr_list(Es, L, ?NEW_VT, ToSt),
Ees.
%% to_expr(Expr, LineNumber, VarTable, State) -> {ErlExpr,State}.
%% Convert one expression from an LFE form to an Erlang AST.
%% 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) ->
to_list(fun to_expr/4, Es, L, Vt, St);
to_expr(['list*'|Es], L, Vt, St) -> %Macro
to_list_s(fun to_expr/4, Es, L, Vt, St);
to_expr([tuple|Es], L, Vt, St0) ->
{Ees,St1} = to_expr_list(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_expr_bitsegs(Segs, L, Vt, St0),
{{bin,L,Esegs},St1};
%% Map special forms.
to_expr([map|Pairs], L, Vt, St0) ->
{Eps,St1} = to_map_pairs(fun to_expr/4, 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(['record',Name|Fs], L, Vt, St0) ->
{Efs,St1} = to_record_fields(fun to_expr/4, Fs, L, Vt, St0),
{{record,L,Name,Efs},St1};
%% make-record has been deprecated but we sill accept it for now.
to_expr(['make-record',Name|Fs], L, Vt, St) ->
to_expr(['record',Name|Fs], L, Vt, St);
to_expr(['is-record',E,Name], L, Vt, St0) ->
{Ee,St1} = to_expr(E, L, Vt, St0),
%% This expands to a function call.
{{call,L,{atom,L,is_record},[Ee,{atom,L,Name}]},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_record_fields(fun to_expr/4, Fs, L, Vt, St1),
{{record,L,Ee,Name,Efs},St2};
%% Struct special forms.
%% We try and do the same as Elixir 1.13.3 when we can.
to_expr(['struct',Name|Fs], L, Vt, St) ->
%% Need the right format to call the predefined mod:__struct_ function.
%% Call mod:__struct__ at runtime so we know ours is loaded, BAD!
Pairs = to_struct_pairs(Fs),
Make = [call,?Q(Name),?Q('__struct__'),[list|Pairs]],
to_expr(Make, L, Vt, St);
to_expr(['is-struct',E], L, Vt, St) ->
Is = ['case',E,
[[map,?Q('__struct__'),'|-struct-|'],
['when',[is_atom,'|-struct-|']],?Q(true)],
['_',?Q(false)]],
to_expr(Is, L, Vt, St);
to_expr(['is-struct',E,Name], L, Vt, St) ->
Is = ['case',E,
[[map,?Q('__struct__'),?Q(Name)],?Q(true)],
['_',?Q(false)]],
to_expr(Is, L, Vt, St);
to_expr(['struct-field',E,Name,F], L, Vt, St) ->
Field = ['case',E,
[[map,?Q('__struct__'),?Q(Name),?Q(F),'|-field-|'],'|-field-|'],
['|-struct-|',
[call,?Q(erlang),?Q(error),
[tuple,?Q(badstruct),?Q(Name),'|-struct-|']]]],
to_expr(Field, L, Vt, St);
to_expr(['struct-update',E,Name|Fs], L, Vt, St) ->
Update = ['case',E,
[['=',[map,?Q('__struct__'),?Q(Name)],'|-struct-|'],
['map-update','|-struct-|'|to_struct_fields(Fs)]],
['|-struct-|',
[call,?Q(erlang),?Q(error),
[tuple,?Q(badstruct),?Q(Name),'|-struct-|']]]],
to_expr(Update, L, Vt, St);
%% 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_short_circuit(fun to_expr/4, Es, 'andalso', L, Vt, St);
to_expr(['orelse'|Es], L, Vt, St) ->
to_short_circuit(fun to_expr/4, 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, St) ->
to_match_lambda(Cls, L, Vt, St);
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_progn(B, L, Vt, St);
to_expr([prog1|B], L, Vt, St) ->
to_prog1(B, L, Vt, St);
to_expr([prog2|B], L, Vt, St) ->
to_prog2(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(['cond'|Body], L, Vt, St) ->
to_cond(Body, L, Vt, St);
to_expr(['maybe'|Body], L, Vt, St) ->
to_maybe(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
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_expr_list(As, L, Vt, St1),
{{call,L,Ef,Eas},St2};
%% List/binary comprehensions.
to_expr([lc,Qs,E], L, Vt, St) ->
to_list_comprehension(Qs, E, L, Vt, St);
to_expr(['list-comp',Qs,E], L, Vt, St) ->
to_list_comprehension(Qs, E, L, Vt, St);
to_expr([bc,Qs,BS], L, Vt, St) ->
to_binary_comprehension(Qs, BS, L, Vt, St);
to_expr(['binary-comp',Qs,BS], L, Vt, St) ->
to_binary_comprehension(Qs, BS, L, Vt, St);
%% 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_expr_list(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_expr_list(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_expr_list(As, L, Vt, St2),
to_remote_call(Em, Ef, Eas, L, St3);
%% General function call.
to_expr([Fun|As], L, Vt, St0) when is_atom(Fun) ->
%% {Eas,St1} = to_expr_list(As, L, Vt, St0),
Arity = length(As), %Arity
%% Check if it is an operator function in which case handle it
%% specifically here.
?COND([{fun () -> lfe_internal:is_arith_func(Fun, Arity) end,
fun () -> to_arith_func(Fun, Arity, As, L, Vt, St0) end},
{fun () -> lfe_internal:is_bit_func(Fun, Arity) end,
fun () -> to_bit_func(Fun, Arity, As, L, Vt, St0) end},
{fun () -> lfe_internal:is_bool_func(Fun, Arity) end,
fun () -> to_bool_func(Fun, Arity, As, L, Vt, St0) end},
{fun () -> lfe_internal:is_list_func(Fun, Arity) end,
fun () -> to_list_func(Fun, Arity, As, L, Vt, St0) end},
{fun () -> lfe_internal:is_comp_func(Fun, Arity) end,
fun () -> to_comp_func(Fun, Arity, As, L, Vt, St0) end}
],
%% And the catch-all cond else clause.
fun () -> to_fun_call(Fun, Arity, As, L, Vt, St0) 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_arith_func(ArithOperator, Arity, Args, LineNumber, VarTable, State) ->
%% to_bit_func(BitOperator, Arity, Args, LineNumber, VarTable, State) ->
%% to_bool_func(BoolOperator, Arity, Args, LineNumber, VarTable, State) ->
%% to_list_func(ListOperator, Arity, Args, LineNumber, VarTable, State) ->
%% to_comp_func(CompOperator, Arity, Args, LineNumber, VarTable, State) ->
%% {OpExpr,State}.
%% These need to evaluate all their arguments first. The comparison
%% operators is a bit more complex as they must test against multiple
%% arguments. Especially the boolean comparisons in which all must
%% test against all.
to_arith_func(Op, 1, [A], L, Vt, St0) ->
{Ea,St1} = to_expr(A, L, Vt, St0),
{{op,L,Op,Ea},St1};
to_arith_func(Op, Ar, As, L, Vt, St0) ->
{Evs,Evbs,St1} = to_op_args(Op, Ar, fun to_expr/4, As, L, Vt, St0),
ArithCall = to_left_assoc_op(Op, Evs, L),
{{block,L,Evbs ++ [ArithCall]},St1}.
to_bit_func(Op, _Ar, As, L, Vt, St0) ->
%% These don't need to associated.
{Eas,St1} = to_expr_list(As, L, Vt, St0),
BitCall = list_to_tuple([op,L,Op|Eas]),
{BitCall,St1}.
to_bool_func(Op, 1, [A], L, Vt, St0) ->
{Ea,St1} = to_expr(A, L, Vt, St0),
BoolCall = {op,L,Op,Ea},
{BoolCall,St1};
to_bool_func(Op, Ar, As, L, Vt, St0) ->
{Evs,Evbs,St1} = to_op_args(Op, Ar, fun to_expr/4, As, L, Vt, St0),
BoolCall = to_left_assoc_op(Op, Evs, L),
{{block,L,Evbs ++ [BoolCall]},St1}.
to_list_func(Op, Ar, As, L, Vt, St0) ->
{Evs,Evbs,St1} = to_op_args(Op, Ar, fun to_expr/4, As, L, Vt, St0),
ListCall = to_right_assoc_op(Op, Evs, L),
{{block,L,Evbs ++ [ListCall]},St1}.
to_comp_func(Op, Ar, As, L, Vt0, St0) ->
{Evs,Evbs,St1} = to_op_args(Op, Ar, fun to_expr/4, As, L, Vt0, St0),
OpList = if Op =:= '=/='; Op =:= '/=' ->
to_all_pairs_op(Op, Evs, L);
true ->
to_pairs_op(Op, Evs, L)
end,
{{block,L,Evbs ++ OpList},St1}.
%% to_op_args(Op, Arity, Exprfun, Args, LineNumber, VarTable, State) ->
%% {Varlist,Matches,State}.
%% Generate a list of variables and binding operations {match,..} for
%% these variables to their value expressions.
to_op_args(Op, Ar, Expr, As, L, Vt0, St0) ->
Vs = [ list_to_atom(lists:concat([Op,"-",Vi])) || Vi <- lists:seq(1, Ar) ],
Vas = lists:zipwith(fun (V, A) -> {V,A} end, Vs, As),
VbFun = fun ({V,A}, {Evs,Ms,Vta,Sta}) ->
{Ea,Stb} = Expr(A, L, Vta, Sta),
{Ev,_,Vtb,Stc} = to_pat_var(V, L, [], Vta, Stb),
{Evs ++ [Ev],Ms ++ [{match,L,Ev,Ea}],Vtb,Stc}
end,
{Evs,Matches,_Vt1,St1} = lists:foldl(VbFun, {[],[],Vt0,St0}, Vas),
{Evs,Matches,St1}.
%% to_left_assoc_op(Op, Args, Line) -> OpCall.
%% to_right_assoc_op(Op, Args, Line) -> OpCall.
%% Make an either left or right associative Op call from the list of
%% args.
to_left_assoc_op(_Op, [E1], _L) ->
E1;
to_left_assoc_op(Op, [E1,E2|Es], L) ->
OpCall = {op,L,Op,E1,E2},
to_left_assoc_op(Op, [OpCall|Es], L).
to_right_assoc_op(_Op, [E1], _L) ->
E1;
%% to_right_assoc_op(Op, [E1,E2], L) ->
%% {op,L,Op,E1,E2};
to_right_assoc_op(Op, [E1|Es], L) ->
OpCall = to_right_assoc_op(Op, Es, L),
{op,L,Op,E1,OpCall}.
%% to_pairs_op(Op, Args, Line) -> OpList.
%% to_all_pairs_op(Op, Args, Line) -> OpList.
%% Generate a list of comparisons between pairs or all pairs of the
%% arguments.
to_pairs_op(Op, [E1,E2], L) ->
[{op,L,Op,E1,E2}];
to_pairs_op(Op, [E1,E2|Es], L) ->
Ops = to_pairs_op(Op, [E2|Es], L),
[{op,L,Op,E1,E2}|Ops].
to_all_pairs_op(_Op, [], _L) -> [];
to_all_pairs_op(Op, [E1|Es], L) ->
[ {op,L,Op,E1,E2} || E2 <- Es ] ++ to_all_pairs_op(Op, Es, L).
%% to_comp_pairs(Op, Args, Line) -> OpList.
%% to_comp_all_pairs(Op, Args, Line) -> OpList.
%% Generate a list of comparisons between pairs or all pairs of the
%% arguments.
to_comp_pairs(Op, [E1,E2]) ->
[[Op,E1,E2]];
to_comp_pairs(Op, [E1,E2|Es]) ->
Ees = to_comp_pairs(Op, [E2|Es]),
[[Op,E1,E2]|Ees].
to_comp_all_pairs(_Op, []) -> [];
to_comp_all_pairs(Op, [E1|Es]) ->
[ [Op,E1,E2] || E2 <- Es ] ++ to_comp_all_pairs(Op, Es).
%% to_fun_call(Name, Arity, Args, LineNumber, VarTable, State) ->
%% {FunExpr,State}.
%% All the arguments have already been converted.
to_fun_call(Fun, Ar, As, L, Vt, St0) ->
{Eas,St1} = to_expr_list(As, L, Vt, St0),
%% Check for import.
case orddict:find({Fun,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(Fun, Ar) of
true -> {list_to_tuple([op,L,Fun|Eas]),St1};
false ->
case lfe_internal:is_lfe_bif(Fun, Ar) of
true ->
to_remote_call({atom,L,lfe}, {atom,L,Fun}, Eas, L, St1);
false ->
{{call,L,{atom,L,Fun},Eas},St1}
end
end
end.
%% to_expr_list(Exprs, LineNumber, VarTable, State) -> {ErlExprs,State}.
%% Convert a list of expressions to a list of Erlang ASTs.
to_expr_list(Es, L, Vt, St) ->
Fun = fun (E, St0) -> to_expr(E, L, Vt, St0) end,
lists:mapfoldl(Fun, St, Es).
to_expr_var(V, L, Vt, St) ->
Var = ?VT_GET(V, Vt, V), %Hmm
{{var,L,Var},St}.
%% to_list(ExprFun, Elements, LineNumber, VarTable, State) -> {ListExpr, State}.
%% Convert a list of expressions to an Erlang AST list.
to_list(Expr, Es, L, Vt, St) ->
Cons = fun (E, {Tail,St0}) ->
{Ee,St1} = Expr(E, L, Vt, St0),
{{cons,L,Ee,Tail},St1}
end,
lists:foldr(Cons, {?TO_NIL(L),St}, Es).
%% to_list_s(ExprFun, Elements, LineNumber, VarTable, State) ->
%% {ListExpr, State}.
%% A list* macro expression that probably should have been expanded.
to_list_s(Expr, [E], L, Vt, St) -> Expr(E, L, Vt, St);
to_list_s(Expr, [E|Es], L, Vt, St0) ->
{Le,St1} = Expr(E, L, Vt, St0),
{Les,St2} = to_list_s(Expr, Es, L, Vt, St1),
{{cons,L,Le,Les},St2};
to_list_s(_Expr, _Es, L, _Vt, St) -> {?TO_NIL(L),St}.
%% to_remote_call(Module, Function, Args, LineNumber, VarTable, State) ->
%% {Call,State}.
%% We expect the module, function name and arguments to be already
%% converted.
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(Exprs, LineNumber, VarTable, State) -> {ErlExprs,State}.
%% A body MUST be a list of expressions. If the input list is empty
%% then return a list which contains ().
to_body([], L, _Vt, St) ->
{[?TO_NIL(L)],St};
to_body(Es, L, Vt, St) ->
to_expr_list(Es, L, Vt, St).
%% to_expr_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_expr_bitsegs(Segs, L, Vt, St) ->
BitSeg = fun (Seg, St0) -> to_bitseg(fun to_expr/4, Seg, L, Vt, St0) end,
lists:mapfoldl(BitSeg, St, Segs).
%% to_bitseg(ExprFun, Seg, LineNumber, VarTable, State) -> {Seg,State}.
%% We must specially handle the case where the segment is a string.
%% ExprFun translates the segment Value.
to_bitseg(ExprFun, [Val|Specs]=Seg, L, Vt, St) ->
%% io:format("tbs ~p ~p\n ~p\n", [Seg,Vt,St]),
case lfe_lib:is_posint_list(Seg) of
true ->
{{bin_element,L,{string,L,Seg},default,default},St};
false ->
to_bin_element(ExprFun, Val, Specs, L, Vt, St)
end;
to_bitseg(ExprFun, Val, L, Vt, St) ->
to_bin_element(ExprFun, Val, [], L, Vt, St).
to_bin_element(ExprFun, Val, Specs, L, Vt, St0) ->
{Eval,St1} = ExprFun(Val, L, Vt, St0),
{Size,Type} = to_bitseg_type(Specs, default, []),
{Esiz,St2} = to_bit_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_bit_size(all, _, _, St) -> {default,St};
to_bit_size(default, _, _, St) -> {default,St};
to_bit_size(undefined, _, _, St) -> {default,St};
to_bit_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_expr_list([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(fun to_expr/4, 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(fun to_expr/4, 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_expr_list(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(ExprFun, Pairs, FieldType, LineNumber, VarTable, State) ->
%% {Fields,State}.
to_map_pairs(Expr, [K,V|Ps], Field, L, Vt, St0) ->
{Ek,St1} = Expr(K, L, Vt, St0),
{Ev,St2} = Expr(V, L, Vt, St1),
{Eps,St3} = to_map_pairs(Expr, Ps, Field, L, Vt, St2),
{[{Field,L,Ek,Ev}|Eps],St3};
to_map_pairs(_Expr, [], _Field, _L, _Vt, St) -> {[],St}.
%% to_record_fields(ExprFun, Fields, LineNumber, VarTable, State) ->
%% {Fields,State}.
to_record_fields(Expr, ['_',V|Fs], L, Vt, St0) ->
%% Special case!!
{Ev,St1} = Expr(V, L, Vt, St0),
{Efs,St2} = to_record_fields(Expr, Fs, L, Vt, St1),
{[{record_field,L,{var,L,'_'},Ev}|Efs],St2};
to_record_fields(Expr, [F,V|Fs], L, Vt, St0) ->
{Ev,St1} = Expr(V, L, Vt, St0),
{Efs,St2} = to_record_fields(Expr, Fs, L, Vt, St1),
{[{record_field,L,{atom,L,F},Ev}|Efs],St2};
to_record_fields(_Expr, [], _L, _Vt, St) -> {[],St}.
%% to_struct_fields(Fields) -> Fields.
to_struct_fields([F,V|Fs]) ->
[?Q(F),V|to_struct_fields(Fs)];
to_struct_fields([]) -> [].
to_struct_pairs([F,V|Fs]) ->
[[tuple,?Q(F),V]|to_struct_pairs(Fs)];
to_struct_pairs([]) -> [].
%% 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,
lists:mapfoldl(Fun, St, Cls).
to_fun_cl([As,['when']|B], L, Vt0, St0) ->
%% Skip empty guards.
{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_guard(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_short_circuit(ExprFun, Exprs, Type, LineNumber, VarTable, State) ->
%% {Logic,State}.
%% These are right associative so the evaluation steps from left to
%% right.
to_short_circuit(Expr, [E1,E2], Type, L, Vt, St0) ->
{Ee1,St1} = Expr(E1, L, Vt, St0),
{Ee2,St2} = Expr(E2, L, Vt, St1),
{{op,L,Type,Ee1,Ee2},St2};
to_short_circuit(Expr, [E1|Es], Type, L, Vt, St0) ->
{Ee1,St1} = Expr(E1, L, Vt, St0),
{Ees,St2} = to_short_circuit(Expr, Es, Type, L, Vt, St1),
{{op,L,Type,Ee1,Ees},St2}.
%% to_lambda(Args, Body, LineNumber, VarTable, State) -> {Fun,State}.
to_lambda(As, B, L, Vt, St0) ->
{Ecl,St1} = to_fun_cl([As|B], L, Vt, St0),
{{'fun',L,{clauses,[Ecl]}},St1}.
%% to_match_lambda(Clauses, LineNumber, VarTable, State) -> {Fun,State}.
to_match_lambda(Cls, L, Vt, St0) ->
{Ecls,St1} = to_fun_cls(Cls, L, Vt, St0),
{{'fun',L,{clauses,Ecls}},St1}.
%% to_let(Bindings, Block, LineNumber, VarTable, State) -> {Block,State}.
%% Transform a let into sequence of nested match and case
%% expressions. At the bottom comes the let body. Note that the
%% value expressions for the bindings all use the variable values
%% from before the let whereas the let body uses the of the created
%% bindings.
to_let(Lbs, B, L, Vt, St0) ->
%% io:format("tl ~w ~p\n ~p\n", [L,Lbs,B]),
{Eb,St1} = to_let_body(Lbs, B, L, Vt, Vt, St0),
{{block,L,Eb},St1}.
%% to_let_body(Bindings, Block, LineNumber, LetVarTable, VarTable, State) ->
%% {LetExprs,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_body([[P,E]|Lbs], B, L, Lvt, Vt0, St0) ->
{Ee,St1} = to_expr(E, L, Lvt, St0),
{Ep,Vt1,St2} = to_pat(P, L, Vt0, St1),
{Elet,St3} = to_let_body(Lbs, B, L, Lvt, Vt1, St2),
{[{match,L,Ep,Ee}|Elet],St3};
to_let_body([[P,['when'],E]|Lbs], B, L, Lvt, Vt, St) ->
%% Skip empty guards.
to_let_body([[P,E]|Lbs], B, L, Lvt, Vt, St);
to_let_body([[P,['when'|G],E]|Lbs], B, L, Lvt, Vt0, St0) ->
{Ee,St1} = to_expr(E, L, Lvt, St0),
{Ep,Vt1,St2} = to_pat(P, L, Vt0, St1),
{Eg,St3} = to_guard(G, L, Vt1, St2),
{BadMatch,St4} = to_let_binding_error(L, St3),
{Elet,St5} = to_let_body(Lbs, B, L, Lvt, Vt1, St4),
{[{'case',L,Ee,[{clause,L,[Ep],[Eg],Elet},BadMatch]}],St5};
to_let_body([], B, L, _Lvt, Vt0, St0) ->
%% io:format("tlb ~w ~p\n", [L,B]),
{Eb,St1} = to_body(B, L, Vt0, St0),
{Eb,St1}.
to_let_binding_error(L, St0) ->
{Other,St1} = new_to_var('let-other',St0),
OtherVar = {var,L,Other},
{{clause,L,[OtherVar],[],
[{call,L,{atom,L,error},[{tuple,L,[{atom,L,badmatch},OtherVar]}]}]},St1}.
%% to_block(Expressions, LineNumber, VarTable, State) -> {Block,State}.
%% Return ONE expression. Specially check for empty block and then
%% just return (), and for block with one expression then just return
%% that expression.
to_block(Es, L, Vt, St0) ->
case to_expr_list(Es, L, Vt, St0) of
{[Ee],St1} -> {Ee,St1}; %No need to wrap
{[],St1} -> {?TO_NIL(L),St1}; %Returns ()
{Ees,St1} -> {{block,L,Ees},St1} %Must wrap
end.
%% to_progn(Body, LineNumber, VarTable, State) -> {Block,State}.
%% to_prog1(Body, LineNumber, VarTable, State) -> {Block,State}.
%% to_prog2(Body, LineNumber, VarTable, State) -> {Block,State}.
to_progn(Es, L, Vt, St) ->
to_block(Es, L, Vt, St).
to_prog1([E|Es], L, Vt, St) ->
Prog1 = ['let',[['-prog-1-',E]] | Es ++ ['-prog-1-']],
to_expr(Prog1, L, Vt, St).
to_prog2([E1,E2|Es], L, Vt, St) ->
Prog2 = [progn,E1,
['let',[['-prog-2-',E2]] | Es ++ ['-prog-2-']]],
to_expr(Prog2, L, Vt, St).
%% 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_cond(CondBody, LineNumber, VarTable, State) -> {ErlCond,State}.
to_cond(Body, L, Vt, St) ->
Cond = to_cond_body(Body),
%% io:format("cond ~p\n", [Cond]),
to_expr(Cond, L, Vt, St).
to_cond_body([['else'|Body]]) ->
['progn'|Body];
to_cond_body([[['?=',Pat,['when'|G],Exp]|Tbody]|Body]) ->
['case',Exp,
[Pat,['when'|G]|Tbody],
['_',to_cond_body(Body)]];
to_cond_body([[['?=',Pat,Exp]|Tbody]|Body]) ->
['case',Exp,
[Pat|Tbody],
['_',to_cond_body(Body)]];
to_cond_body([[Test|Tbody]|Body]) ->
['if',Test,[progn|Tbody],to_cond_body(Body)];
to_cond_body([]) -> ?Q(false).
%% to_maybe(MaybeBody, LineNumber, VarTable, State) -> {ErlMaybe,State}.
%% We have 2 different versions here depending on which version of
%% Erlang we are using. If is OTP 27 or later we transform to use the
%% maybe instructions in the AST, while if it older we transform to a
%% sequence of let and case on which we then just do a normal
%% tranformation.
-ifdef(OTP27_MAYBE).
to_maybe(Body, L, Vt, St0) ->
{Eb,St1} = to_maybe_body(Body, L, Vt, St0),
{Ee,St2} = to_maybe_else(Body, L, Vt, St1),
Emb = if Ee =:= [] -> {'maybe',L,Eb};
Ee =/= [] -> {'maybe',L,Eb,{'else',L,Ee}}
end,
{Emb,St2}.
to_maybe_body([['else'|_Cls]], _L, _Vt, St) ->
%% Already done else elsewhere.
{[],St};
to_maybe_body([['?=',Pat,E]|Mes], L, Vt0, St0) ->
{Ematch,Vt1,St1} =
to_maybe_let_binding(Pat, E, maybe_match, L, Vt0, Vt0, St0),
{Emes,St2} = to_maybe_body(Mes, L, Vt1, St1),
{[Ematch | Emes],St2};
to_maybe_body([['let',Bindings|Body]|Mes], L, Vt, St0) ->
{Elet,Eletb,St1} = to_maybe_let(Bindings, Body, L, Vt, St0),
{Emes,St2} = to_maybe_body(Mes, L, Vt, St1),
{Elet ++ Eletb ++ Emes,St2};
to_maybe_body([Me|Mes], L, Vt, St0) ->
{Eme,St1} = to_expr(Me, L, Vt, St0),
{Emes,St2} = to_maybe_body(Mes, L, Vt, St1),
{[Eme|Emes],St2};
to_maybe_body([], _L, _Vt, St) ->
{[],St}.
to_maybe_else(Es, L, Vt, St) ->
Drop = fun (['else'|_Cls]) -> false;
(_Other) -> true
end,
case lists:dropwhile(Drop, Es) of
[] -> {[],St};
[['else'|Cls]] ->
to_fun_cls(Cls, L, Vt, St)
end.
%% to_maybe_let(Bindings, Block, LineNumber, VarTable, State) -> {Let,State}.
%% Note that the value expressions for the bindings all use the
%% variable values from before the let whereas the let body uses the
%% of the created bindings.
to_maybe_let(Lbs, B, L, Vt, St0) ->
{Elbs,Eb,St1} = to_maybe_let_bindings(Lbs, B, L, Vt, Vt, St0),
{Elbs,Eb,St1}.
%% to_maybe_let_bindings([[P,['when'],E]|Lbs], B, L, Lvt, Vt, St) ->
%% %% Just drop an empty guard.
%% to_maybe_let_bindings([[P,E]|Lbs], B, L, Lvt, Vt, St);
to_maybe_let_bindings([[P,['when'|G],E]|Lbs], B, L, Lvt, Vt0, St0) ->
{Emg,Vt1,St1} = to_maybe_let_guard_binding(P, G, E, L, Lvt, Vt0, St0),
{Elbs,Eb,St2} = to_maybe_let_bindings(Lbs, B, L, Lvt, Vt1, St1),
{Emg ++ Elbs,Eb,St2};
to_maybe_let_bindings([[P,E]|Lbs], B, L, Lvt, Vt0, St0) ->
{Ematch,Vt1,St1} = to_maybe_let_binding(P, E, match, L, Lvt, Vt0, St0),
{Elbs,Eb,St2} = to_maybe_let_bindings(Lbs, B, L, Lvt, Vt1, St1),
{[Ematch|Elbs],Eb,St2};
to_maybe_let_bindings([], B, L, _Lvt, Vt, St0) ->
{Eb,St1} = to_maybe_body(B, L, Vt, St0),
{[],Eb,St1}.
to_maybe_let_binding(P, E, Type, L, Lvt, Vt0, St0) ->
{Ee,St1} = to_expr(E, L, Lvt, St0),
{Ep,Vt1,St2} = to_pat(P, L, Vt0, St1),
{{Type,L,Ep,Ee},Vt1,St2}.
to_maybe_let_guard_binding(P, [], E, L, Lvt, Vt0, St0) ->
{Ematch,Vt1,St1} = to_maybe_let_binding(P, E, match, L, Lvt, Vt0, St0),
{[Ematch],Vt1,St1};
to_maybe_let_guard_binding(P, G, E, L, Lvt, Vt0, St0) ->
%% Fix the value. We bind the value to a variable so we can use it
%% to give a good badmatch error.
{Ee,St1} = to_expr(E, L, Lvt, St0),
{Ev,Vt1,St2} = to_pat('let-val', L, Vt0, St1),
{Ep,Vt2,St3} = to_pat(P, L, Vt1, St2),
Ebind = {match,L,Ev,Ee}, %Bind the value
Ematch = {match,L,Ep,Ev}, %Match the value
%% Fix the guard. We use 'andalso' to sequentialize the tests but
%% we only need it with many tests.
Gt = case G of
[Test] -> Test;
Tests -> ['andalso'|Tests]
end,
Guard = ['orelse',Gt,[error,[tuple,?Q(badmatch),'let-val']]],
{Eguard,St4} = to_expr(Guard, L, Vt2, St3),
{[Ebind,Ematch,Eguard],Vt2,St4}.
%% to_maybe_let_clause(P, G, B, L, Vt0, St0) ->
%% {Ep,Vt1,St1} = to_pat(P, L, Vt0, St0),
%% {Eg,St2} = to_guard(G, L, Vt1, St1),
%% {Eb,St3} = to_body(B, L, Vt1, St2),
%% {{clause,L,[Ep],[Eg],Eb},Vt1,St3}.
%% to_maybe_let(Lbs0, B, L, Vt0, St0) ->
%% {Elbs,Vt1,St1} = to_maybe_let_bindings(Lbs0, L, Vt0, Vt0, St0),
%% {Eb,St2} = to_maybe_body(B, L, Vt1, St1),
%% {Elbs ++ Eb,St2}.
%% to_maybe_let_bindings([[P,['when'],E]|Lbs], L, Lvt, Vt, St) ->
%% to_maybe_let_bindings([[P,E]|Lbs], L, Lvt, Vt, St);
%% to_maybe_let_bindings([['when'|G]|Lbs], L, Lvt, Vt0, St0) ->
%% %% {Eg,St1} = to_guard(G, L, Vt0, St0),
%% %% Gt = case G of
%% %% [T] -> T;
%% %% [T|Ts] ->
%% %% lists:foldr(fun (T, Acc) -> ['and',T,Acc] end, T, Ts)
%% %% end,
%% Gt = lists:foldr(fun (T, Acc) -> ['and',T,Acc] end, ?Q(true), G),
%% io:format("grd ~p\n", [{G,Gt}]),
%% {Eg,St1} = to_expr(Gt, L, Vt0, St0),
%% Guard = {match,L,to_lit(true, L),Eg},
%% {Ematches,Vt1,St2} = to_maybe_let_bindings(Lbs, L, Lvt, Vt0, St1),
%% {[Guard | Ematches],Vt1,St2};
%% to_maybe_let_bindings([[P,G,E]|Lbs], L, Lvt, Vt, St) ->
%% %% We match against both the pattern and the value so we can
%% %% return the value without rebuilding it. We need to match twice
%% %% so we can opull the pattern apart at the top level as well to
%% %% get the bindings.
%% Case = ['case',E,
%% [['=',P,'-pat-'],G,'-pat-'],
%% ['-maybe-other-',[error,[tuple,?Q(badmatch),'-maybe-other-']]]],
%% to_maybe_let_bindings([[P,Case]|Lbs], L, Lvt, Vt, St);
%% %% to_maybe_let_bindings([[P,E],G|Lbs], L, Lvt, Vt, St);
%% to_maybe_let_bindings([[P,E]|Lbs], L, Lvt, Vt0, St0) ->
%% {Ematch,Vt1,St1} = to_maybe_let_binding(P, E, L, Lvt, Vt0, St0),
%% {Ematchs,Vt2,St2} = to_maybe_let_bindings(Lbs, L, Lvt, Vt1, St1),
%% {[Ematch|Ematchs],Vt2,St2};
%% to_maybe_let_bindings([], _L, _Lvt, Vt, St) ->
%% {[],Vt,St}.
-else.
to_maybe(Body, L, Vt, St) ->
{Mes,Else} = to_maybe_else(Body),
Case = ['let',[['-else-',Else]],
['progn' | to_maybe_body(Mes)]],
to_expr(Case, L, Vt, St).
to_maybe_body([['?=',Pat,E]|Mes]) ->
to_maybe_match(Pat, E, Mes);
to_maybe_body([['let',Bindings|Body]|Mes]) ->
[['let',Bindings | to_maybe_body(Body)] | to_maybe_body(Mes)];
to_maybe_body([Me|Mes]) ->
[Me | to_maybe_body(Mes)];
to_maybe_body([]) -> [].
to_maybe_match(Pat, E, []) ->
[['case',E,
[['=',Pat,'-match-val-'],'-match-val-'],
['other',['funcall','-else-','other']]]];
to_maybe_match(Pat, E, Mes) ->
[['case',E,
[Pat,['progn' | to_maybe_body(Mes)]],
['other',['funcall','-else-','other']]]].
to_maybe_else(Body) ->
Split = fun (['else'|_Cls]) -> false;
(_Other) -> true
end ,
case lists:splitwith(Split, Body) of
{Mes,[]} ->
{Mes,['lambda',[x],x]};
{Mes,[['else'|Cls0]]} ->
Cls1 = Cls0 ++ [[['-else-other-'],
[error,[tuple,?Q(else_clause),'-else-other-']]]],
{Mes,['match-lambda' | Cls1]}
end.
-endif.
%% 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.
Split = fun (['after'|_]) -> false;
(_) -> true
end,
{Cls1,After} = lists:splitwith(Split, Cls0),
{Ecls,St1} = to_icr_cls(Cls1, L, Vt, St0),
case After 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,
lists:mapfoldl(Fun, St, Cls).
to_icr_cl([P,['when']|B], L, Vt0, St0) ->
%% Skip empty guards.
{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_guard(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) ->
%% lfe_io:format("try ~w\n~p\n", [L,['try',E|Try]]),
{Ee,St1} = to_try_expr(E, L, Vt, St0),
{Ecase,Ecatch,Eafter,St2} = to_try_sections(Try, L, Vt, St1, [], [], []),
{{'try',L,Ee,Ecase,Ecatch,Eafter},St2}.
to_try_expr([progn|Exprs], L, Vt, St) ->
to_expr_list(Exprs, L, Vt, St);
to_try_expr(Expr, L, Vt, St) ->
to_expr_list([Expr], L, Vt, St).
to_try_sections([['case'|Case]|Try], L, Vt, St0, _, Ecatch, Eafter) ->
{Ecase,St1} = to_icr_cls(Case, L, Vt, St0),
to_try_sections(Try, L, Vt, St1, Ecase, Ecatch, Eafter);
to_try_sections([['catch'|Catch]|Try], L, Vt, St0, Ecase, _, Eafter) ->
{Ecatch,St1} = to_try_catch_cls(Catch, L, Vt, St0),
to_try_sections(Try, L, Vt, St1, Ecase, Ecatch, Eafter);
to_try_sections([['after'|After]|Try], L, Vt, St0, Ecase, Ecatch, _) ->
{Eafter,St1} = to_expr_list(After, L, Vt, St0),
to_try_sections(Try, L, Vt, St1, Ecase, Ecatch, Eafter);
to_try_sections([], _, _, St, Ecase, Ecatch, Eafter) ->
{Ecase,Ecatch,Eafter,St}.
to_try_catch_cls(Cls, L, Vt, St) ->
Fun = fun (Cl, St0) -> to_try_catch_cl(Cl, L, Vt, St0) end,
lists:mapfoldl(Fun, St, Cls).
to_try_catch_cl(['_'|Body], L, Vt, St) ->
to_try_catch_cl([[tuple,'_','_','_']|Body], L, Vt, St);
to_try_catch_cl(Cl, L, Vt, St) ->
to_icr_cl(Cl, L, Vt, St).
%% to_list_comprehension(Qualifiers, Expr, LineNumber, VarTable, State) ->
%% {ListComprehension,State}.
to_list_comprehension(Qs, Expr, L, Vt0, St0) ->
{Eqs,Vt1,St1} = to_comp_quals(Qs, L, Vt0, St0),
{Eexpr,St2} = to_expr(Expr, L, Vt1, St1),
{{lc,L,Eexpr,Eqs},St2}.
%% to_binary_comprehension(Qualifiers, Expr, LineNumber, VarTable, State) ->
%% {BinaryComprehension,State}.
to_binary_comprehension(Qs, Expr, L, Vt0, St0) ->
{Eqs,Vt1,St1} = to_comp_quals(Qs, L, Vt0, St0),
{Eexpr,St2} = to_expr(Expr, L, Vt1, St1),
{{bc,L,Eexpr,Eqs},St2}.
%% to_comp_quals(Qualifiers, LineNumber, VarTable, State) ->
%% {Qualifiers,VarTable,State}.
%% Can't use mapfoldl2 as guard handling modifies Qualifiers.
to_comp_quals([['<-',P,E]|Qs], L, Vt0, St0) ->
{Gen,Vt1,St1} = to_comp_listgen(P, E, L, Vt0, St0),
{Eqs,Vt2,St2} = to_comp_quals(Qs, L, Vt1, St1),
{[Gen|Eqs],Vt2,St2};
to_comp_quals([['<-',P,['when'|G],E]|Qs], L, Vt, St) ->
%% Move guards to qualifiers as tests.
to_comp_quals([['<-',P,E]|G ++ Qs], L, Vt, St);
to_comp_quals([['<=',P,E]|Qs], L, Vt0, St0) ->
{Gen,Vt1,St1} = to_comp_binarygen(P, E, L, Vt0, St0),
{Eqs,Vt2,St2} = to_comp_quals(Qs, L, Vt1, St1),
{[Gen|Eqs],Vt2,St2};
to_comp_quals([['<=',P,['when'|G],E]|Qs], L, Vt, St) ->
%% Move guards to qualifiers as tests.
to_comp_quals([['<=',P,E]|G ++ Qs], L, Vt, St);
to_comp_quals([Test|Qs], L, Vt0, St0) ->
{Etest,St1} = to_expr(Test, L, Vt0, St0),
{Eqs,Vt1,St2} = to_comp_quals(Qs, L, Vt0, St1),
{[Etest|Eqs],Vt1,St2};
to_comp_quals([], _, Vt, St) -> {[],Vt,St}.
%% to_comp_listgen(Pattern, ListExpr, LineNumber, VarTable, State) ->
%% {Generator,VarTable,State}.
%% to_comp_binarygen(BitStringPattern, BitStringExpr, LineNumber, VarTable, State) ->
%% {Generator,VarTable,State}.
%% Must be careful in a generator to do the Expression first as the
%% Pattern may update variables in it and changes should only be seen
%% AFTER the generator.
to_comp_listgen(Pat, Expr, L, Vt0, St0) ->
{Eexpr,St1} = to_expr(Expr, L, Vt0, St0),
{Epat,Vt1,St2} = to_pat(Pat, L, Vt0, St1),
{{generate,L,Epat,Eexpr},Vt1,St2}.
to_comp_binarygen([binary|Segs], Expr, L, Vt0, St0) ->
{Eexpr,St1} = to_expr(Expr, L, Vt0, St0),
{Ebin,_Pva,Vt1,St2} = to_pat_binary(Segs, L, [], Vt0, St1),
{{b_generate,L,Ebin,Eexpr},Vt1,St2}.
%% 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_guard(GuardTests, LineNumber, VarTable, State) -> {ErlGuard,State}.
%% to_guard_test(Test, LineNumber, VarTable, State) -> {ErlGuardTest,State}.
%% Having a top level guard function allows us to optimise at the top
%% guard level
to_guard(Es, L, Vt, St) ->
Fun = fun (E, St0) -> to_guard_test(E, L, Vt, St0) end,
lists:mapfoldl(Fun, St, Es).
to_guard_test(['is-struct',E], L, Vt, St) ->
Is = [is_atom,[mref,E,?Q('__struct__')]],
to_gexpr(Is, L, Vt, St);
to_guard_test(['is-struct',E,Name], L, Vt, St) ->
Is = ['=:=',[mref,E,?Q('__struct__')],?Q(Name)],
to_gexpr(Is, L, Vt, St);
to_guard_test(Test, L, Vt, St) ->
to_gexpr(Test, L, Vt, St).
%% to_gexpr(Expr, LineNumber, VarTable, State) -> {ErlExpr,State}.
to_gexpr(?Q(Lit), L, _, St) ->
{to_lit(Lit, L),St};
to_gexpr([cons,H,T], L, Vt, St0) ->
{Eh,St1} = to_gexpr(H, L, Vt, St0),
{Et,St2} = to_gexpr(T, L, Vt, St1),
{{cons,L,Eh,Et},St2};
to_gexpr([car,E], L, Vt, St0) ->
{Ee,St1} = to_gexpr(E, L, Vt, St0),
{{call,L,{atom,L,hd},[Ee]},St1};
to_gexpr([cdr,E], L, Vt, St0) ->
{Ee,St1} = to_gexpr(E, L, Vt, St0),
{{call,L,{atom,L,tl},[Ee]},St1};
to_gexpr([list|Es], L, Vt, St) ->
to_list(fun to_gexpr/4, Es, L, Vt, St);
to_gexpr(['list*'|Es], L, Vt, St) -> %Macro
to_list_s(fun to_gexpr/4, Es, L, Vt, St);
to_gexpr([tuple|Es], L, Vt, St0) ->
{Ees,St1} = to_gexpr_list(Es, L, Vt, St0),
{{tuple,L,Ees},St1};
to_gexpr([tref,T,I], L, Vt, St0) ->
{Et,St1} = to_gexpr(T, L, Vt, St0),
{Ei,St2} = to_gexpr(I, L, Vt, St1),
%% Get the argument order correct.
{{call,L,{atom,L,element},[Ei,Et]},St2};
to_gexpr([binary|Segs], L, Vt, St0) ->
{Esegs,St1} = to_gexpr_bitsegs(Segs, L, Vt, St0),
{{bin,L,Esegs},St1};
%% Map special forms.
to_gexpr([map|Pairs], L, Vt, St0) ->
{Eps,St1} = to_map_pairs(fun to_gexpr/4, Pairs, map_field_assoc, L, Vt, St0),
{{map,L,Eps},St1};
to_gexpr([msiz,Map], L, Vt, St) ->
to_gexpr([map_size,Map], L, Vt, St);
to_gexpr([mref,Map,Key], L, Vt, St) ->
to_gmap_get(Map, Key, L, Vt, St);
to_gexpr([mset,Map|Pairs], L, Vt, St) ->
to_gmap_set(Map, Pairs, L, Vt, St);
to_gexpr([mupd,Map|Pairs], L, Vt, St) ->
to_gmap_update(Map, Pairs, L, Vt, St);
to_gexpr(['map-size',Map], L, Vt, St) ->
to_gexpr([map_size,Map], L, Vt, St);
to_gexpr(['map-get',Map,Key], L, Vt, St) ->
to_gmap_get(Map, Key, L, Vt, St);
to_gexpr(['map-set',Map|Pairs], L, Vt, St) ->
to_gmap_set(Map, Pairs, L, Vt, St);
to_gexpr(['map-update',Map|Pairs], L, Vt, St) ->
to_gmap_update(Map, Pairs, L, Vt, St);
%% Record special forms.
to_gexpr(['record',Name|Fs], L, Vt, St0) ->
{Efs,St1} = to_record_fields(fun to_gexpr/4, Fs, L, Vt, St0),
{{record,L,Name,Efs},St1};
to_gexpr(['is-record',E,Name], L, Vt, St0) ->
{Ee,St1} = to_gexpr(E, L, Vt, St0),
%% This expands to a function call.
{{call,L,{atom,L,is_record},[Ee,{atom,L,Name}]},St1};
to_gexpr(['record-index',Name,F], L, _, St) ->
{{record_index,L,Name,{atom,L,F}},St};
to_gexpr(['record-field',E,Name,F], L, Vt, St0) ->
{Ee,St1} = to_gexpr(E, L, Vt, St0),
{{record_field,L,Ee,Name,{atom,L,F}},St1};
%% Struct special forms.
%% We try and do the same as Elixir 1.13.3 when we can.
to_gexpr(['is-struct',E], L, Vt, St) ->
Is = ['andalso',
[is_map,E],
[call,?Q(erlang),?Q(is_map_key),?Q('__struct__'),E],
[is_atom,[mref,E,?Q('__struct__')]]],
to_gexpr(Is, L, Vt, St);
to_gexpr(['is-struct',E,Name], L, Vt, St) ->
Is = ['andalso',
[is_map,E],
[call,?Q(erlang),?Q(is_map_key),?Q('__struct__'),E],
['=:=',[mref,E,?Q('__struct__')],?Q(Name)]],
to_gexpr(Is, L, Vt, St);
to_gexpr(['struct-field',E,Name,F], L, Vt, St) ->
Field = ['andalso',
[is_map,E],['=:=',[mref,E,?Q('__struct__')],?Q(Name)],
[mref,E,?Q(F)]],
to_gexpr(Field, L, Vt, St);
%% Special known data type operations.
to_gexpr(['andalso'|Es], L, Vt, St) ->
to_short_circuit(fun to_gexpr/4, Es, 'andalso', L, Vt, St);
to_gexpr(['orelse'|Es], L, Vt, St) ->
to_short_circuit(fun to_gexpr/4, Es, 'orelse', L, Vt, St);
%% General function call.
to_gexpr([call,?Q(erlang),?Q(F)|As], L, Vt, St0) ->
{Eas,St1} = to_gexpr_list(As, L, Vt, St0),
case is_erl_op(F, length(As)) of
true -> {list_to_tuple([op,L,F|Eas]),St1};
false ->
%% It's a bif.
to_remote_call({atom,L,erlang}, {atom,L,F}, Eas, L, St1)
end;
to_gexpr([call|_], L, _Vt, _St) ->
illegal_code_error(L, call);
to_gexpr([Fun|As], L, Vt, St0) when is_atom(Fun) ->
%% {Eas,St1} = to_gexpr_list(As, L, Vt, St0),
Arity = length(As),
%% Check if it is an operator function in which case handle it
%% specifically here.
?COND([{fun () -> lfe_internal:is_arith_func(Fun, Arity) end,
fun () -> to_arith_gfunc(Fun, Arity, As, L, Vt, St0) end},
{fun () -> lfe_internal:is_bit_func(Fun, Arity) end,
fun () -> to_bit_gfunc(Fun, Arity, As, L, Vt, St0) end},
{fun () -> lfe_internal:is_bool_func(Fun, Arity) end,
fun () -> to_bool_gfunc(Fun, Arity, As, L, Vt, St0) end},
{fun () -> lfe_internal:is_list_func(Fun, Arity) end,
fun () -> to_list_gfunc(Fun, Arity, As, L, Vt, St0) end},
{fun () -> lfe_internal:is_comp_func(Fun, Arity) end,
fun () -> to_comp_gfunc(Fun, Arity, As, L, Vt, St0) end}
],
%% And the catch-all cond else clause.
fun () -> to_gfun_call(Fun, Arity, As, L, Vt, St0) end);
to_gexpr([_|_]=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_gexpr(V, L, Vt, St) when is_atom(V) -> %Unquoted atom
to_gexpr_var(V, L, Vt, St);
to_gexpr(Lit, L, _, St) -> %Everything else is a literal
{to_lit(Lit, L),St}.
%% to_arith_gfunc(ArithOperator, Arity, Args, LineNumber, VarTable, State) ->
%% to_bit_gfunc(BitOperator, Arity, Args, LineNumber, VarTable, State) ->
%% to_bool_gfunc(BoolOperator, Arity, Args, LineNumber, VarTable, State) ->
%% to_list_gfunc(ListOperator, Arity, Args, LineNumber, VarTable, State) ->
%% {OpExpr,State}.
%% These cannot evaluate their arguments first as they are in a guard.
to_arith_gfunc(Op, 1, [A], L, Vt, St0) ->
{Ea,St1} = to_gexpr(A, L, Vt, St0),
{{op,L,Op,Ea},St1};
to_arith_gfunc(Op, _Ar, As, L, Vt, St0) ->
{Eas,St1} = to_gexpr_list(As, L, Vt, St0),
ArithCall = to_left_assoc_op(Op, Eas, L),
{ArithCall,St1}.
to_bit_gfunc(Op, _Ar, As, L, Vt, St0) ->
%% These don't need to associated.
{Eas,St1} = to_gexpr_list(As, L, Vt, St0),
BitCall = list_to_tuple([op,L,Op|Eas]),
{BitCall,St1}.
to_bool_gfunc(Op, 1, [A], L, Vt, St0) ->
{Ea,St1} = to_gexpr(A, L, Vt, St0),
{{op,L,Op,Ea},St1};
to_bool_gfunc(Op, _Ar, As, L, Vt, St0) ->
{Eas,St1} = to_gexpr_list(As, L, Vt, St0),
BoolCall = to_left_assoc_op(Op, Eas, L),
{BoolCall,St1}.
to_list_gfunc(Op, _Ar, As, L, Vt, St0) ->
{Eas,St1} = to_gexpr_list(As, L, Vt, St0),
FunCall = to_right_assoc_op(Op, Eas, L),
{FunCall,St1}.
%% to_comp_gfunc(CompOperator, Arity, Args, LineNumber, VarTable, State) ->
%% {CompExpr,State}.
%% Build a comp op expression. These are a bit more complex as we
%% need to evaluate to the args first as they will be used many
%% times. This because we must compare the arguments with each other.
%% to_comp_gfunc(_Op, 1, [A], L, Vt, St0) ->
%% {Ea,St1} = to_gexpr(A, L, Vt, St0),
%% {Ea,St1};
to_comp_gfunc(Op, 2, As, L, Vt, St0) ->
{[Ea1,Ea2],St1} = to_gexpr_list(As, L, Vt, St0),
{{op,L,Op,Ea1,Ea2},St1};
to_comp_gfunc(Op, _Ar, As, L, Vt, St0) ->
Tests = if Op =:= '=/='; Op =:= '/=' ->
to_comp_all_pairs(Op, As);
true ->
to_comp_pairs(Op, As)
end,
{Et,St1} = to_gexpr(['and'|Tests], L, Vt, St0),
{Et,St1}.
%% to_gfun_call(NAe, Arity, Args, LineNumber, VarTable, State) ->
%% {FunExpr,State}.
to_gfun_call(Fun, _Ar, As, L, Vt, St0) ->
{Eas,St1} = to_gexpr_list(As, L, Vt, St0),
{{call,L,{atom,L,Fun},Eas},St1}.
%% to_gexpr_list(Exprs, LineNumber, VarTable, State) -> {ErlExprs,State}.
%% Convert a list of guard expressions to a list of Erlang ASTs.
to_gexpr_list(Es, L, Vt, St) ->
Fun = fun (E, St0) -> to_gexpr(E, L, Vt, St0) end,
lists:mapfoldl(Fun, St, Es).
to_gexpr_var(V, L, Vt, St) ->
Var = ?VT_GET(V, Vt, V), %Hmm
{{var,L,Var},St}.
%% to_gexpr_bitsegs(Segs, LineNumber, VarTable, State) -> {Segs,State}.
to_gexpr_bitsegs(Segs, L, Vt, St) ->
BitSeg = fun (Seg, St0) -> to_bitseg(fun to_gexpr/4, Seg, L, Vt, St0) end,
lists:mapfoldl(BitSeg, St, Segs).
%% to_gmap_get(Map, Key, LineNumber, VarTable, State) -> {MapGet,State}.
%% to_gmap_set(Map, Pairs, LineNumber, VarTable, State) -> {MapSet,State}.
%% to_gmap_update(Map, Pairs, LineNumber, VarTable, State) -> {MapUpdate,State}.
to_gmap_get(Map, Key, L, Vt, St0) ->
{Eas,St1} = to_gexpr_list([Key,Map], L, Vt, St0),
{{call,L,{atom,L,map_get},Eas},St1}.
to_gmap_set(Map, Pairs, L, Vt, St0) ->
{Em,St1} = to_gexpr(Map, L, Vt, St0),
{Eps,St2} = to_map_pairs(fun to_gexpr/4, Pairs, map_field_assoc, L, Vt, St1),
{{map,L,Em,Eps},St2}.
to_gmap_update(Map, Pairs, L, Vt, St0) ->
{Em,St1} = to_gexpr(Map, L, Vt, St0),
{Eps,St2} = to_map_pairs(fun to_gexpr/4, Pairs, map_field_exact, L, Vt, St1),
{{map,L,Em,Eps},St2}.
%% 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) -> {?TO_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) ->
to_pat_list(Es, L, Pvs, Vt, St);
to_pat(['list*'|Es], L, Pvs, Vt, St) -> %Macro
to_pat_list_s(Es, L, Pvs, Vt, St);
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, Pvs, Vt, St) ->
to_pat_binary(Segs, L, Pvs, Vt, St);
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};
%% Record patterns.
to_pat(['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};
%% make-record has been deprecated but we sill accept it for now.
to_pat(['make-record',R|Fs], L, Pvs, Vt, St) ->
to_pat(['record',R|Fs], L, Pvs, Vt, St);
to_pat(['record-index',R,F], L, Pvs, Vt, St) ->
{{record_index,L,R,{atom,L,F}},Pvs,Vt,St};
%% Struct patterns.
to_pat(['struct',Name|Fs], L, Pvs, Vt, St) ->
Pat = [map,?Q('__struct__'),?Q(Name)|to_struct_fields(Fs)],
to_pat(Pat, L, Pvs, Vt, St);
%% List patterns.
to_pat(['++'|Ps], L, Pvs, Vt, St) ->
to_pat_append('++', Ps, L, Pvs, Vt, St);
to_pat(['--'|Ps], L, Pvs, Vt, St) ->
to_pat_append('--', Ps, L, Pvs, Vt, St);
%% Alias pattern.
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};
%% General string pattern.
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_list(Elements, LineNumber, PatVars, VarTable, State) ->
%% {ListPat,PatVars,VarTable,State}.
to_pat_list(Es, L, Pvs, Vt, St) ->
Cons = 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,
lists:foldr(Cons, {?TO_NIL(L),Pvs,Vt,St}, Es).
%% to_pat_list_s(Elements, LineNumber, PatVars, VarTable, State) ->
%% {ListPat,PatVars,VarTable,State}.
%% A list* macro expression that probably should have been expanded.
to_pat_list_s([E], L, Pvs, Vt, St) -> to_pat(E, L, Pvs, Vt, St);
to_pat_list_s([E|Es], L, Pvs0, Vt0, St0) ->
{Les,Pvs1,Vt1,St1} = to_pat_list_s(Es, L, Pvs0, Vt0, St0),
{Le,Pvs2, Vt2,St2} = to_pat(E, L, Pvs1, Vt1, St1),
{{cons,L,Le,Les},Pvs2,Vt2,St2};
to_pat_list_s([], L, Pvs, Vt, St) -> {?TO_NIL(L),Pvs,Vt,St}.
%% 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_binary(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_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_bitsegs(Segs, L, Pvs, Vt, St) ->
BitSeg = fun (Seg, Pvs0, Vt0, St0) ->
to_pat_bitseg(Seg, L, Pvs0, Vt0, St0)
end,
mapfoldl3(BitSeg, Pvs, Vt, St, Segs).
%% 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_bit_size(Size, L, Pvs1, Vt1, St1),
{{bin_element,L,Eval,Esiz,Type},Pvs2,Vt2,St2}.
to_pat_bit_size(all, _, Pvs, Vt, St) -> {default,Pvs,Vt,St};
to_pat_bit_size(default, _, Pvs, Vt, St) -> {default,Pvs,Vt,St};
to_pat_bit_size(undefined, _, Pvs, Vt, St) -> {default,Pvs,Vt,St};
to_pat_bit_size(Size, L, Pvs, Vt, St) when is_integer(Size) ->
{{integer,L,Size},Pvs,Vt,St};
to_pat_bit_size(Size, L, Pvs, Vt, St) when is_atom(Size) ->
%% We require the variable to have a value here.
Var = ?VT_GET(Size, Vt, Size), %Hmm
{{var,L,Var},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_pat_append(Op, Ps, L, Pvs0, Vt0, St0) ->
{Eps,Pvs1,Vt1,St1} = to_pats(Ps, L, Pvs0, Vt0, St0),
Pat = to_right_assoc_op(Op, Eps, L),
{Pat,Pvs1,Vt1,St1}.
%% 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}.
%% mapfoldl3(Fun, Acc1, Acc2, Acc3, List) -> {List,Acc1,Acc2,Acc3}.
%% Like normal mapfoldl but with 2/3 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}).