aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler/src/sys_pre_expand.erl
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/compiler/src/sys_pre_expand.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/compiler/src/sys_pre_expand.erl')
-rw-r--r--lib/compiler/src/sys_pre_expand.erl687
1 files changed, 687 insertions, 0 deletions
diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
new file mode 100644
index 0000000000..78dd73e0a2
--- /dev/null
+++ b/lib/compiler/src/sys_pre_expand.erl
@@ -0,0 +1,687 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Purpose : Expand some source Erlang constructions. This is part of the
+%% pre-processing phase.
+
+%% N.B. Although structs (tagged tuples) are not yet allowed in the
+%% language there is code included in pattern/2 and expr/3 (commented out)
+%% that handles them by transforming them to tuples.
+
+-module(sys_pre_expand).
+
+%% Main entry point.
+-export([module/2]).
+
+-import(ordsets, [from_list/1,add_element/2,union/2]).
+-import(lists, [member/2,foldl/3,foldr/3]).
+
+-compile({nowarn_deprecated_function, {erlang,hash,2}}).
+
+-include("../include/erl_bits.hrl").
+
+-record(expand, {module=[], %Module name
+ parameters=undefined, %Module parameters
+ package="", %Module package
+ exports=[], %Exports
+ imports=[], %Imports
+ mod_imports, %Module Imports
+ compile=[], %Compile flags
+ attributes=[], %Attributes
+ defined=[], %Defined functions
+ vcount=0, %Variable counter
+ func=[], %Current function
+ arity=[], %Arity for current function
+ fcount=0, %Local fun count
+ fun_index=0, %Global index for funs
+ bitdefault,
+ bittypes
+ }).
+
+%% module(Forms, CompileOptions)
+%% {ModuleName,Exports,TransformedForms,CompileOptions'}
+%% Expand the forms in one module. N.B.: the lists of predefined
+%% exports and imports are really ordsets!
+%% CompileOptions is augmented with options from -compile attributes.
+
+module(Fs0, Opts0) ->
+
+ %% Expand records. Normalise guard tests.
+ Fs = erl_expand_records:module(Fs0, Opts0),
+
+ Opts = compiler_options(Fs) ++ Opts0,
+
+ %% Set pre-defined exported functions.
+ PreExp = [{module_info,0},{module_info,1}],
+
+ %% Set pre-defined module imports.
+ PreModImp = [{erlang,erlang},{packages,packages}],
+
+ %% Build initial expand record.
+ St0 = #expand{exports=PreExp,
+ mod_imports=dict:from_list(PreModImp),
+ compile=Opts,
+ defined=PreExp,
+ bitdefault = erl_bits:system_bitdefault(),
+ bittypes = erl_bits:system_bittypes()
+ },
+ %% Expand the functions.
+ {Tfs,St1} = forms(Fs, define_functions(Fs, St0)),
+ {Efs,St2} = expand_pmod(Tfs, St1),
+ %% Get the correct list of exported functions.
+ Exports = case member(export_all, St2#expand.compile) of
+ true -> St2#expand.defined;
+ false -> St2#expand.exports
+ end,
+ %% Generate all functions from stored info.
+ {Ats,St3} = module_attrs(St2#expand{exports = Exports}),
+ {Mfs,St4} = module_predef_funcs(St3),
+ {St4#expand.module, St4#expand.exports, Ats ++ Efs ++ Mfs,
+ St4#expand.compile}.
+
+compiler_options(Forms) ->
+ lists:flatten([C || {attribute,_,compile,C} <- Forms]).
+
+expand_pmod(Fs0, St0) ->
+ case St0#expand.parameters of
+ undefined ->
+ {Fs0,St0};
+ Ps0 ->
+ Base = get_base(St0#expand.attributes),
+ Ps = if is_atom(Base) ->
+ ['BASE' | Ps0];
+ true ->
+ Ps0
+ end,
+ {Fs1,Xs,Ds} = sys_expand_pmod:forms(Fs0, Ps,
+ St0#expand.exports,
+ St0#expand.defined),
+ St1 = St0#expand{exports=Xs, defined=Ds},
+ {Fs2,St2} = add_instance(Ps, Fs1, St1),
+ {Fs3,St3} = ensure_new(Base, Ps0, Fs2, St2),
+ {Fs3,St3#expand{attributes = [{abstract, [true]}
+ | St3#expand.attributes]}}
+ end.
+
+get_base(As) ->
+ case lists:keyfind(extends, 1, As) of
+ {extends,[Base]} when is_atom(Base) ->
+ Base;
+ _ ->
+ []
+ end.
+
+ensure_new(Base, Ps, Fs, St) ->
+ case has_new(Fs) of
+ true ->
+ {Fs, St};
+ false ->
+ add_new(Base, Ps, Fs, St)
+ end.
+
+has_new([{function,_L,new,_A,_Cs} | _Fs]) ->
+ true;
+has_new([_ | Fs]) ->
+ has_new(Fs);
+has_new([]) ->
+ false.
+
+add_new(Base, Ps, Fs, St) ->
+ Vs = [{var,0,V} || V <- Ps],
+ As = if is_atom(Base) ->
+ [{call,0,{remote,0,{atom,0,Base},{atom,0,new}},Vs} | Vs];
+ true ->
+ Vs
+ end,
+ Body = [{call,0,{atom,0,instance},As}],
+ add_func(new, Vs, Body, Fs, St).
+
+add_instance(Ps, Fs, St) ->
+ Vs = [{var,0,V} || V <- Ps],
+ AbsMod = [{tuple,0,[{atom,0,St#expand.module}|Vs]}],
+ add_func(instance, Vs, AbsMod, Fs, St).
+
+add_func(Name, Args, Body, Fs, St) ->
+ A = length(Args),
+ F = {function,0,Name,A,[{clause,0,Args,[],Body}]},
+ NA = {Name,A},
+ {[F|Fs],St#expand{exports=add_element(NA, St#expand.exports),
+ defined=add_element(NA, St#expand.defined)}}.
+
+%% define_function(Form, State) -> State.
+%% Add function to defined if form is a function.
+
+define_functions(Forms, #expand{defined=Predef}=St) ->
+ Fs = foldl(fun({function,_,N,A,_Cs}, Acc) -> [{N,A}|Acc];
+ (_, Acc) -> Acc
+ end, Predef, Forms),
+ St#expand{defined=ordsets:from_list(Fs)}.
+
+module_attrs(St) ->
+ {[{attribute,0,Name,Val} || {Name,Val} <- St#expand.attributes],St}.
+
+module_predef_funcs(St) ->
+ PreDef = [{module_info,0},{module_info,1}],
+ PreExp = PreDef,
+ {[{function,0,module_info,0,
+ [{clause,0,[],[],
+ [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}},
+ [{atom,0,St#expand.module}]}]}]},
+ {function,0,module_info,1,
+ [{clause,0,[{var,0,'X'}],[],
+ [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}},
+ [{atom,0,St#expand.module},{var,0,'X'}]}]}]}],
+ St#expand{defined=union(from_list(PreDef), St#expand.defined),
+ exports=union(from_list(PreExp), St#expand.exports)}}.
+
+%% forms(Forms, State) ->
+%% {TransformedForms,State'}
+%% Process the forms. Attributes are lost and just affect the state.
+%% Ignore uninteresting forms like eof and type.
+
+forms([{attribute,_,file,_File}=F|Fs0], St0) ->
+ {Fs,St1} = forms(Fs0, St0),
+ {[F|Fs],St1};
+forms([{attribute,_,Name,Val}|Fs0], St0) ->
+ St1 = attribute(Name, Val, St0),
+ forms(Fs0, St1);
+forms([{function,L,N,A,Cs}|Fs0], St0) ->
+ {Ff,St1} = function(L, N, A, Cs, St0),
+ {Fs,St2} = forms(Fs0, St1),
+ {[Ff|Fs],St2};
+forms([_|Fs], St) -> forms(Fs, St);
+forms([], St) -> {[],St}.
+
+%% attribute(Attribute, Value, State) -> State'.
+%% Process an attribute, this just affects the state.
+
+attribute(module, {Module, As}, St) ->
+ M = package_to_string(Module),
+ St#expand{module=list_to_atom(M),
+ package = packages:strip_last(M),
+ parameters=As};
+attribute(module, Module, St) ->
+ M = package_to_string(Module),
+ St#expand{module=list_to_atom(M),
+ package = packages:strip_last(M)};
+attribute(export, Es, St) ->
+ St#expand{exports=union(from_list(Es), St#expand.exports)};
+attribute(import, Is, St) ->
+ import(Is, St);
+attribute(compile, C, St) when is_list(C) ->
+ St#expand{compile=St#expand.compile ++ C};
+attribute(compile, C, St) ->
+ St#expand{compile=St#expand.compile ++ [C]};
+attribute(Name, Val, St) when is_list(Val) ->
+ St#expand{attributes=St#expand.attributes ++ [{Name,Val}]};
+attribute(Name, Val, St) ->
+ St#expand{attributes=St#expand.attributes ++ [{Name,[Val]}]}.
+
+function(L, N, A, Cs0, St0) ->
+ {Cs,St} = clauses(Cs0, St0#expand{func=N,arity=A,fcount=0}),
+ {{function,L,N,A,Cs},St}.
+
+%% clauses([Clause], State) ->
+%% {[TransformedClause],State}.
+%% Expand function clauses.
+
+clauses([{clause,Line,H0,G0,B0}|Cs0], St0) ->
+ {H,St1} = head(H0, St0),
+ {G,St2} = guard(G0, St1),
+ {B,St3} = exprs(B0, St2),
+ {Cs,St4} = clauses(Cs0, St3),
+ {[{clause,Line,H,G,B}|Cs],St4};
+clauses([], St) -> {[],St}.
+
+%% head(HeadPatterns, State) ->
+%% {TransformedPatterns,Variables,UsedVariables,State'}
+
+head(As, St) -> pattern_list(As, St).
+
+%% pattern(Pattern, State) ->
+%% {TransformedPattern,State'}
+%%
+
+pattern({var,_,'_'}=Var, St) -> %Ignore anonymous variable.
+ {Var,St};
+pattern({var,_,_}=Var, St) ->
+ {Var,St};
+pattern({char,_,_}=Char, St) ->
+ {Char,St};
+pattern({integer,_,_}=Int, St) ->
+ {Int,St};
+pattern({float,_,_}=Float, St) ->
+ {Float,St};
+pattern({atom,_,_}=Atom, St) ->
+ {Atom,St};
+pattern({string,_,_}=String, St) ->
+ {String,St};
+pattern({nil,_}=Nil, St) ->
+ {Nil,St};
+pattern({cons,Line,H,T}, St0) ->
+ {TH,St1} = pattern(H, St0),
+ {TT,St2} = pattern(T, St1),
+ {{cons,Line,TH,TT},St2};
+pattern({tuple,Line,Ps}, St0) ->
+ {TPs,St1} = pattern_list(Ps, St0),
+ {{tuple,Line,TPs},St1};
+%%pattern({struct,Line,Tag,Ps}, St0) ->
+%% {TPs,TPsvs,St1} = pattern_list(Ps, St0),
+%% {{tuple,Line,[{atom,Line,Tag}|TPs]},TPsvs,St1};
+pattern({record_field,_,_,_}=M, St) ->
+ {expand_package(M, St),St}; % must be a package name
+pattern({bin,Line,Es0}, St0) ->
+ {Es1,St1} = pattern_bin(Es0, St0),
+ {{bin,Line,Es1},St1};
+pattern({op,_,'++',{nil,_},R}, St) ->
+ pattern(R, St);
+pattern({op,_,'++',{cons,Li,H,T},R}, St) ->
+ pattern({cons,Li,H,{op,Li,'++',T,R}}, St);
+pattern({op,_,'++',{string,Li,L},R}, St) ->
+ pattern(string_to_conses(Li, L, R), St);
+pattern({match,Line,Pat1, Pat2}, St0) ->
+ {TH,St1} = pattern(Pat2, St0),
+ {TT,St2} = pattern(Pat1, St1),
+ {{match,Line,TT,TH},St2};
+%% Compile-time pattern expressions, including unary operators.
+pattern({op,Line,Op,A}, St) ->
+ {erl_eval:partial_eval({op,Line,Op,A}),St};
+pattern({op,Line,Op,L,R}, St) ->
+ {erl_eval:partial_eval({op,Line,Op,L,R}),St}.
+
+pattern_list([P0|Ps0], St0) ->
+ {P,St1} = pattern(P0, St0),
+ {Ps,St2} = pattern_list(Ps0, St1),
+ {[P|Ps],St2};
+pattern_list([], St) -> {[],St}.
+
+%% guard(Guard, State) ->
+%% {TransformedGuard,State'}
+%% Transform a list of guard tests. We KNOW that this has been checked
+%% and what the guards test are. Use expr for transforming the guard
+%% expressions.
+
+guard([G0|Gs0], St0) ->
+ {G,St1} = guard_tests(G0, St0),
+ {Gs,St2} = guard(Gs0, St1),
+ {[G|Gs],St2};
+guard([], St) -> {[],St}.
+
+guard_tests([Gt0|Gts0], St0) ->
+ {Gt1,St1} = guard_test(Gt0, St0),
+ {Gts1,St2} = guard_tests(Gts0, St1),
+ {[Gt1|Gts1],St2};
+guard_tests([], St) -> {[],St}.
+
+guard_test(Test, St) ->
+ expr(Test, St).
+
+%% exprs(Expressions, State) ->
+%% {TransformedExprs,State'}
+
+exprs([E0|Es0], St0) ->
+ {E,St1} = expr(E0, St0),
+ {Es,St2} = exprs(Es0, St1),
+ {[E|Es],St2};
+exprs([], St) -> {[],St}.
+
+%% expr(Expression, State) ->
+%% {TransformedExpression,State'}
+
+expr({var,_,_}=Var, St) ->
+ {Var,St};
+expr({char,_,_}=Char, St) ->
+ {Char,St};
+expr({integer,_,_}=Int, St) ->
+ {Int,St};
+expr({float,_,_}=Float, St) ->
+ {Float,St};
+expr({atom,_,_}=Atom, St) ->
+ {Atom,St};
+expr({string,_,_}=String, St) ->
+ {String,St};
+expr({nil,_}=Nil, St) ->
+ {Nil,St};
+expr({cons,Line,H0,T0}, St0) ->
+ {H,St1} = expr(H0, St0),
+ {T,St2} = expr(T0, St1),
+ {{cons,Line,H,T},St2};
+expr({lc,Line,E0,Qs0}, St0) ->
+ {Qs1,St1} = lc_tq(Line, Qs0, St0),
+ {E1,St2} = expr(E0, St1),
+ {{lc,Line,E1,Qs1},St2};
+expr({bc,Line,E0,Qs0}, St0) ->
+ {Qs1,St1} = lc_tq(Line, Qs0, St0),
+ {E1,St2} = expr(E0, St1),
+ {{bc,Line,E1,Qs1},St2};
+expr({tuple,Line,Es0}, St0) ->
+ {Es1,St1} = expr_list(Es0, St0),
+ {{tuple,Line,Es1},St1};
+%%expr({struct,Line,Tag,Es0}, Vs, St0) ->
+%% {Es1,Esvs,Esus,St1} = expr_list(Es0, Vs, St0),
+%% {{tuple,Line,[{atom,Line,Tag}|Es1]},Esvs,Esus,St1};
+expr({record_field,_,_,_}=M, St) ->
+ {expand_package(M, St),St}; % must be a package name
+expr({bin,Line,Es0}, St0) ->
+ {Es1,St1} = expr_bin(Es0, St0),
+ {{bin,Line,Es1},St1};
+expr({block,Line,Es0}, St0) ->
+ {Es,St1} = exprs(Es0, St0),
+ {{block,Line,Es},St1};
+expr({'if',Line,Cs0}, St0) ->
+ {Cs,St1} = icr_clauses(Cs0, St0),
+ {{'if',Line,Cs},St1};
+expr({'case',Line,E0,Cs0}, St0) ->
+ {E,St1} = expr(E0, St0),
+ {Cs,St2} = icr_clauses(Cs0, St1),
+ {{'case',Line,E,Cs},St2};
+expr({'receive',Line,Cs0}, St0) ->
+ {Cs,St1} = icr_clauses(Cs0, St0),
+ {{'receive',Line,Cs},St1};
+expr({'receive',Line,Cs0,To0,ToEs0}, St0) ->
+ {To,St1} = expr(To0, St0),
+ {ToEs,St2} = exprs(ToEs0, St1),
+ {Cs,St3} = icr_clauses(Cs0, St2),
+ {{'receive',Line,Cs,To,ToEs},St3};
+expr({'fun',Line,Body}, St) ->
+ fun_tq(Line, Body, St);
+expr({call,Line,{atom,La,N},As0}, St0) ->
+ {As,St1} = expr_list(As0, St0),
+ Ar = length(As),
+ case erl_internal:bif(N, Ar) of
+ true ->
+ {{call,Line,{remote,La,{atom,La,erlang},{atom,La,N}},As},St1};
+ false ->
+ case imported(N, Ar, St1) of
+ {yes,Mod} ->
+ {{call,Line,{remote,La,{atom,La,Mod},{atom,La,N}},As},St1};
+ no ->
+ {{call,Line,{atom,La,N},As},St1}
+ end
+ end;
+expr({call,Line,{record_field,_,_,_}=M,As0}, St0) ->
+ expr({call,Line,expand_package(M, St0),As0}, St0);
+expr({call,Line,{remote,Lr,M,F},As0}, St0) ->
+ M1 = expand_package(M, St0),
+ {[M2,F1|As1],St1} = expr_list([M1,F|As0], St0),
+ {{call,Line,{remote,Lr,M2,F1},As1},St1};
+expr({call,Line,{tuple,_,[{atom,_,_}=M,{atom,_,_}=F]},As}, St) ->
+ %% Rewrite {Mod,Function}(Args...) to Mod:Function(Args...).
+ expr({call,Line,{remote,Line,M,F},As}, St);
+expr({call,Line,F,As0}, St0) ->
+ {[Fun1|As1],St1} = expr_list([F|As0], St0),
+ {{call,Line,Fun1,As1},St1};
+expr({'try',Line,Es0,Scs0,Ccs0,As0}, St0) ->
+ {Es1,St1} = exprs(Es0, St0),
+ {Scs1,St2} = icr_clauses(Scs0, St1),
+ {Ccs1,St3} = icr_clauses(Ccs0, St2),
+ {As1,St4} = exprs(As0, St3),
+ {{'try',Line,Es1,Scs1,Ccs1,As1},St4};
+expr({'catch',Line,E0}, St0) ->
+ %% Catch exports no new variables.
+ {E,St1} = expr(E0, St0),
+ {{'catch',Line,E},St1};
+expr({match,Line,P0,E0}, St0) ->
+ {E,St1} = expr(E0, St0),
+ {P,St2} = pattern(P0, St1),
+ {{match,Line,P,E},St2};
+expr({op,Line,Op,A0}, St0) ->
+ {A,St1} = expr(A0, St0),
+ {{op,Line,Op,A},St1};
+expr({op,Line,Op,L0,R0}, St0) ->
+ {L,St1} = expr(L0, St0),
+ {R,St2} = expr(R0, St1),
+ {{op,Line,Op,L,R},St2}.
+
+expr_list([E0|Es0], St0) ->
+ {E,St1} = expr(E0, St0),
+ {Es,St2} = expr_list(Es0, St1),
+ {[E|Es],St2};
+expr_list([], St) -> {[],St}.
+
+%% icr_clauses([Clause], State) -> {[TransformedClause],State'}
+%% Be very careful here to return the variables that are really used
+%% and really new.
+
+icr_clauses([], St) -> {[],St};
+icr_clauses(Clauses, St) -> icr_clauses2(Clauses, St).
+
+icr_clauses2([{clause,Line,H0,G0,B0}|Cs0], St0) ->
+ {H,St1} = head(H0, St0),
+ {G,St2} = guard(G0, St1),
+ {B,St3} = exprs(B0, St2),
+ {Cs,St4} = icr_clauses2(Cs0, St3),
+ {[{clause,Line,H,G,B}|Cs],St4};
+icr_clauses2([], St) -> {[],St}.
+
+%% lc_tq(Line, Qualifiers, State) ->
+%% {[TransQual],State'}
+
+lc_tq(Line, [{generate,Lg,P0,G0} | Qs0], St0) ->
+ {G1,St1} = expr(G0, St0),
+ {P1,St2} = pattern(P0, St1),
+ {Qs1,St3} = lc_tq(Line, Qs0, St2),
+ {[{generate,Lg,P1,G1} | Qs1],St3};
+
+lc_tq(Line, [{b_generate,Lg,P0,G0}|Qs0], St0) ->
+ {G1,St1} = expr(G0, St0),
+ {P1,St2} = pattern(P0, St1),
+ {Qs1,St3} = lc_tq(Line, Qs0, St2),
+ {[{b_generate,Lg,P1,G1}|Qs1],St3};
+lc_tq(Line, [F0 | Qs0], St0) ->
+ case erl_lint:is_guard_test(F0) of
+ true ->
+ {F1,St1} = guard_test(F0, St0),
+ {Qs1,St2} = lc_tq(Line, Qs0, St1),
+ {[F1|Qs1],St2};
+ false ->
+ {F1,St1} = expr(F0, St0),
+ {Qs1,St2} = lc_tq(Line, Qs0, St1),
+ {[F1 | Qs1],St2}
+ end;
+lc_tq(_Line, [], St0) ->
+ {[],St0}.
+
+
+%% fun_tq(Line, Body, State) ->
+%% {Fun,State'}
+%% Transform an "explicit" fun {'fun', Line, {clauses, Cs}} into an
+%% extended form {'fun', Line, {clauses, Cs}, Info}, unless it is the
+%% name of a BIF (erl_lint has checked that it is not an import).
+%% Process the body sequence directly to get the new and used variables.
+%% "Implicit" funs {'fun', Line, {function, F, A}} are not changed.
+
+fun_tq(Lf, {function,F,A}=Function, St0) ->
+ {As,St1} = new_vars(A, Lf, St0),
+ Cs = [{clause,Lf,As,[],[{call,Lf,{atom,Lf,F},As}]}],
+ case erl_internal:bif(F, A) of
+ true ->
+ fun_tq(Lf, {clauses,Cs}, St1);
+ false ->
+ Index = St0#expand.fun_index,
+ Uniq = erlang:hash(Cs, (1 bsl 27)-1),
+ {Fname,St2} = new_fun_name(St1),
+ {{'fun',Lf,Function,{Index,Uniq,Fname}},
+ St2#expand{fun_index=Index+1}}
+ end;
+fun_tq(L, {function,M,F,A}, St) ->
+ {{call,L,{remote,L,{atom,L,erlang},{atom,L,make_fun}},
+ [{atom,L,M},{atom,L,F},{integer,L,A}]},St};
+fun_tq(Lf, {clauses,Cs0}, St0) ->
+ Uniq = erlang:hash(Cs0, (1 bsl 27)-1),
+ {Cs1,St1} = fun_clauses(Cs0, St0),
+ Index = St1#expand.fun_index,
+ {Fname,St2} = new_fun_name(St1),
+ {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},
+ St2#expand{fun_index=Index+1}}.
+
+fun_clauses([{clause,L,H0,G0,B0}|Cs0], St0) ->
+ {H,St1} = head(H0, St0),
+ {G,St2} = guard(G0, St1),
+ {B,St3} = exprs(B0, St2),
+ {Cs,St4} = fun_clauses(Cs0, St3),
+ {[{clause,L,H,G,B}|Cs],St4};
+fun_clauses([], St) -> {[],St}.
+
+%% new_fun_name(State) -> {FunName,State}.
+
+new_fun_name(#expand{func=F,arity=A,fcount=I}=St) ->
+ Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A)
+ ++ "-fun-" ++ integer_to_list(I) ++ "-",
+ {list_to_atom(Name),St#expand{fcount=I+1}}.
+
+%% pattern_bin([Element], State) -> {[Element],[Variable],[UsedVar],State}.
+
+pattern_bin(Es0, St) ->
+ Es1 = bin_expand_strings(Es0),
+ foldr(fun (E, Acc) -> pattern_element(E, Acc) end, {[],St}, Es1).
+
+pattern_element({bin_element,Line,Expr0,Size0,Type0}, {Es,St0}) ->
+ {Expr1,St1} = pattern(Expr0, St0),
+ {Size1,St2} = pat_bit_size(Size0, St1),
+ {Size,Type} = make_bit_type(Line, Size1, Type0),
+ Expr = coerce_to_float(Expr1, Type0),
+ {[{bin_element,Line,Expr,Size,Type}|Es],St2}.
+
+pat_bit_size(default, St) -> {default,St};
+pat_bit_size({atom,_La,all}=All, St) -> {All,St};
+pat_bit_size({var,_Lv,_V}=Var, St) -> {Var,St};
+pat_bit_size(Size, St) ->
+ Line = element(2, Size),
+ {value,Sz,_} = erl_eval:expr(Size, erl_eval:new_bindings()),
+ {{integer,Line,Sz},St}.
+
+make_bit_type(Line, default, Type0) ->
+ case erl_bits:set_bit_type(default, Type0) of
+ {ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)};
+ {ok,undefined,Bt} -> {{atom,Line,undefined},erl_bits:as_list(Bt)};
+ {ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)}
+ end;
+make_bit_type(_Line, Size, Type0) -> %Integer or 'all'
+ {ok,Size,Bt} = erl_bits:set_bit_type(Size, Type0),
+ {Size,erl_bits:as_list(Bt)}.
+
+coerce_to_float({integer,L,I}=E, [float|_]) ->
+ try
+ {float,L,float(I)}
+ catch
+ error:badarg -> E;
+ error:badarith -> E
+ end;
+coerce_to_float(E, _) -> E.
+
+%% expr_bin([Element], State) -> {[Element],State}.
+
+expr_bin(Es0, St) ->
+ Es1 = bin_expand_strings(Es0),
+ foldr(fun (E, Acc) -> bin_element(E, Acc) end, {[],St}, Es1).
+
+bin_element({bin_element,Line,Expr,Size,Type}, {Es,St0}) ->
+ {Expr1,St1} = expr(Expr, St0),
+ {Size1,St2} = if Size == default -> {default,St1};
+ true -> expr(Size, St1)
+ end,
+ {Size2,Type1} = make_bit_type(Line, Size1, Type),
+ {[{bin_element,Line,Expr1,Size2,Type1}|Es],St2}.
+
+bin_expand_strings(Es) ->
+ foldr(fun ({bin_element,Line,{string,_,S},Sz,Ts}, Es1) ->
+ foldr(fun (C, Es2) ->
+ [{bin_element,Line,{char,Line,C},Sz,Ts}|Es2]
+ end, Es1, S);
+ (E, Es1) -> [E|Es1]
+ end, [], Es).
+
+%% new_var_name(State) -> {VarName,State}.
+
+new_var_name(St) ->
+ C = St#expand.vcount,
+ {list_to_atom("pre" ++ integer_to_list(C)),St#expand{vcount=C+1}}.
+
+%% new_var(Line, State) -> {Var,State}.
+
+new_var(L, St0) ->
+ {New,St1} = new_var_name(St0),
+ {{var,L,New},St1}.
+
+%% new_vars(Count, Line, State) -> {[Var],State}.
+%% Make Count new variables.
+
+new_vars(N, L, St) -> new_vars(N, L, St, []).
+
+new_vars(N, L, St0, Vs) when N > 0 ->
+ {V,St1} = new_var(L, St0),
+ new_vars(N-1, L, St1, [V|Vs]);
+new_vars(0, _L, St, Vs) -> {Vs,St}.
+
+string_to_conses(Line, Cs, Tail) ->
+ foldr(fun (C, T) -> {cons,Line,{char,Line,C},T} end, Tail, Cs).
+
+
+%% In syntax trees, module/package names are atoms or lists of atoms.
+
+package_to_string(A) when is_atom(A) -> atom_to_list(A);
+package_to_string(L) when is_list(L) -> packages:concat(L).
+
+expand_package({atom,L,A} = M, St) ->
+ case dict:find(A, St#expand.mod_imports) of
+ {ok, A1} ->
+ {atom,L,A1};
+ error ->
+ case packages:is_segmented(A) of
+ true ->
+ M;
+ false ->
+ M1 = packages:concat(St#expand.package, A),
+ {atom,L,list_to_atom(M1)}
+ end
+ end;
+expand_package(M, _St) ->
+ case erl_parse:package_segments(M) of
+ error ->
+ M;
+ M1 ->
+ {atom,element(2,M),list_to_atom(package_to_string(M1))}
+ end.
+
+%% import(Line, Imports, State) ->
+%% State'
+%% imported(Name, Arity, State) ->
+%% {yes,Module} | no
+%% Handle import declarations and test for imported functions. No need to
+%% check when building imports as code is correct.
+
+import({Mod0,Fs}, St) ->
+ Mod = list_to_atom(package_to_string(Mod0)),
+ Mfs = from_list(Fs),
+ St#expand{imports=add_imports(Mod, Mfs, St#expand.imports)};
+import(Mod0, St) ->
+ Mod = package_to_string(Mod0),
+ Key = list_to_atom(packages:last(Mod)),
+ St#expand{mod_imports=dict:store(Key, list_to_atom(Mod),
+ St#expand.mod_imports)}.
+
+add_imports(Mod, [F|Fs], Is) ->
+ add_imports(Mod, Fs, orddict:store(F, Mod, Is));
+add_imports(_, [], Is) -> Is.
+
+imported(F, A, St) ->
+ case orddict:find({F,A}, St#expand.imports) of
+ {ok,Mod} -> {yes,Mod};
+ error -> no
+ end.