Skip to content


Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

730 lines (638 sloc) 26.603 kb
%% ``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 via the world wide web at
%% 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.
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%% $Id$
%% 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.
%% Main entry point.
-import(ordsets, [list_to_set/1,add_element/2,
-import(lists, [member/2,map/2,foldl/3,foldr/3]).
-record(expand, {module=[], %Module name
exports=[], %Exports
imports=[], %Imports
compile=[], %Compile flags
records=dict:new(), %Record definitions
attributes=[], %Attributes
defined=[], %Defined functions
vcount=0, %Variable counter
func=[]}). %Current function
%% module(Forms, CompileOptions)
%% {ModuleName,Exports,TransformedForms}
%% Expand the forms in one module. N.B. the lists of predefined functions
%% and exports are really ordsets!
module(Fs, Opts) ->
%% Set pre-defined functions.
PreDef = [{module_info,0},{module_info,1}],
%% Set pre-defined exports.
PreExp = [{module_info,0},{module_info,1}],
%% Build initial expand record.
St0 = #expand{exports=PreExp,
%% Expand the functions.
{Tfs,St1} = forms(Fs, foldl(fun define_function/2, St0, Fs)),
%% Get the correct list of exported functions.
Exports = case member(export_all, St1#expand.compile) of
true -> St1#expand.defined;
false -> St1#expand.exports
%% Generate compile time info.
{{Y,Mo,D}, {H,Mi,S}} = erlang:universaltime(),
Compile = [{time,{Y,Mo,D,H,Mi,S}},{options,St1#expand.compile}],
%% Generate all functions from stored info.
{Ats,St2} = module_attrs(Exports, Compile, St1),
{Mfs,St3} = module_info_funcs(Exports, Compile, St2),
{St3#expand.module,Exports,Ats ++ Tfs ++ Mfs,St3#expand.compile}.
%% -type define_function(Form, State) -> State.
%% Add function to defined if form a function.
define_function({attribute,L,asm,{function,N,A,Code}}, St) ->
St#expand{defined=add_element({N,A}, St#expand.defined)};
define_function({function,L,N,A,Cs}, St) ->
St#expand{defined=add_element({N,A}, St#expand.defined)};
define_function(F, St) -> St.
module_attrs(Exp, Compile, St) ->
{[{attribute,0,Name,Val} || {Name,Val} <- St#expand.attributes],St}.
module_info_funcs(Exp, Compile, St) ->
[{clause,0,[],[], [{nil,0}]}]},
[{clause,0,[{var,0,'_'}],[], [{nil,0}]}]}],
%% forms(Forms, State) ->
%% {TransformedForms,State'}
%% Process the forms. Attributes are lost and just affect the state.
%% Asm things are funny, just pass them through. Ignore uninteresting forms
%% like eof and type.
forms([{attribute,L,asm,{function,N,A,Code}}|Fs0], St0) ->
{Fs,St1} = forms(Fs0, St0),
forms([{attribute,L,Name,Val}|Fs0], St0) ->
St1 = attribute(L, 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),
forms([F|Fs], St) -> forms(Fs, St);
forms([], St) -> {[],St}.
%% -type attribute(Line, Attribute, Value, State) ->
%% State.
%% Process an attribute, this just affects the state.
attribute(L, module, Module, St) ->
attribute(L, export, Es, St) ->
St#expand{exports=union(list_to_set(Es), St#expand.exports)};
attribute(L, import, Is, St) ->
import(L, Is, St);
attribute(L, compile, C, St) when list(C) ->
St#expand{compile=St#expand.compile ++ C};
attribute(L, compile, C, St) ->
St#expand{compile=St#expand.compile ++ [C]};
attribute(L, record, {Name,Defs}, St) ->
St#expand{records=dict:store(Name, normalise_fields(Defs),
attribute(L, file, File, St) -> St; %This is ignored
attribute(L, Name, Val, St) when list(Val) ->
St#expand{attributes=St#expand.attributes ++ [{Name,Val}]};
attribute(L, 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}),
%% -type clauses([Clause], State) ->
%% {[TransformedClause],State}.
%% Expand function clauses.
clauses([{clause,Line,H0,G0,B0}|Cs0], St0) ->
{H,Hvs,St1} = head(H0, St0),
{G,Gvs,Gus,St2} = guard(G0, Hvs, St1),
{B,Bvs,Bus,St3} = exprs(B0, union(Hvs, Gvs), St2),
{Cs,St4} = clauses(Cs0, St3),
clauses([], St) -> {[],St}.
%% head(HeadPatterns, State) ->
%% {TransformedPatterns,Variables,State'}
head(As, St) -> pattern_list(As, St).
%% pattern(Pattern, State) ->
%% {TransformedPattern,Variables,State'}
string_to_conses(Line, Cs, Tail) ->
foldr(fun (C, T) -> {cons,Line,{integer,Line,C},T} end, Tail, Cs).
pattern({var,Line,'_'}, St) -> %Ignore anonymous variable.
pattern({var,Line,V}, St) ->
pattern({integer,Line,I}, St) ->
pattern({float,Line,F}, St) ->
pattern({atom,Line,A}, St) ->
pattern({string,Line,S}, St) ->
pattern({nil,Line}, St) ->
pattern({cons,Line,H,T}, St0) ->
{TH,THvs,St1} = pattern(H, St0),
{TT,TTvs,St2} = pattern(T, St1),
{{cons,Line,TH,TT},union(THvs, TTvs),St2};
pattern({tuple,Line,Ps}, St0) ->
{TPs,TPsvs,St1} = pattern_list(Ps, St0),
%%pattern({struct,Line,Tag,Ps}, St0) ->
%% {TPs,TPsvs,St1} = pattern_list(Ps, St0),
%% {{tuple,Line,[{atom,Line,Tag}|TPs]},TPsvs,St1};
pattern({record_index,Line,Name,Field}, St) ->
{index_expr(Line, Field, Name, record_fields(Name, St)),[],St};
pattern({record,Line,Name,Pfs}, St0) ->
Fs = record_fields(Name, St0),
{TMs,TMsvs,St1} = pattern_list(pattern_fields(Fs, Pfs), St0),
pattern({op,Line,'++',{nil,_},R}, St) ->
pattern(R, St);
pattern({op,Line,'++',{cons,Li,H,T},R}, St) ->
pattern({cons,Li,H,{op,Li,'++',T,R}}, St);
pattern({op,Line,'++',{string,Li,L},R}, St) ->
pattern(string_to_conses(Li, L, R), St);
pattern({match,Line,Pat1, Pat2}, St0) ->
{TH,Hvt,St1} = pattern(Pat2, St0),
{TT,Tvt,St2} = pattern(Pat1, St1),
{{match,Line,TT,TH}, union(Hvt,Tvt), St2};
%% The following are necessary to be able to handle unary +,- in patterns.
pattern({op,Line,'+',{integer,Li,I}}, St) ->
pattern({op,Line,'-',{integer,Li,I}}, St) ->
pattern({op,Line,'+',{float,Lf,F}}, St) ->
pattern({op,Line,'-',{float,Lf,F}}, St) ->
pattern_list([P|Ps], St0) ->
{TP,TPvs,St1} = pattern(P, St0),
{TPs,TPsvs,St2} = pattern_list(Ps, St1),
{[TP|TPs],union(TPvs, TPsvs),St2};
pattern_list([], St) -> {[],[],St}.
%% guard(Guard, VisibleVariables, State) ->
%% {TransformedGuard,NewVariables,UsedVariables,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], Vs, St0) ->
{G,Hvs,Hus,St1} = guard_tests(G0, Vs, St0),
{Gs,Tvs,Tus,St2} = guard(Gs0, Vs, St1),
{[G|Gs],union(Hvs, Tvs),union(Hus, Tus),St2};
guard([], Vs, St) -> {[],[],[],St}.
guard_tests([{op,Line,Op,L0,R0}|Gs0], Vs, St0) ->
{L,Lvs,Lus,St1} = expr(L0, Vs, St0),
{R,Rvs,Rus,St2} = expr(R0, Vs, St1),
{Gs,Gsvs,Gsus,St3} = guard_tests(Gs0, union(Lvs, Rvs), St2),
guard_tests([{call,Line,{atom,Lr,record},[A,{atom,Ln,Name}]}|Gs], Vs, St) ->
Fs = record_fields(Name, St),
{atom,Ln,Name}}|Gs], Vs, St);
guard_tests([{call,Line,Test,As0}|Gs0], Vs, St0) ->
{As,Asvs,Asus,St1} = expr_list(As0, Vs, St0),
{Gs,Gsvs,Gsus,St2} = guard_tests(Gs0, union(Asvs, Vs), St1),
TestF = {remote,Line,{atom,Line,erlang},Test},
{[{call,Line,TestF,As}|Gs],union(Asvs, Gsvs),union(Asus, Gsus),St2};
guard_tests([{atom,Line,true}|Gs], Vs, St) ->
guard_tests(Gs, Vs, St);
guard_tests([], Vs, St) ->
%% exprs(Expressions, VisibleVariables, State) ->
%% {TransformedExprs,NewVariables,UsedVariables,State'}
exprs([E0|Es0], Vs, St0) ->
{E,Evs,Eus,St1} = expr(E0, Vs, St0),
{Es,Esvs,Esus,St2} = exprs(Es0, union(Evs, Vs), St1),
{[E|Es],union(Evs, Esvs),union(Eus, Esus),St2};
exprs([], Vs, St) ->
%% expr(Expression, VisibleVariables, State) ->
%% {TransformedExpression,NewVariables,UsedVariables,State'}
expr({var,Line,V}, Vs, St) ->
expr({integer,Line,I}, Vs, St) ->
expr({float,Line,F}, Vs, St) ->
expr({atom,Line,A}, Vs, St) ->
expr({string,Line,S}, Vs, St) ->
expr({nil,Line}, Vs, St) ->
expr({cons,Line,H0,T0}, Vs, St0) ->
{H,Hvs,Hus,St1} = expr(H0, Vs, St0),
{T,Tvs,Tus,St2} = expr(T0, Vs, St1),
{{cons,Line,H,T},union(Hvs, Tvs),union(Hus, Tus),St2};
expr({lc,Line,E,Qs}, Vs, St) ->
lc_tq(Line, E, Qs, {nil,Line}, Vs, St);
expr({tuple,Line,Es0}, Vs, St0) ->
{Es1,Esvs,Esus,St1} = expr_list(Es0, Vs, St0),
%%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_index,Line,Name,F}, Vs, St) ->
I = index_expr(Line, F, Name, record_fields(Name, St)),
expr(I, Vs, St);
expr({record,Line,Name,Is}, Vs, St) ->
record_inits(record_fields(Name, St), Is)]},
Vs, St);
expr({record_field,Line,R,Name,F}, Vs, St) ->
I = index_expr(Line, F, Name, record_fields(Name, St)),
expr({call,Line,{atom,Line,element},[I,R]}, Vs, St);
expr({record,Line,R,Name,Us}, Vs, St0) ->
{Ue,St1} = record_update(R, Name, record_fields(Name, St0), Us, St0),
expr(Ue, Vs, St1);
expr({block,Line,Es0}, Vs, St0) ->
{Es,Esvs,Esus,St1} = exprs(Es0, Vs, St0),
expr({'if',Line,Cs0}, Vs, St0) ->
{Cs,Csvss,Csuss,St1} = icr_clauses(Cs0, Vs, St0),
{All,Some} = new_in(Vs, Csvss),
expr({'case',Line,E0,Cs0}, Vs, St0) ->
{E,Evs,Eus,St1} = expr(E0, Vs, St0),
{Cs,Csvss,Csuss,St2} = icr_clauses(Cs0, union(Evs, Vs), St1),
{All,Some} = new_in(Vs, Csvss),
{{'case',Line,E,Cs},union(Evs, All),union([Eus|Csuss]),St2};
expr({'receive',Line,Cs0}, Vs, St0) ->
{Cs,Csvss,Csuss,St1} = icr_clauses(Cs0, Vs, St0),
{All,Some} = new_in(Vs, Csvss),
expr({'receive',Line,Cs0,To0,ToEs0}, Vs, St0) ->
{To,Tovs,Tous,St1} = expr(To0, Vs, St0),
{ToEs,ToEsvs,ToEsus,St2} = exprs(ToEs0, Vs, St1),
{Cs,Csvss,Csuss,St3} = icr_clauses(Cs0, Vs, St2),
{All,Some} = new_in(Vs, [ToEsvs|Csvss]),
{{'receive',Line,Cs,To,ToEs},union(Tovs, All),union([Tous|Csuss]),St3};
expr({'fun',Line,Body}, Vs, St) ->
fun_tq(Line, Body, Vs, St);
expr({call,Line,{atom,La,apply},As0}, Vs, St0) when length(As0) == 2 ->
{As,Asvs,Asus,St1} = expr_list(As0, Vs, St0),
expr({call,Line,{atom,La,record_info},[{atom,Li,Info},{atom,Ln,Name}]}, Vs, St) ->
case Info of
size -> {{integer,Line,1+length(record_fields(Name, St))},[],[],St};
fields -> {make_list(field_names(record_fields(Name, St)), Line),
expr({call,Line,{atom,La,N},As0}, Vs, St0) ->
{As,Asvs,Asus,St1} = expr_list(As0, Vs, St0),
Ar = length(As),
case erl_internal:bif(N, Ar) of
true ->
false ->
case imported(N, Ar, St1) of
{yes,Mod} ->
no ->
expr({call,Line,{remote,Lr,{atom,Lm,M},{atom,Lf,F}},As0}, Vs, St0) ->
{As1,Asvs,Asus,St1} = expr_list(As0, Vs, St0),
expr({call,Line,{remote,Lr,M,F},As}, Vs, St) ->
expr({call,Line,{atom,Line,apply},[M,F,make_list(As, Line)]}, Vs, St);
expr({call,Line,F,As0}, Vs, St0) ->
{[Fun1|As1],Asvs,Asus,St1} = expr_list([F|As0], Vs, St0),
expr({'catch',Line,E0}, Vs, St0) ->
%% Catch exports no new variables.
{E,Evs,Eus,St1} = expr(E0, Vs, St0),
expr({match,Line,P0,E0}, Vs, St0) ->
{E,Evs,Eus,St1} = expr(E0, Vs, St0),
{P,Pvs,St2} = pattern(P0, St1),
union(subtract(Pvs, Vs), Evs),
union(intersection(Pvs, Vs), Eus),St2};
expr({op,Line,'++',{lc,Ll,E,Qs},L2}, Vs, St) ->
lc_tq(Ll, E, Qs, L2, Vs, St);
expr({op,Ll,'++',{string,L1,S1},{string,L2,S2}}, Vs, St) ->
{{string,L1,S1 ++ S2},[],[],St};
expr({op,Ll,'++',{string,L1,S1},R0}, Vs, St0) ->
{R1,Rvs,Rus,St1} = expr(R0, Vs, St0),
E = case R1 of
{string,L2,S2} -> {string,L1,S1 ++ S2};
Other -> string_to_conses(L1, S1, R1)
expr({op,Ll,'++',{cons,Lc,H,T},L2}, Vs, St) ->
expr({cons,Ll,H,{op,Lc,'++',T,L2}}, Vs, St);
expr({op,Ll,'++',{nil,Ln},L2}, Vs, St) ->
expr(L2, Vs, St);
expr({op,Line,Op,A0}, Vs, St0) ->
{A,Avs,Aus,St1} = expr(A0, Vs, St0),
expr({op,Line,Op,L0,R0}, Vs, St0) ->
{L,Lvs,Lus,St1} = expr(L0, Vs, St0),
{R,Rvs,Rus,St2} = expr(R0, Vs, St1),
{{op,Line,Op,L,R},union(Lvs, Rvs),union(Lus, Rus),St2}.
expr_list([E0|Es0], Vs, St0) ->
{E,Evs,Eus,St1} = expr(E0, Vs, St0),
{Es,Esvs,Esus,St2} = expr_list(Es0, Vs, St1),
{[E|Es],union(Evs, Esvs),union(Eus, Esus),St2};
expr_list([], Vs, St) ->
%% icr_clauses([Clause], [VisibleVariable], State) ->
%% {[TransformedClause],[[NewVariable]],[[UsedVariable]],State'}
%% Be very careful here to return the variables that are really used
%% and really new.
icr_clauses([{clause,Line,H0,G0,B0}|Cs0], Vs, St0) ->
{H,Hvs,St1} = head(H0, St0), %Hvs is really used!
{G,Gvs,Gus,St2} = guard(G0, union(Hvs, Vs), St1),
{B,Bvs,Bus,St3} = exprs(B0, union([Vs,Hvs,Gvs]), St2),
New = subtract(union([Hvs,Gvs,Bvs]), Vs), %Really new
Used = intersection(union([Hvs,Gus,Bus]), Vs), %Really used
{Cs,Csvs,Csus,St4} = icr_clauses(Cs0, Vs, St3),
icr_clauses([], Vs, St) ->
%% lc_tq(Line, Expr, Qualifiers, More, [VisibleVar], State) ->
%% {ListComp,[NewVar],[UsedVar],State'}
%% This TQ from Simon PJ pp 127-138. No need to call ourselves
%% recursively on append as this is special cased in expr as an
%% optimisation. As Erlang doesn't have letrec's we explicitly pass
%% the lambda as an extra argument to be able to do the recursive
%% call. We also do the argument matching in the head of the lambda
%% instead of in a 'case' so as to automatically get the correct
%% shadowing.
lc_tq(Line, E, Qs, More, Vs, St0) ->
{Lc,St1} = lc_tq(Line, E, Qs, More, St0),
expr(Lc, Vs, St1).
lc_tq(Line, E, [{generate,Lg,P,G}|Qs], More, St0) ->
{Fun,St1} = new_var(Lg, St0),
{Tail,St2} = new_var(Lg, St1),
NewMore = {call,Lg,Fun,[Tail,Fun]},
{Lc,St3} = lc_tq(Line, E, Qs, NewMore, St2),
lc_tq(Line, E, [F|Qs], More, St0) ->
Lf = element(2, F),
{Lc,St1} = lc_tq(Line, E, Qs, More, St0),
case erl_lint:is_guard_test(F) of
true ->
false ->
case F of
{op,_,'not',F1} -> %Get rid of not operator.
Other ->
lc_tq(Line, E, [], More, St) ->
%% fun_tq(Line, Body, VisibleVariables, State) ->
%% {Fun,NewVariables,UsedVariables,State'}
%% Transform a fun into into a tuple {'fun',Mod,I,Uniq,Free} and add
%% clauses to module_lambdas/4 to hold the code. Process the body
%% sequence directly to get the new and used variables, this also
%% allows recursives call for the function case to correctly handle
%% BIFs. N.B. erl_lint disallows imports so we don't have to check.
fun_tq(Lf, {function,F,A}, Vs, St0) ->
%% Core {{'fun',Lf,{function,F,A}},[],[],St0}
{As,St1} = new_vars(A, Lf, St0),
fun_tq(Lf, {clauses,[{clause,Lf,As,[],[{call,Lf,{atom,Lf,F},As}]}]},
Vs, St1);
fun_tq(Lf, {clauses,Cs0}, Vs, St0) ->
Uniq = erlang:hash(Cs0, (1 bsl 27)-1),
%% The added clauses are transformed directly to get
%% new/used vars. The line number hack is to get the same
%% indentifier in both cases. This SUCKS!
{Cs1,Hvss,Frees,St1} = fun_clauses(Cs0, Vs, St0),
Ufrees = union(Frees),
Free = intersection(Ufrees, Vs),
fun_clauses([{clause,L,H0,G0,B0}|Cs0], Vs, St0) ->
{H,Hvs,St1} = head(H0, St0),
{G,Gvs,Gus,St2} = guard(G0, union(Hvs, Vs), St1),
{B,Bvs,Bus,St3} = exprs(B0, union([Vs,Hvs,Gvs]), St2),
%% Free variables cannot be new anywhere in the clause.
Free = subtract(union(Gus, Bus), union([Hvs,Gvs,Bvs])),
%%io:format(" Gus :~p~n Bvs :~p~n Bus :~p~n Free:~p~n" ,[Gus,Bvs,Bus,Free]),
{Cs,Hvss,Frees,St4} = fun_clauses(Cs0, Vs, St3),
fun_clauses([], Vs, St) -> {[],[],[],St}.
%% normalise_fields([RecDef]) -> [Field].
%% Normalise the field definitions to always have a default value. If
%% none has been given then use 'undefined'.
normalise_fields(Fs) ->
map(fun ({record_field,Lf,Field}) ->
(F) -> F end, Fs).
%% record_fields(RecordName, State)
%% find_field(FieldName, Fields)
record_fields(R, St) -> dict:fetch(R, St#expand.records).
find_field(F, [{record_field,Lf,{atom,La,F},Val}|Fs]) -> {ok,Val};
find_field(F, [_|Fs]) -> find_field(F, Fs);
find_field(F, []) -> error.
%% field_names(RecFields) -> [Name].
%% Return a list of the field names structures.
field_names(Fs) ->
map(fun ({record_field,Lf,Field,Val}) -> Field end, Fs).
%% index_expr(Line, FieldExpr, Name, Fields) -> IndexExpr.
%% Return an expression which evaluates to the index of a
%% field. Currently only handle the case where the field is an
%% atom. This expansion must be passed through expr again.
index_expr(Line, {atom,La,F}, Name, Fs) ->
{integer,Line,index_expr(F, Fs, 2)}.
index_expr(F, [{record_field,Lf,{atom,La,F},Val}|Fs], I) -> I;
index_expr(F, [_|Fs], I) ->
index_expr(F, Fs, I+1).
%% pattern_fields([RecDefField], [Match]) -> [Pattern].
%% Build a list of match patterns for the record tuple elements.
%% This expansion must be passed through pattern again. N.B. We are
%% scanning the record definition field list!
pattern_fields(Fs, Ms) ->
map(fun ({record_field,L,{atom,La,F},D}) ->
case find_field(F, Ms) of
{ok,Match} -> Match;
error -> {var,L,'_'}
end end,
%% record_inits([RecDefField], [Init]) -> [InitExpr].
%% Build a list of initialisation expressions for the record tuple
%% elements. This expansion must be passed through expr
%% again. N.B. We are scanning the record definition field list!
record_inits(Fs, Is) ->
map(fun ({record_field,L,{atom,La,F},D}) ->
case find_field(F, Is) of
{ok,Init} -> Init;
error -> D
end end,
%% record_update(Record, RecordName, [RecDefField], [Update], State) ->
%% {Expr,State'}
%% Build an expression to update fields in a record returning a new
%% record. Try to be smart and optimise this. This expansion must be
%% passed through expr again.
record_update(R, Name, Fs, Us, St) ->
Nf = length(Fs), %# of record fields
Nu = length(Us), %# of update fields
Nc = Nf - Nu, %# of copy fields
%% Try to be intelligent about which method of updating record to use.
Nu == 0 ->
{record_el(R, Name, Fs, Us),St};
Nu == 1 ->
{record_setel(R, Name, Fs, Us),St};
Nc == 1 ->
{record_el(R, Name, Fs, Us),St};
true ->
record_match(R, Name, Fs, Us, St)
%% record_match(Record, RecordName, [RecDefField], [Update], State)
%% Build a 'case' expression to modify record fields.
record_match(R, Name, Fs, Us, St0) ->
{Ps,News,St1} = record_upd_fs(Fs, Us, St0),
Lr = element(2, hd(Us)),
[call_fault(Lr, {tuple,Lr,[{atom,Lr,badrecord},{atom,Lr,Name}]})]}
record_upd_fs([{record_field,Lf,{atom,La,F},Val}|Fs], Us, St0) ->
case find_field(F, Us) of
{ok,New} ->
{Ps,News,St1} = record_upd_fs(Fs, Us, St0),
error ->
{P,St1} = new_var(Lf, St0),
{Ps,News,St2} = record_upd_fs(Fs, Us, St1),
record_upd_fs([], Us, St) -> {[],[],St}.
%% record_el(Record, RecordName, [RecDefField], [Update])
%% Build a new record using Rec#name.field expression for unchanged
%% values.
record_el(R, Name, Fs, []) ->
record_el1(R, Name, Fs, [], element(2, R));
record_el(R, Name, Fs, Us) ->
record_el1(R, Name, Fs, Us, element(2, hd(Us))).
record_el1(R, Name, Fs, Us, Lr) ->
map(fun (F) -> record_el2(R, Name, F, Us) end, Fs)]}.
record_el2(R, Name, {record_field,Lf,{atom,La,F},Val}, Us) ->
case find_field(F, Us) of
{ok,New} -> New;
error -> {record_field,Lf,R,Name,{atom,La,F}}
%% record_setel(Record, RecordName, [RecDefField], [Update])
%% Build a nested chain of setelement calls to build updated record tuple.
record_setel(R, Name, Fs, Us) ->
foldr(fun ({record_field,Lf,Field,Val}, Acc) ->
I = index_expr(Lf, Field, Name, Fs),
{call,Lf,{atom,Lf,setelement},[I,Acc,Val]} end,
R, Us).
%% new_var_name(State) -> {VarName,State}.
new_var_name(St) ->
C = St#expand.vcount,
{list_to_atom("%" ++ 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),
%% 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}.
%% make_list(TermList, Line) -> ConsTerm.
make_list(Ts, Line) ->
foldr(fun (H, T) -> {cons,Line,H,T} end, {nil,Line}, Ts).
%% call_fault(Line, Reason) -> Expr.
%% Build a call to erlang:fault/1 with reason Reason.
call_fault(L, R) ->
%% new_in(Before, RegionList) ->
%% {NewInAll,NewInSome}
%% Return the variables new in all clauses and those new in some clauses.
new_in(Before, Region) ->
InAll = intersection(Region),
InSome = union(Region),
NewInAll = subtract(InAll, Before),
NewInSome = subtract(subtract(InSome, Before), NewInAll),
%% For storing the import list we use our own version of the module dict.
%% This is/was the same as the original but we must be sure of the format
%% (sorted list of pairs) so we can do ordset operations on them (see the
%% the function eof/2. We know an empty set is [].
%% import(Line, Imports, State) ->
%% State'
%% imported(Name, Arity, State) ->
%% {yes,Module} | no
%% Handle import declarations and est for imported functions. No need to
%% check when building imports as code is correct.
import(Line, {Mod,Fs}, St) ->
Mfs = list_to_set(Fs),
St#expand{imports=add_imports(Mod, Mfs, St#expand.imports)}.
add_imports(Mod, [F|Fs], Is) ->
add_imports(Mod, Fs, store(F, Mod, Is));
add_imports(Mod, [], Is) ->
imported(F, A, St) ->
case find({F,A}, St#expand.imports) of
{ok,Mod} -> {yes,Mod};
error -> no
%% This is our own version of the module dict which is/was the same as
%% the original but we must be sure of the format (sorted list of pairs)
%% so we can do ordset operations on them. We know an empty set is [].
%% find(Key, Dictionary) -> {ok,Value} | error
find(Key, [{K,Value}|D]) when Key > K -> find(Key, D);
find(Key, [{K,Value}|_]) when Key == K -> {ok,Value};
find(Key, [{K,Value}|_]) when Key < K -> error;
find(Key, []) -> error.
%% store(Key, Value, Dictionary) -> Dictionary.
store(Key, New, [{K,_}=Old|Dict]) when Key > K ->
[Old|store(Key, New, Dict)];
store(Key, New, [{K,Old}|Dict]) when Key == K ->
store(Key, New, [{K,_}=Old|Dict]) when Key < K ->
store(Key, New, []) -> [{Key,New}].
Jump to Line
Something went wrong with that request. Please try again.