diff options
Diffstat (limited to 'lib/dialyzer/test/options1_tests_SUITE_data/src/compiler')
36 files changed, 0 insertions, 30142 deletions
diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_asm.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_asm.erl deleted file mode 100644 index c2d9edcaa7..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_asm.erl +++ /dev/null @@ -1,358 +0,0 @@ -%% ``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 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. -%% -%% 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: beam_asm.erl,v 1.1 2008/12/17 09:53:40 mikpe Exp $ -%% -%% Purpose : Assembler for threaded Beam. - --module(beam_asm). - --export([module/4,format_error/1]). --export([encode/2]). - --import(lists, [map/2,member/2,keymember/3,duplicate/2]). --include("beam_opcodes.hrl"). - --define(bs_aligned, 1). - -module(Code, Abst, SourceFile, Opts) -> - case assemble(Code, Abst, SourceFile, Opts) of - {error, Error} -> - {error, [{none, ?MODULE, Error}]}; - Bin when binary(Bin) -> - {ok, Bin} - end. - -format_error({crashed, Why}) -> - io_lib:format("beam_asm_int: EXIT: ~p", [Why]). - -assemble({Mod,Exp,Attr,Asm,NumLabels}, Abst, SourceFile, Opts) -> - {1,Dict0} = beam_dict:atom(Mod, beam_dict:new()), - NumFuncs = length(Asm), - {Code,Dict1} = assemble_1(Asm, Exp, Dict0, []), - build_file(Code, Attr, Dict1, NumLabels, NumFuncs, Abst, SourceFile, Opts). - -assemble_1([{function,Name,Arity,Entry,Asm}|T], Exp, Dict0, Acc) -> - Dict1 = case member({Name,Arity}, Exp) of - true -> - beam_dict:export(Name, Arity, Entry, Dict0); - false -> - beam_dict:local(Name, Arity, Entry, Dict0) - end, - {Code, Dict2} = assemble_function(Asm, Acc, Dict1), - assemble_1(T, Exp, Dict2, Code); -assemble_1([], _Exp, Dict0, Acc) -> - {IntCodeEnd,Dict1} = make_op(int_code_end, Dict0), - {list_to_binary(lists:reverse(Acc, [IntCodeEnd])),Dict1}. - -assemble_function([H|T], Acc, Dict0) -> - {Code, Dict} = make_op(H, Dict0), - assemble_function(T, [Code| Acc], Dict); -assemble_function([], Code, Dict) -> - {Code, Dict}. - -build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) -> - %% Create the code chunk. - - CodeChunk = chunk(<<"Code">>, - <<16:32, - (beam_opcodes:format_number()):32, - (beam_dict:highest_opcode(Dict)):32, - NumLabels:32, - NumFuncs:32>>, - Code), - - %% Create the atom table chunk. - - {NumAtoms, AtomTab} = beam_dict:atom_table(Dict), - AtomChunk = chunk(<<"Atom">>, <<NumAtoms:32>>, AtomTab), - - %% Create the import table chunk. - - {NumImps, ImpTab0} = beam_dict:import_table(Dict), - Imp = flatten_imports(ImpTab0), - ImportChunk = chunk(<<"ImpT">>, <<NumImps:32>>, Imp), - - %% Create the export table chunk. - - {NumExps, ExpTab0} = beam_dict:export_table(Dict), - Exp = flatten_exports(ExpTab0), - ExpChunk = chunk(<<"ExpT">>, <<NumExps:32>>, Exp), - - %% Create the local function table chunk. - - {NumLocals, Locals} = beam_dict:local_table(Dict), - Loc = flatten_exports(Locals), - LocChunk = chunk(<<"LocT">>, <<NumLocals:32>>, Loc), - - %% Create the string table chunk. - - {_,StringTab} = beam_dict:string_table(Dict), - StringChunk = chunk(<<"StrT">>, StringTab), - - %% Create the fun table chunk. It is important not to build an empty chunk, - %% as that would change the MD5. - - LambdaChunk = case beam_dict:lambda_table(Dict) of - {0,[]} -> []; - {NumLambdas,LambdaTab} -> - chunk(<<"FunT">>, <<NumLambdas:32>>, LambdaTab) - end, - - %% Create the attributes and compile info chunks. - - Essentials = [AtomChunk,CodeChunk,StringChunk,ImportChunk,ExpChunk,LambdaChunk], - {Attributes,Compile} = build_attributes(Opts, SourceFile, Attr, Essentials), - AttrChunk = chunk(<<"Attr">>, Attributes), - CompileChunk = chunk(<<"CInf">>, Compile), - - %% Create the abstract code chunk. - - AbstChunk = chunk(<<"Abst">>, Abst), - - %% Create IFF chunk. - - Chunks = case member(slim, Opts) of - true -> [Essentials,AttrChunk,CompileChunk,AbstChunk]; - false -> [Essentials,LocChunk,AttrChunk,CompileChunk,AbstChunk] - end, - build_form(<<"BEAM">>, Chunks). - -%% Build an IFF form. - -build_form(Id, Chunks0) when size(Id) == 4, list(Chunks0) -> - Chunks = list_to_binary(Chunks0), - Size = size(Chunks), - 0 = Size rem 4, % Assertion: correct padding? - <<"FOR1",(Size+4):32,Id/binary,Chunks/binary>>. - -%% Build a correctly padded chunk (with no sub-header). - -chunk(Id, Contents) when size(Id) == 4, binary(Contents) -> - Size = size(Contents), - [<<Id/binary,Size:32>>,Contents|pad(Size)]; -chunk(Id, Contents) when list(Contents) -> - chunk(Id, list_to_binary(Contents)). - -%% Build a correctly padded chunk (with a sub-header). - -chunk(Id, Head, Contents) when size(Id) == 4, is_binary(Head), is_binary(Contents) -> - Size = size(Head)+size(Contents), - [<<Id/binary,Size:32,Head/binary>>,Contents|pad(Size)]; -chunk(Id, Head, Contents) when list(Contents) -> - chunk(Id, Head, list_to_binary(Contents)). - -pad(Size) -> - case Size rem 4 of - 0 -> []; - Rem -> duplicate(4 - Rem, 0) - end. - -flatten_exports(Exps) -> - list_to_binary(map(fun({F,A,L}) -> <<F:32,A:32,L:32>> end, Exps)). - -flatten_imports(Imps) -> - list_to_binary(map(fun({M,F,A}) -> <<M:32,F:32,A:32>> end, Imps)). - -build_attributes(Opts, SourceFile, Attr, Essentials) -> - Misc = case member(slim, Opts) of - false -> - {{Y,Mo,D},{H,Mi,S}} = erlang:universaltime(), - [{time,{Y,Mo,D,H,Mi,S}},{source,SourceFile}]; - true -> [] - end, - Compile = [{options,Opts},{version,?COMPILER_VSN}|Misc], - {term_to_binary(calc_vsn(Attr, Essentials)),term_to_binary(Compile)}. - -%% -%% If the attributes contains no 'vsn' attribute, we'll insert one -%% with an MD5 "checksum" calculated on the code as its value. -%% We'll not change an existing 'vsn' attribute. -%% - -calc_vsn(Attr, Essentials) -> - case keymember(vsn, 1, Attr) of - true -> Attr; - false -> - <<Number:128>> = erlang:md5(Essentials), - [{vsn,[Number]}|Attr] - end. - -bif_type('-', 1) -> negate; -bif_type('+', 2) -> {op, m_plus}; -bif_type('-', 2) -> {op, m_minus}; -bif_type('*', 2) -> {op, m_times}; -bif_type('/', 2) -> {op, m_div}; -bif_type('div', 2) -> {op, int_div}; -bif_type('rem', 2) -> {op, int_rem}; -bif_type('band', 2) -> {op, int_band}; -bif_type('bor', 2) -> {op, int_bor}; -bif_type('bxor', 2) -> {op, int_bxor}; -bif_type('bsl', 2) -> {op, int_bsl}; -bif_type('bsr', 2) -> {op, int_bsr}; -bif_type('bnot', 1) -> {op, int_bnot}; -bif_type(fnegate, 1) -> {op, fnegate}; -bif_type(fadd, 2) -> {op, fadd}; -bif_type(fsub, 2) -> {op, fsub}; -bif_type(fmul, 2) -> {op, fmul}; -bif_type(fdiv, 2) -> {op, fdiv}; -bif_type(_, _) -> bif. - -make_op(Comment, Dict) when element(1, Comment) == '%' -> - {[],Dict}; -make_op({'%live',_R}, Dict) -> - {[],Dict}; -make_op({bif, Bif, nofail, [], Dest}, Dict) -> - encode_op(bif0, [{extfunc, erlang, Bif, 0}, Dest], Dict); -make_op({bif, raise, _Fail, [A1,A2], _Dest}, Dict) -> - encode_op(raise, [A1,A2], Dict); -make_op({bif, Bif, Fail, Args, Dest}, Dict) -> - Arity = length(Args), - case bif_type(Bif, Arity) of - {op, Op} -> - make_op(list_to_tuple([Op, Fail|Args++[Dest]]), Dict); - negate -> - %% Fake negation operator. - make_op({m_minus, Fail, {integer,0}, hd(Args), Dest}, Dict); - bif -> - BifOp = list_to_atom(lists:concat([bif, Arity])), - encode_op(BifOp, [Fail, {extfunc, erlang, Bif, Arity}|Args++[Dest]], - Dict) - end; -make_op({bs_add=Op,Fail,[Src1,Src2,Unit],Dest}, Dict) -> - encode_op(Op, [Fail,Src1,Src2,Unit,Dest], Dict); -make_op({test,Cond,Fail,Ops}, Dict) when list(Ops) -> - encode_op(Cond, [Fail|Ops], Dict); -make_op({make_fun2,{f,Lbl},Index,OldUniq,NumFree}, Dict0) -> - {Fun,Dict} = beam_dict:lambda(Lbl, Index, OldUniq, NumFree, Dict0), - make_op({make_fun2,Fun}, Dict); -make_op(Op, Dict) when atom(Op) -> - encode_op(Op, [], Dict); -make_op({kill,Y}, Dict) -> - make_op({init,Y}, Dict); -make_op({Name,Arg1}, Dict) -> - encode_op(Name, [Arg1], Dict); -make_op({Name,Arg1,Arg2}, Dict) -> - encode_op(Name, [Arg1,Arg2], Dict); -make_op({Name,Arg1,Arg2,Arg3}, Dict) -> - encode_op(Name, [Arg1,Arg2,Arg3], Dict); -make_op({Name,Arg1,Arg2,Arg3,Arg4}, Dict) -> - encode_op(Name, [Arg1,Arg2,Arg3,Arg4], Dict); -make_op({Name,Arg1,Arg2,Arg3,Arg4,Arg5}, Dict) -> - encode_op(Name, [Arg1,Arg2,Arg3,Arg4,Arg5], Dict); -make_op({Name,Arg1,Arg2,Arg3,Arg4,Arg5,Arg6}, Dict) -> - encode_op(Name, [Arg1,Arg2,Arg3,Arg4,Arg5,Arg6], Dict). - -encode_op(Name, Args, Dict0) when atom(Name) -> - {EncArgs,Dict1} = encode_args(Args, Dict0), - Op = beam_opcodes:opcode(Name, length(Args)), - Dict2 = beam_dict:opcode(Op, Dict1), - {list_to_binary([Op|EncArgs]),Dict2}. - -encode_args([Arg| T], Dict0) -> - {EncArg, Dict1} = encode_arg(Arg, Dict0), - {EncTail, Dict2} = encode_args(T, Dict1), - {[EncArg| EncTail], Dict2}; -encode_args([], Dict) -> - {[], Dict}. - -encode_arg({x, X}, Dict) when X >= 0 -> - {encode(?tag_x, X), Dict}; -encode_arg({y, Y}, Dict) when Y >= 0 -> - {encode(?tag_y, Y), Dict}; -encode_arg({atom, Atom}, Dict0) when atom(Atom) -> - {Index, Dict} = beam_dict:atom(Atom, Dict0), - {encode(?tag_a, Index), Dict}; -encode_arg({integer, N}, Dict) -> - {encode(?tag_i, N), Dict}; -encode_arg(nil, Dict) -> - {encode(?tag_a, 0), Dict}; -encode_arg({f, W}, Dict) -> - {encode(?tag_f, W), Dict}; -encode_arg({'char', C}, Dict) -> - {encode(?tag_h, C), Dict}; -encode_arg({string, String}, Dict0) -> - {Offset, Dict} = beam_dict:string(String, Dict0), - {encode(?tag_u, Offset), Dict}; -encode_arg({extfunc, M, F, A}, Dict0) -> - {Index, Dict} = beam_dict:import(M, F, A, Dict0), - {encode(?tag_u, Index), Dict}; -encode_arg({list, List}, Dict0) -> - {L, Dict} = encode_list(List, Dict0, []), - {[encode(?tag_z, 1), encode(?tag_u, length(List))|L], Dict}; -encode_arg({float, Float}, Dict) when float(Float) -> - {[encode(?tag_z, 0)|<<Float:64/float>>], Dict}; -encode_arg({fr,Fr}, Dict) -> - {[encode(?tag_z, 2),encode(?tag_u,Fr)], Dict}; -encode_arg({field_flags,Flags0}, Dict) -> - Flags = lists:foldl(fun (F, S) -> S bor flag_to_bit(F) end, 0, Flags0), - {encode(?tag_u, Flags), Dict}; -encode_arg({alloc,List}, Dict) -> - {encode_alloc_list(List),Dict}; -encode_arg(Int, Dict) when is_integer(Int) -> - {encode(?tag_u, Int),Dict}. - -flag_to_bit(aligned) -> 16#01; -flag_to_bit(little) -> 16#02; -flag_to_bit(big) -> 16#00; -flag_to_bit(signed) -> 16#04; -flag_to_bit(unsigned)-> 16#00; -flag_to_bit(exact) -> 16#08; -flag_to_bit(native) -> 16#10. - -encode_list([H|T], _Dict, _Acc) when is_list(H) -> - exit({illegal_nested_list,encode_arg,[H|T]}); -encode_list([H|T], Dict0, Acc) -> - {Enc,Dict} = encode_arg(H, Dict0), - encode_list(T, Dict, [Enc|Acc]); -encode_list([], Dict, Acc) -> - {lists:reverse(Acc), Dict}. - -encode_alloc_list(L0) -> - L = encode_alloc_list_1(L0), - [encode(?tag_z, 3),encode(?tag_u, length(L0))|L]. - -encode_alloc_list_1([{words,Words}|T]) -> - [encode(?tag_u, 0),encode(?tag_u, Words)|encode_alloc_list_1(T)]; -encode_alloc_list_1([{floats,Floats}|T]) -> - [encode(?tag_u, 1),encode(?tag_u, Floats)|encode_alloc_list_1(T)]; -encode_alloc_list_1([]) -> []. - -encode(Tag, N) when N < 0 -> - encode1(Tag, negative_to_bytes(N, [])); -encode(Tag, N) when N < 16 -> - (N bsl 4) bor Tag; -encode(Tag, N) when N < 16#800 -> - [((N bsr 3) band 2#11100000) bor Tag bor 2#00001000, N band 16#ff]; -encode(Tag, N) -> - encode1(Tag, to_bytes(N, [])). - -encode1(Tag, Bytes) -> - case length(Bytes) of - Num when 2 =< Num, Num =< 8 -> - [((Num-2) bsl 5) bor 2#00011000 bor Tag| Bytes]; - Num when 8 < Num -> - [2#11111000 bor Tag, encode(?tag_u, Num-9)| Bytes] - end. - -to_bytes(0, [B|Acc]) when B < 128 -> - [B|Acc]; -to_bytes(N, Acc) -> - to_bytes(N bsr 8, [N band 16#ff| Acc]). - -negative_to_bytes(-1, [B1, B2|T]) when B1 > 127 -> - [B1, B2|T]; -negative_to_bytes(N, Acc) -> - negative_to_bytes(N bsr 8, [N band 16#ff|Acc]). diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_block.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_block.erl deleted file mode 100644 index b0dd3e6380..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_block.erl +++ /dev/null @@ -1,601 +0,0 @@ -%% ``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 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. -%% -%% 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: beam_block.erl,v 1.1 2008/12/17 09:53:41 mikpe Exp $ -%% -%% Purpose : Partitions assembly instructions into basic blocks and -%% optimizes them. - --module(beam_block). - --export([module/2]). --export([live_at_entry/1]). %Used by beam_type, beam_bool. --export([is_killed/2]). %Used by beam_dead, beam_type, beam_bool. --export([is_not_used/2]). %Used by beam_bool. --export([merge_blocks/2]). %Used by beam_jump. --import(lists, [map/2,mapfoldr/3,reverse/1,reverse/2,foldl/3, - member/2,sort/1,all/2]). --define(MAXREG, 1024). - -module({Mod,Exp,Attr,Fs,Lc}, _Opt) -> - {ok,{Mod,Exp,Attr,map(fun function/1, Fs),Lc}}. - -function({function,Name,Arity,CLabel,Is0}) -> - %% Collect basic blocks and optimize them. - Is = blockify(Is0), - - %% Done. - {function,Name,Arity,CLabel,Is}. - -%% blockify(Instructions0) -> Instructions -%% Collect sequences of instructions to basic blocks and -%% optimize the contents of the blocks. Also do some simple -%% optimations on instructions outside the blocks. - -blockify(Is) -> - blockify(Is, []). - -blockify([{loop_rec,{f,Fail},{x,0}},{loop_rec_end,_Lbl},{label,Fail}|Is], Acc) -> - %% Useless instruction sequence. - blockify(Is, Acc); -blockify([{test,bs_test_tail,F,[Bits]}|Is], - [{test,bs_skip_bits,F,[{integer,I},Unit,_Flags]}|Acc]) -> - blockify(Is, [{test,bs_test_tail,F,[Bits+I*Unit]}|Acc]); -blockify([{test,bs_skip_bits,F,[{integer,I1},Unit1,_]}|Is], - [{test,bs_skip_bits,F,[{integer,I2},Unit2,Flags]}|Acc]) -> - blockify(Is, [{test,bs_skip_bits,F, - [{integer,I1*Unit1+I2*Unit2},1,Flags]}|Acc]); -blockify([{test,is_atom,{f,Fail},[Reg]}=I| - [{select_val,Reg,{f,Fail}, - {list,[{atom,false},{f,_}=BrFalse, - {atom,true}=AtomTrue,{f,_}=BrTrue]}}|Is]=Is0], - [{block,Bl}|_]=Acc) -> - case is_last_bool(Bl, Reg) of - false -> - blockify(Is0, [I|Acc]); - true -> - blockify(Is, [{jump,BrTrue}, - {test,is_eq_exact,BrFalse,[Reg,AtomTrue]}|Acc]) - end; -blockify([{test,is_atom,{f,Fail},[Reg]}=I| - [{select_val,Reg,{f,Fail}, - {list,[{atom,true}=AtomTrue,{f,_}=BrTrue, - {atom,false},{f,_}=BrFalse]}}|Is]=Is0], - [{block,Bl}|_]=Acc) -> - case is_last_bool(Bl, Reg) of - false -> - blockify(Is0, [I|Acc]); - true -> - blockify(Is, [{jump,BrTrue}, - {test,is_eq_exact,BrFalse,[Reg,AtomTrue]}|Acc]) - end; -blockify([I|Is0]=IsAll, Acc) -> - case is_bs_put(I) of - true -> - {BsPuts0,Is} = collect_bs_puts(IsAll), - BsPuts = opt_bs_puts(BsPuts0), - blockify(Is, reverse(BsPuts, Acc)); - false -> - case collect(I) of - error -> blockify(Is0, [I|Acc]); - Instr when is_tuple(Instr) -> - {Block0,Is} = collect_block(IsAll), - Block = opt_block(Block0), - blockify(Is, [{block,Block}|Acc]) - end - end; -blockify([], Acc) -> reverse(Acc). - -is_last_bool([I,{'%live',_}], Reg) -> - is_last_bool([I], Reg); -is_last_bool([{set,[Reg],As,{bif,N,_}}], Reg) -> - Ar = length(As), - erl_internal:new_type_test(N, Ar) orelse erl_internal:comp_op(N, Ar) - orelse erl_internal:bool_op(N, Ar); -is_last_bool([_|Is], Reg) -> is_last_bool(Is, Reg); -is_last_bool([], _) -> false. - -collect_block(Is) -> - collect_block(Is, []). - -collect_block([{allocate_zero,Ns,R},{test_heap,Nh,R}|Is], Acc) -> - collect_block(Is, [{allocate,R,{no_opt,Ns,Nh,[]}}|Acc]); -collect_block([I|Is]=Is0, Acc) -> - case collect(I) of - error -> {reverse(Acc),Is0}; - Instr -> collect_block(Is, [Instr|Acc]) - end; -collect_block([], Acc) -> {reverse(Acc),[]}. - -collect({allocate_zero,N,R}) -> {allocate,R,{zero,N,0,[]}}; -collect({test_heap,N,R}) -> {allocate,R,{nozero,nostack,N,[]}}; -collect({bif,N,nofail,As,D}) -> {set,[D],As,{bif,N}}; -collect({bif,N,F,As,D}) -> {set,[D],As,{bif,N,F}}; -collect({move,S,D}) -> {set,[D],[S],move}; -collect({put_list,S1,S2,D}) -> {set,[D],[S1,S2],put_list}; -collect({put_tuple,A,D}) -> {set,[D],[],{put_tuple,A}}; -collect({put,S}) -> {set,[],[S],put}; -collect({put_string,L,S,D}) -> {set,[D],[],{put_string,L,S}}; -collect({get_tuple_element,S,I,D}) -> {set,[D],[S],{get_tuple_element,I}}; -collect({set_tuple_element,S,D,I}) -> {set,[],[S,D],{set_tuple_element,I}}; -collect({get_list,S,D1,D2}) -> {set,[D1,D2],[S],get_list}; -collect(remove_message) -> {set,[],[],remove_message}; -collect({'catch',R,L}) -> {set,[R],[],{'catch',L}}; -collect({'%live',_}=Live) -> Live; -collect(_) -> error. - -opt_block(Is0) -> - %% We explicitly move any allocate instruction upwards before optimising - %% moves, to avoid any potential problems with the calculation of live - %% registers. - Is1 = find_fixpoint(fun move_allocates/1, Is0), - Is2 = find_fixpoint(fun opt/1, Is1), - Is = opt_alloc(Is2), - share_floats(Is). - -find_fixpoint(OptFun, Is0) -> - case OptFun(Is0) of - Is0 -> Is0; - Is1 -> find_fixpoint(OptFun, Is1) - end. - -move_allocates([{set,_Ds,_Ss,{set_tuple_element,_}}|_]=Is) -> Is; -move_allocates([{set,Ds,Ss,_Op}=Set,{allocate,R,Alloc}|Is]) when is_integer(R) -> - [{allocate,live_regs(Ds, Ss, R),Alloc},Set|Is]; -move_allocates([{allocate,R1,Alloc1},{allocate,R2,Alloc2}|Is]) -> - R1 = R2, % Assertion. - move_allocates([{allocate,R1,combine_alloc(Alloc1, Alloc2)}|Is]); -move_allocates([I|Is]) -> - [I|move_allocates(Is)]; -move_allocates([]) -> []. - -combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) -> - {zero,Ns,Nh1+Nh2,Init}. - -merge_blocks([{allocate,R,{Attr,Ns,Nh1,Init}}|B1], - [{allocate,_,{_,nostack,Nh2,[]}}|B2]) -> - Alloc = {allocate,R,{Attr,Ns,Nh1+Nh2,Init}}, - [Alloc|merge_blocks(B1, B2)]; -merge_blocks(B1, B2) -> merge_blocks_1(B1++[{set,[],[],stop_here}|B2]). - -merge_blocks_1([{set,[],_,stop_here}|Is]) -> Is; -merge_blocks_1([{set,[D],_,move}=I|Is]) -> - case is_killed(D, Is) of - true -> merge_blocks_1(Is); - false -> [I|merge_blocks_1(Is)] - end; -merge_blocks_1([I|Is]) -> [I|merge_blocks_1(Is)]. - -opt([{set,[Dst],As,{bif,Bif,Fail}}=I1, - {set,[Dst],[Dst],{bif,'not',Fail}}=I2|Is]) -> - %% Get rid of the 'not' if the operation can be inverted. - case inverse_comp_op(Bif) of - none -> [I1,I2|opt(Is)]; - RevBif -> [{set,[Dst],As,{bif,RevBif,Fail}}|opt(Is)] - end; -opt([{set,[X],[X],move}|Is]) -> opt(Is); -opt([{set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1, - {set,[D2],[{integer,Idx2},Reg],{bif,element,{f,0}}}=I2|Is]) - when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg -> - opt([I2,I1|Is]); -opt([{set,Ds0,Ss,Op}|Is0]) -> - {Ds,Is} = opt_moves(Ds0, Is0), - [{set,Ds,Ss,Op}|opt(Is)]; -opt([I|Is]) -> [I|opt(Is)]; -opt([]) -> []. - -opt_moves([], Is0) -> {[],Is0}; -opt_moves([D0], Is0) -> - {D1,Is1} = opt_move(D0, Is0), - {[D1],Is1}; -opt_moves([X0,Y0]=Ds, Is0) -> - {X1,Is1} = opt_move(X0, Is0), - case opt_move(Y0, Is1) of - {Y1,Is2} when X1 =/= Y1 -> {[X1,Y1],Is2}; - _Other when X1 =/= Y0 -> {[X1,Y0],Is1}; - _Other -> {Ds,Is0} - end. - -opt_move(R, [{set,[D],[R],move}|Is]=Is0) -> - case is_killed(R, Is) of - true -> {D,Is}; - false -> {R,Is0} - end; -opt_move(R, [I|Is0]) -> - case is_transparent(R, I) of - true -> - {D,Is1} = opt_move(R, Is0), - case is_transparent(D, I) of - true -> {D,[I|Is1]}; - false -> {R,[I|Is0]} - end; - false -> {R,[I|Is0]} - end; -opt_move(R, []) -> {R,[]}. - -is_transparent(R, {set,Ds,Ss,_Op}) -> - case member(R, Ds) of - true -> false; - false -> not member(R, Ss) - end; -is_transparent(_, _) -> false. - -%% is_killed(Register, [Instruction]) -> true|false -%% Determine whether a register is killed by the instruction sequence. -%% If true is returned, it means that the register will not be -%% referenced in ANY way (not even indirectly by an allocate instruction); -%% i.e. it is OK to enter the instruction sequence with Register -%% containing garbage. - -is_killed({x,N}=R, [{block,Blk}|Is]) -> - case is_killed(R, Blk) of - true -> true; - false -> - %% Before looking beyond the block, we must be - %% sure that the register is not referenced by - %% any allocate instruction in the block. - case all(fun({allocate,Live,_}) when N < Live -> false; - (_) -> true - end, Blk) of - true -> is_killed(R, Is); - false -> false - end - end; -is_killed(R, [{block,Blk}|Is]) -> - case is_killed(R, Blk) of - true -> true; - false -> is_killed(R, Is) - end; -is_killed(R, [{set,Ds,Ss,_Op}|Is]) -> - case member(R, Ss) of - true -> false; - false -> - case member(R, Ds) of - true -> true; - false -> is_killed(R, Is) - end - end; -is_killed(R, [{case_end,Used}|_]) -> R =/= Used; -is_killed(R, [{badmatch,Used}|_]) -> R =/= Used; -is_killed(_, [if_end|_]) -> true; -is_killed(R, [{func_info,_,_,Ar}|_]) -> - case R of - {x,X} when X < Ar -> false; - _ -> true - end; -is_killed(R, [{kill,R}|_]) -> true; -is_killed(R, [{kill,_}|Is]) -> is_killed(R, Is); -is_killed(R, [{bs_init2,_,_,_,_,_,Dst}|Is]) -> - if - R =:= Dst -> true; - true -> is_killed(R, Is) - end; -is_killed(R, [{bs_put_string,_,_}|Is]) -> is_killed(R, Is); -is_killed({x,R}, [{'%live',Live}|_]) when R >= Live -> true; -is_killed({x,R}, [{'%live',_}|Is]) -> is_killed(R, Is); -is_killed({x,R}, [{allocate,Live,_}|_]) -> - %% Note: To be safe here, we must return either true or false, - %% not looking further at the instructions beyond the allocate - %% instruction. - R >= Live; -is_killed({x,R}, [{call,Live,_}|_]) when R >= Live -> true; -is_killed({x,R}, [{call_last,Live,_,_}|_]) when R >= Live -> true; -is_killed({x,R}, [{call_only,Live,_}|_]) when R >= Live -> true; -is_killed({x,R}, [{call_ext,Live,_}|_]) when R >= Live -> true; -is_killed({x,R}, [{call_ext_last,Live,_,_}|_]) when R >= Live -> true; -is_killed({x,R}, [{call_ext_only,Live,_}|_]) when R >= Live -> true; -is_killed({x,R}, [return|_]) when R > 0 -> true; -is_killed(_, _) -> false. - -%% is_not_used(Register, [Instruction]) -> true|false -%% Determine whether a register is used by the instruction sequence. -%% If true is returned, it means that the register will not be -%% referenced directly, but it may be referenced by an allocate -%% instruction (meaning that it is NOT allowed to contain garbage). - -is_not_used(R, [{block,Blk}|Is]) -> - case is_not_used(R, Blk) of - true -> true; - false -> is_not_used(R, Is) - end; -is_not_used({x,R}=Reg, [{allocate,Live,_}|Is]) -> - if - R >= Live -> true; - true -> is_not_used(Reg, Is) - end; -is_not_used(R, [{set,Ds,Ss,_Op}|Is]) -> - case member(R, Ss) of - true -> false; - false -> - case member(R, Ds) of - true -> true; - false -> is_not_used(R, Is) - end - end; -is_not_used(R, Is) -> is_killed(R, Is). - -%% opt_alloc(Instructions) -> Instructions' -%% Optimises all allocate instructions. - -opt_alloc([{allocate,R,{_,Ns,Nh,[]}}|Is]) -> - [opt_alloc(Is, Ns, Nh, R)|opt(Is)]; -opt_alloc([I|Is]) -> [I|opt_alloc(Is)]; -opt_alloc([]) -> []. - -%% opt_alloc(Instructions, FrameSize, HeapNeed, LivingRegs) -> [Instr] -%% Generates the optimal sequence of instructions for -%% allocating and initalizing the stack frame and needed heap. - -opt_alloc(_Is, nostack, Nh, LivingRegs) -> - {allocate,LivingRegs,{nozero,nostack,Nh,[]}}; -opt_alloc(Is, Ns, Nh, LivingRegs) -> - InitRegs = init_yreg(Is, 0), - case count_ones(InitRegs) of - N when N*2 > Ns -> - {allocate,LivingRegs,{nozero,Ns,Nh,gen_init(Ns, InitRegs)}}; - _ -> - {allocate,LivingRegs,{zero,Ns,Nh,[]}} - end. - -gen_init(Fs, Regs) -> gen_init(Fs, Regs, 0, []). - -gen_init(SameFs, _Regs, SameFs, Acc) -> reverse(Acc); -gen_init(Fs, Regs, Y, Acc) when Regs band 1 == 0 -> - gen_init(Fs, Regs bsr 1, Y+1, [{init, {y,Y}}|Acc]); -gen_init(Fs, Regs, Y, Acc) -> - gen_init(Fs, Regs bsr 1, Y+1, Acc). - -%% init_yreg(Instructions, RegSet) -> RegSetInitialized -%% Calculate the set of initialized y registers. - -init_yreg([{set,_,_,{bif,_,_}}|_], Reg) -> Reg; -init_yreg([{set,Ds,_,_}|Is], Reg) -> init_yreg(Is, add_yregs(Ds, Reg)); -init_yreg(_Is, Reg) -> Reg. - -add_yregs(Ys, Reg) -> foldl(fun(Y, R0) -> add_yreg(Y, R0) end, Reg, Ys). - -add_yreg({y,Y}, Reg) -> Reg bor (1 bsl Y); -add_yreg(_, Reg) -> Reg. - -count_ones(Bits) -> count_ones(Bits, 0). -count_ones(0, Acc) -> Acc; -count_ones(Bits, Acc) -> - count_ones(Bits bsr 1, Acc + (Bits band 1)). - -%% live_at_entry(Is) -> NumberOfRegisters -%% Calculate the number of register live at the entry to the code -%% sequence. - -live_at_entry([{block,[{allocate,R,_}|_]}|_]) -> - R; -live_at_entry([{label,_}|Is]) -> - live_at_entry(Is); -live_at_entry([{block,Bl}|_]) -> - live_at_entry(Bl); -live_at_entry([{func_info,_,_,Ar}|_]) -> - Ar; -live_at_entry(Is0) -> - case reverse(Is0) of - [{'%live',Regs}|Is] -> live_at_entry_1(Is, (1 bsl Regs)-1); - _ -> unknown - end. - -live_at_entry_1([{set,Ds,Ss,_}|Is], Rset0) -> - Rset = x_live(Ss, x_dead(Ds, Rset0)), - live_at_entry_1(Is, Rset); -live_at_entry_1([{allocate,_,_}|Is], Rset) -> - live_at_entry_1(Is, Rset); -live_at_entry_1([], Rset) -> live_regs_1(0, Rset). - -%% Calculate the new number of live registers when we move an allocate -%% instruction upwards, passing a 'set' instruction. - -live_regs(Ds, Ss, Regs0) -> - Rset = x_live(Ss, x_dead(Ds, (1 bsl Regs0)-1)), - live_regs_1(0, Rset). - -live_regs_1(N, 0) -> N; -live_regs_1(N, Regs) -> live_regs_1(N+1, Regs bsr 1). - -x_dead([{x,N}|Rs], Regs) -> x_dead(Rs, Regs band (bnot (1 bsl N))); -x_dead([_|Rs], Regs) -> x_dead(Rs, Regs); -x_dead([], Regs) -> Regs. - -x_live([{x,N}|Rs], Regs) -> x_live(Rs, Regs bor (1 bsl N)); -x_live([_|Rs], Regs) -> x_live(Rs, Regs); -x_live([], Regs) -> Regs. - -%% -%% If a floating point literal occurs more than once, move it into -%% a free register and re-use it. -%% - -share_floats([{allocate,_,_}=Alloc|Is]) -> - [Alloc|share_floats(Is)]; -share_floats(Is0) -> - All = get_floats(Is0, []), - MoreThanOnce0 = more_than_once(sort(All), gb_sets:empty()), - case gb_sets:is_empty(MoreThanOnce0) of - true -> Is0; - false -> - MoreThanOnce = gb_sets:to_list(MoreThanOnce0), - FreeX = highest_used(Is0, -1) + 1, - Regs0 = make_reg_map(MoreThanOnce, FreeX, []), - Regs = gb_trees:from_orddict(Regs0), - Is = map(fun({set,Ds,[{float,F}],Op}=I) -> - case gb_trees:lookup(F, Regs) of - none -> I; - {value,R} -> {set,Ds,[R],Op} - end; - (I) -> I - end, Is0), - [{set,[R],[{float,F}],move} || {F,R} <- Regs0] ++ Is - end. - -get_floats([{set,_,[{float,F}],_}|Is], Acc) -> - get_floats(Is, [F|Acc]); -get_floats([_|Is], Acc) -> - get_floats(Is, Acc); -get_floats([], Acc) -> Acc. - -more_than_once([F,F|Fs], Set) -> - more_than_once(Fs, gb_sets:add(F, Set)); -more_than_once([_|Fs], Set) -> - more_than_once(Fs, Set); -more_than_once([], Set) -> Set. - -highest_used([{set,Ds,Ss,_}|Is], High) -> - highest_used(Is, highest(Ds, highest(Ss, High))); -highest_used([{'%live',Live}|Is], High) when Live > High -> - highest_used(Is, Live); -highest_used([_|Is], High) -> - highest_used(Is, High); -highest_used([], High) -> High. - -highest([{x,R}|Rs], High) when R > High -> - highest(Rs, R); -highest([_|Rs], High) -> - highest(Rs, High); -highest([], High) -> High. - -make_reg_map([F|Fs], R, Acc) when R < ?MAXREG -> - make_reg_map(Fs, R+1, [{F,{x,R}}|Acc]); -make_reg_map(_, _, Acc) -> sort(Acc). - -%% inverse_comp_op(Op) -> none|RevOp - -inverse_comp_op('=:=') -> '=/='; -inverse_comp_op('=/=') -> '=:='; -inverse_comp_op('==') -> '/='; -inverse_comp_op('/=') -> '=='; -inverse_comp_op('>') -> '=<'; -inverse_comp_op('<') -> '>='; -inverse_comp_op('>=') -> '<'; -inverse_comp_op('=<') -> '>'; -inverse_comp_op(_) -> none. - -%%% -%%% Evaluation of constant bit fields. -%%% - -is_bs_put({bs_put_integer,_,_,_,_,_}) -> true; -is_bs_put({bs_put_float,_,_,_,_,_}) -> true; -is_bs_put(_) -> false. - -collect_bs_puts(Is) -> - collect_bs_puts_1(Is, []). - -collect_bs_puts_1([I|Is]=Is0, Acc) -> - case is_bs_put(I) of - false -> {reverse(Acc),Is0}; - true -> collect_bs_puts_1(Is, [I|Acc]) - end; -collect_bs_puts_1([], Acc) -> {reverse(Acc),[]}. - -opt_bs_puts(Is) -> - opt_bs_1(Is, []). - -opt_bs_1([{bs_put_float,Fail,{integer,Sz},1,Flags0,Src}=I0|Is], Acc) -> - case catch eval_put_float(Src, Sz, Flags0) of - {'EXIT',_} -> - opt_bs_1(Is, [I0|Acc]); - <<Int:Sz>> -> - Flags = force_big(Flags0), - I = {bs_put_integer,Fail,{integer,Sz},1,Flags,{integer,Int}}, - opt_bs_1([I|Is], Acc) - end; -opt_bs_1([{bs_put_integer,_,{integer,8},1,_,{integer,_}}|_]=IsAll, Acc0) -> - {Is,Acc} = bs_collect_string(IsAll, Acc0), - opt_bs_1(Is, Acc); -opt_bs_1([{bs_put_integer,Fail,{integer,Sz},1,F,{integer,N}}=I|Is0], Acc) when Sz > 8 -> - case field_endian(F) of - big -> - case bs_split_int(N, Sz, Fail, Is0) of - no_split -> opt_bs_1(Is0, [I|Acc]); - Is -> opt_bs_1(Is, Acc) - end; - little -> - case catch <<N:Sz/little>> of - {'EXIT',_} -> - opt_bs_1(Is0, [I|Acc]); - <<Int:Sz>> -> - Flags = force_big(F), - Is = [{bs_put_integer,Fail,{integer,Sz},1, - Flags,{integer,Int}}|Is0], - opt_bs_1(Is, Acc) - end; - native -> opt_bs_1(Is0, [I|Acc]) - end; -opt_bs_1([{Op,Fail,{integer,Sz},U,F,Src}|Is], Acc) when U > 1 -> - opt_bs_1([{Op,Fail,{integer,U*Sz},1,F,Src}|Is], Acc); -opt_bs_1([I|Is], Acc) -> - opt_bs_1(Is, [I|Acc]); -opt_bs_1([], Acc) -> reverse(Acc). - -eval_put_float(Src, Sz, Flags) -> - Val = value(Src), - case field_endian(Flags) of - little -> <<Val:Sz/little-float-unit:1>>; - big -> <<Val:Sz/big-float-unit:1>> - %% native intentionally not handled here - we can't optimize it. - end. - -value({integer,I}) -> I; -value({float,F}) -> F; -value({atom,A}) -> A. - -bs_collect_string(Is, [{bs_put_string,Len,{string,Str}}|Acc]) -> - bs_coll_str_1(Is, Len, reverse(Str), Acc); -bs_collect_string(Is, Acc) -> - bs_coll_str_1(Is, 0, [], Acc). - -bs_coll_str_1([{bs_put_integer,_,{integer,Sz},U,_,{integer,V}}|Is], - Len, StrAcc, IsAcc) when U*Sz =:= 8 -> - Byte = V band 16#FF, - bs_coll_str_1(Is, Len+1, [Byte|StrAcc], IsAcc); -bs_coll_str_1(Is, Len, StrAcc, IsAcc) -> - {Is,[{bs_put_string,Len,{string,reverse(StrAcc)}}|IsAcc]}. - -field_endian({field_flags,F}) -> field_endian_1(F). - -field_endian_1([big=E|_]) -> E; -field_endian_1([little=E|_]) -> E; -field_endian_1([native=E|_]) -> E; -field_endian_1([_|Fs]) -> field_endian_1(Fs). - -force_big({field_flags,F}) -> - {field_flags,force_big_1(F)}. - -force_big_1([big|_]=Fs) -> Fs; -force_big_1([little|Fs]) -> [big|Fs]; -force_big_1([F|Fs]) -> [F|force_big_1(Fs)]. - -bs_split_int(0, Sz, _, _) when Sz > 64 -> - %% We don't want to split in this case because the - %% string will consist of only zeroes. - no_split; -bs_split_int(N, Sz, Fail, Acc) -> - FirstByteSz = case Sz rem 8 of - 0 -> 8; - Rem -> Rem - end, - bs_split_int_1(N, FirstByteSz, Sz, Fail, Acc). - -bs_split_int_1(N, ByteSz, Sz, Fail, Acc) when Sz > 0 -> - Mask = (1 bsl ByteSz) - 1, - I = {bs_put_integer,Fail,{integer,ByteSz},1, - {field_flags,[big]},{integer,N band Mask}}, - bs_split_int_1(N bsr ByteSz, 8, Sz-ByteSz, Fail, [I|Acc]); -bs_split_int_1(_, _, _, _, Acc) -> Acc. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_bool.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_bool.erl deleted file mode 100644 index 3180a22433..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_bool.erl +++ /dev/null @@ -1,617 +0,0 @@ -%% ``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 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. -%% -%% 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: beam_bool.erl,v 1.1 2008/12/17 09:53:41 mikpe Exp $ -%% -%% Purpose: Optimizes booleans in guards. - --module(beam_bool). - --export([module/2]). - --import(lists, [reverse/1,foldl/3,mapfoldl/3,sort/1,member/2]). --define(MAXREG, 1024). - --record(st, - {next, %Next label number. - ll %Live regs at labels. - }). - -module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> - %%io:format("~p:\n", [Mod]), - {Fs,_} = mapfoldl(fun(Fn, Lbl) -> function(Fn, Lbl) end, 100000000, Fs0), - {ok,{Mod,Exp,Attr,Fs,Lc}}. - -function({function,Name,Arity,CLabel,Is0}, Lbl0) -> - %%io:format("~p/~p:\n", [Name,Arity]), - {Is,#st{next=Lbl}} = bool_opt(Is0, Lbl0), - {{function,Name,Arity,CLabel,Is},Lbl}. - -%% -%% Optimize boolean expressions that use guard bifs. Rewrite to -%% use test instructions if possible. -%% - -bool_opt(Asm, Lbl) -> - LiveInfo = index_instructions(Asm), - bopt(Asm, [], #st{next=Lbl,ll=LiveInfo}). - -bopt([{block,Bl0}=Block| - [{jump,{f,Succ}}, - {label,Fail}, - {block,[{set,[Dst],[{atom,false}],move},{'%live',Live}]}, - {label,Succ}|Is]=Is0], Acc0, St) -> - case split_block(Bl0, Dst, Fail) of - failed -> - bopt(Is0, [Block|Acc0], St); - {Bl,PreBlock} -> - Acc1 = case PreBlock of - [] -> Acc0; - _ -> [{block,PreBlock}|Acc0] - end, - Acc = [{protected,[Dst],Bl,{Fail,Succ,Live}}|Acc1], - bopt(Is, Acc, St) - end; -bopt([{test,is_eq_exact,{f,Fail},[Reg,{atom,true}]}=I|Is], [{block,_}|_]=Acc0, St0) -> - case bopt_block(Reg, Fail, Is, Acc0, St0) of - failed -> bopt(Is, [I|Acc0], St0); - {Acc,St} -> bopt(Is, Acc, St) - end; -bopt([I|Is], Acc, St) -> - bopt(Is, [I|Acc], St); -bopt([], Acc, St) -> - {bopt_reverse(Acc, []),St}. - -bopt_reverse([{protected,[Dst],Block,{Fail,Succ,Live}}|Is], Acc0) -> - Acc = [{block,Block},{jump,{f,Succ}}, - {label,Fail}, - {block,[{set,[Dst],[{atom,false}],move},{'%live',Live}]}, - {label,Succ}|Acc0], - bopt_reverse(Is, Acc); -bopt_reverse([I|Is], Acc) -> - bopt_reverse(Is, [I|Acc]); -bopt_reverse([], Acc) -> Acc. - -%% bopt_block(Reg, Fail, OldIs, Accumulator, St) -> failed | {NewAcc,St} -%% Attempt to optimized a block of guard BIFs followed by a test -%% instruction. -bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) -> - case split_block(Bl0, Reg, Fail) of - failed -> - %% Reason for failure: The block either contained no - %% guard BIFs with the failure label Fail, or the final - %% instruction in the block did not assign the Reg register. - - %%io:format("split ~p: ~P\n", [Reg,Bl0,20]), - failed; - {Bl1,BlPre} -> - %% The block has been splitted. Bl1 is a non-empty list - %% of guard BIF instructions having the failure label Fail. - %% BlPre is a (possibly empty list) of instructions preceeding - %% Bl1. - Acc1 = make_block(BlPre, Acc0), - {Bl,Acc} = extend_block(Bl1, Fail, Acc1), - case catch bopt_block_1(Bl, Fail, St0) of - {'EXIT',_Reason} -> - %% Optimization failed for one of the following reasons: - %% - %% 1. Not possible to rewrite because a boolean value is - %% passed to another guard bif, e.g. 'abs(A > B)' - %% (in this case, obviously nonsense code). Rare in - %% practice. - %% - %% 2. Not possible to rewrite because we have not seen - %% the complete boolan expression (it is spread out - %% over several blocks with jumps and labels). - %% The 'or' and 'and' instructions need to that fully - %% known operands in order to be eliminated. - %% - %% 3. Other bug or limitation. - - %%io:format("~P\n", [_Reason,20]), - failed; - {NewCode,St} -> - case is_opt_safe(Bl, NewCode, OldIs, St) of - false -> - %% The optimization is not safe. (A register - %% used by the instructions following the - %% optimized code is either not assigned a - %% value at all or assigned a different value.) - - %%io:format("\nNot safe:\n"), - %%io:format("~p\n", [Bl]), - %%io:format("~p\n", [reverse(NewCode)]), - failed; - true -> {NewCode++Acc,St} - end - end - end. - -bopt_block_1(Block, Fail, St) -> - {Pre0,[{_,Tree}]} = bopt_tree(Block), - Pre = update_fail_label(Pre0, Fail, []), - bopt_cg(Tree, Fail, make_block(Pre, []), St). - -%% is_opt_safe(OriginalCode, OptCode, FollowingCode, State) -> true|false -%% Comparing the original code to the optimized code, determine -%% whether the optimized code is guaranteed to work in the same -%% way as the original code. - -is_opt_safe(Bl, NewCode, OldIs, St) -> - %% Here are the conditions that must be true for the - %% optimization to be safe. - %% - %% 1. Any register that was assigned a value in the original - %% code, but is not in the optimized code, must be guaranteed - %% to be KILLED in the following code. (NotSet below.) - %% - %% 2. Any register that is assigned a value in the optimized - %% code must be UNUSED in the following code. (NewDst, Set.) - %% (Possible future improvement: Registers that are known - %% to be assigned the SAME value in the original and optimized - %% code don't need to be unused in the following code.) - - PrevDst = dst_regs(Bl), - NewDst = dst_regs(NewCode), - NotSet = ordsets:subtract(PrevDst, NewDst), - - %% Note: The following line is an optimization. We don't need - %% to test whether variables in NotSet for being unused, because - %% they will all be tested for being killed (a stronger condition - %% than being unused). - - Set = ordsets:subtract(NewDst, NotSet), - - all_killed(NotSet, OldIs, St) andalso - none_used(Set, OldIs, St). - -% update_fail_label([{set,_,_,{bif,_,{f,0}}}=I|Is], Fail, Acc) -> -% update_fail_label(Is, Fail, [I|Acc]); -update_fail_label([{set,Ds,As,{bif,N,{f,_}}}|Is], Fail, Acc) -> - update_fail_label(Is, Fail, [{set,Ds,As,{bif,N,{f,Fail}}}|Acc]); -update_fail_label([], _, Acc) -> Acc. - -make_block([], Acc) -> Acc; -make_block(Bl, Acc) -> [{block,Bl}|Acc]. - -extend_block(BlAcc, Fail, [{protected,_,_,_}=Prot|OldAcc]) -> - extend_block([Prot|BlAcc], Fail, OldAcc); -extend_block(BlAcc0, Fail, [{block,Is0}|OldAcc]=OldAcc0) -> - case extend_block_1(reverse(Is0), Fail, BlAcc0) of - {[],_} -> {BlAcc0,OldAcc0}; - {BlAcc,[]} -> extend_block(BlAcc, Fail, OldAcc); - {BlAcc,Is} -> {BlAcc,[{block,Is}|OldAcc]} - end; -extend_block(BlAcc, _, OldAcc) -> {BlAcc,OldAcc}. - -extend_block_1([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) -> - extend_block_1(Is, Fail, [I|Acc]); -extend_block_1([{set,[_],As,{bif,Bif,_}}=I|Is]=Is0, Fail, Acc) -> - case safe_bool_op(Bif, length(As)) of - false -> {Acc,reverse(Is0)}; - true -> extend_block_1(Is, Fail, [I|Acc]) - end; -extend_block_1([_|_]=Is, _, Acc) -> {Acc,reverse(Is)}; -extend_block_1([], _, Acc) -> {Acc,[]}. - -split_block(Is0, Dst, Fail) -> - case reverse(Is0) of - [{'%live',_}|[{set,[Dst],_,_}|_]=Is] -> - split_block_1(Is, Fail); - [{set,[Dst],_,_}|_]=Is -> - split_block_1(Is, Fail); - _ -> failed - end. - -split_block_1(Is, Fail) -> - case split_block_2(Is, Fail, []) of - {[],_} -> failed; - {_,_}=Res -> Res - end. - -% split_block_2([{set,[_],_,{bif,_,{f,0}}}=I|Is], Fail, Acc) -> -% split_block_2(Is, Fail, [I|Acc]); -split_block_2([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) -> - split_block_2(Is, Fail, [I|Acc]); -split_block_2([{'%live',_}|Is], Fail, Acc) -> - split_block_2(Is, Fail, Acc); -split_block_2(Is, _, Acc) -> {Acc,reverse(Is)}. - -dst_regs(Is) -> - dst_regs(Is, []). - -dst_regs([{block,Bl}|Is], Acc) -> - dst_regs(Bl, dst_regs(Is, Acc)); -dst_regs([{set,[D],_,{bif,_,{f,_}}}|Is], Acc) -> - dst_regs(Is, [D|Acc]); -dst_regs([_|Is], Acc) -> - dst_regs(Is, Acc); -dst_regs([], Acc) -> ordsets:from_list(Acc). - -all_killed([R|Rs], OldIs, St) -> - case is_killed(R, OldIs, St) of - false -> false; - true -> all_killed(Rs, OldIs, St) - end; -all_killed([], _, _) -> true. - -none_used([R|Rs], OldIs, St) -> - case is_not_used(R, OldIs, St) of - false -> false; - true -> none_used(Rs, OldIs, St) - end; -none_used([], _, _) -> true. - -bopt_tree(Block0) -> - Block = ssa_block(Block0), - Reg = free_variables(Block), - %%io:format("~p\n", [Block]), - %%io:format("~p\n", [Reg]), - Res = bopt_tree_1(Block, Reg, []), - %%io:format("~p\n", [Res]), - Res. - -bopt_tree_1([{set,[Dst],As0,{bif,'not',_}}|Is], Forest0, Pre) -> - {[Arg],Forest1} = bopt_bool_args(As0, Forest0), - Forest = gb_trees:enter(Dst, {'not',Arg}, Forest1), - bopt_tree_1(Is, Forest, Pre); -bopt_tree_1([{set,[Dst],As0,{bif,'and',_}}|Is], Forest0, Pre) -> - {As,Forest1} = bopt_bool_args(As0, Forest0), - AndList = make_and_list(As), - Forest = gb_trees:enter(Dst, {'and',AndList}, Forest1), - bopt_tree_1(Is, Forest, Pre); -bopt_tree_1([{set,[Dst],[L0,R0],{bif,'or',_}}|Is], Forest0, Pre) -> - L = gb_trees:get(L0, Forest0), - R = gb_trees:get(R0, Forest0), - Forest1 = gb_trees:delete(L0, gb_trees:delete(R0, Forest0)), - OrList = make_or_list([L,R]), - Forest = gb_trees:enter(Dst, {'or',OrList}, Forest1), - bopt_tree_1(Is, Forest, Pre); -bopt_tree_1([{protected,[Dst],_,_}=Prot|Is], Forest0, Pre) -> - Forest = gb_trees:enter(Dst, Prot, Forest0), - bopt_tree_1(Is, Forest, Pre); -bopt_tree_1([{set,[Dst],As,{bif,N,_}}=Bif|Is], Forest0, Pre) -> - Ar = length(As), - case safe_bool_op(N, Ar) of - false -> - bopt_good_args(As, Forest0), - Forest = gb_trees:enter(Dst, any, Forest0), - bopt_tree_1(Is, Forest, [Bif|Pre]); - true -> - bopt_good_args(As, Forest0), - Test = bif_to_test(Dst, N, As), - Forest = gb_trees:enter(Dst, Test, Forest0), - bopt_tree_1(Is, Forest, Pre) - end; -bopt_tree_1([], Forest, Pre) -> - {Pre,[R || {_,V}=R <- gb_trees:to_list(Forest), V =/= any]}. - -safe_bool_op(internal_is_record, 3) -> true; -safe_bool_op(N, Ar) -> - erl_internal:new_type_test(N, Ar) orelse erl_internal:comp_op(N, Ar). - -bopt_bool_args(As, Forest) -> - mapfoldl(fun bopt_bool_arg/2, Forest, As). - -bopt_bool_arg({T,_}=R, Forest) when T == x; T == y -> - {gb_trees:get(R, Forest),gb_trees:delete(R, Forest)}; -bopt_bool_arg(Term, Forest) -> - {Term,Forest}. - -bopt_good_args([A|As], Regs) -> - bopt_good_arg(A, Regs), - bopt_good_args(As, Regs); -bopt_good_args([], _) -> ok. - -bopt_good_arg({x,_}=X, Regs) -> - case gb_trees:get(X, Regs) of - any -> ok; - _Other -> - %%io:format("not any: ~p: ~p\n", [X,_Other]), - exit(bad_contents) - end; -bopt_good_arg(_, _) -> ok. - -bif_to_test(_, N, As) -> - bif_to_test(N, As). - -bif_to_test(internal_is_record, [_,_,_]=As) -> - {test,internal_is_record,fail,As}; -bif_to_test('=:=', As) -> {test,is_eq_exact,fail,As}; -bif_to_test('=/=', As) -> {test,is_ne_exact,fail,As}; -bif_to_test('==', As) -> {test,is_eq,fail,As}; -bif_to_test('/=', As) -> {test,is_ne,fail,As}; -bif_to_test('=<', [L,R]) -> {test,is_ge,fail,[R,L]}; -bif_to_test('>=', As) -> {test,is_ge,fail,As}; -bif_to_test('>', [L,R]) -> {test,is_lt,fail,[R,L]}; -bif_to_test('<', As) -> {test,is_lt,fail,As}; -bif_to_test(Name, [_]=As) -> - case erl_internal:new_type_test(Name, 1) of - false -> exit({bif_to_test,Name,As,failed}); - true -> {test,Name,fail,As} - end. - -make_and_list([{'and',As}|Is]) -> - make_and_list(As++Is); -make_and_list([I|Is]) -> - [I|make_and_list(Is)]; -make_and_list([]) -> []. - -make_or_list([{'or',As}|Is]) -> - make_or_list(As++Is); -make_or_list([I|Is]) -> - [I|make_or_list(Is)]; -make_or_list([]) -> []. - -%% Code generation for a boolean tree. - -bopt_cg({'not',Arg}, Fail, Acc, St) -> - I = bopt_cg_not(Arg), - bopt_cg(I, Fail, Acc, St); -bopt_cg({'and',As}, Fail, Acc, St) -> - bopt_cg_and(As, Fail, Acc, St); -bopt_cg({'or',As}, Fail, Acc, St0) -> - {Succ,St} = new_label(St0), - bopt_cg_or(As, Succ, Fail, Acc, St); -bopt_cg({test,is_tuple_element,fail,[Tmp,Tuple,RecordTag]}, Fail, Acc, St) -> - {[{test,is_eq_exact,{f,Fail},[Tmp,RecordTag]}, - {get_tuple_element,Tuple,0,Tmp}|Acc],St}; -bopt_cg({inverted_test,is_tuple_element,fail,[Tmp,Tuple,RecordTag]}, Fail, Acc, St) -> - {[{test,is_ne_exact,{f,Fail},[Tmp,RecordTag]}, - {get_tuple_element,Tuple,0,Tmp}|Acc],St}; -bopt_cg({test,N,fail,As}, Fail, Acc, St) -> - Test = {test,N,{f,Fail},As}, - {[Test|Acc],St}; -bopt_cg({inverted_test,N,fail,As}, Fail, Acc, St0) -> - {Lbl,St} = new_label(St0), - {[{label,Lbl},{jump,{f,Fail}},{test,N,{f,Lbl},As}|Acc],St}; -bopt_cg({protected,_,Bl0,{_,_,_}}, Fail, Acc, St0) -> - {Bl,St} = bopt_block_1(Bl0, Fail, St0), - {Bl++Acc,St}; -bopt_cg([_|_]=And, Fail, Acc, St) -> - bopt_cg_and(And, Fail, Acc, St). - -bopt_cg_not({'and',As0}) -> - As = [bopt_cg_not(A) || A <- As0], - {'or',As}; -bopt_cg_not({'or',As0}) -> - As = [bopt_cg_not(A) || A <- As0], - {'and',As}; -bopt_cg_not({test,Test,Fail,As}) -> - {inverted_test,Test,Fail,As}. - -bopt_cg_and([{atom,false}|_], Fail, _, St) -> - {[{jump,{f,Fail}}],St}; -bopt_cg_and([{atom,true}|Is], Fail, Acc, St) -> - bopt_cg_and(Is, Fail, Acc, St); -bopt_cg_and([I|Is], Fail, Acc0, St0) -> - {Acc,St} = bopt_cg(I, Fail, Acc0, St0), - bopt_cg_and(Is, Fail, Acc, St); -bopt_cg_and([], _, Acc, St) -> {Acc,St}. - -bopt_cg_or([I], Succ, Fail, Acc0, St0) -> - {Acc,St} = bopt_cg(I, Fail, Acc0, St0), - {[{label,Succ}|Acc],St}; -bopt_cg_or([I|Is], Succ, Fail, Acc0, St0) -> - {Lbl,St1} = new_label(St0), - {Acc,St} = bopt_cg(I, Lbl, Acc0, St1), - bopt_cg_or(Is, Succ, Fail, [{label,Lbl},{jump,{f,Succ}}|Acc], St). - -new_label(#st{next=LabelNum}=St) when is_integer(LabelNum) -> - {LabelNum,St#st{next=LabelNum+1}}. - -free_variables(Is) -> - E = gb_sets:empty(), - free_vars_1(Is, E, E). - -free_vars_1([{set,[Dst],As,{bif,_,_}}|Is], F0, N0) -> - F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), - N = gb_sets:union(N0, var_list([Dst])), - free_vars_1(Is, F, N); -free_vars_1([{protected,_,Pa,_}|Is], F, N) -> - free_vars_1(Pa++Is, F, N); -free_vars_1([], F, _) -> - gb_trees:from_orddict([{K,any} || K <- gb_sets:to_list(F)]). - -var_list(Is) -> - var_list_1(Is, gb_sets:empty()). - -var_list_1([{x,_}=X|Is], D) -> - var_list_1(Is, gb_sets:add(X, D)); -var_list_1([_|Is], D) -> - var_list_1(Is, D); -var_list_1([], D) -> D. - -%%% -%%% Convert a block to Static Single Assignment (SSA) form. -%%% - --record(ssa, - {live, - sub}). - -ssa_block(Is0) -> - Next = ssa_first_free(Is0, 0), - {Is,_} = ssa_block_1(Is0, #ssa{live=Next,sub=gb_trees:empty()}, []), - Is. - -ssa_block_1([{protected,[_],Pa0,Pb}|Is], Sub0, Acc) -> - {Pa,Sub} = ssa_block_1(Pa0, Sub0, []), - Dst = ssa_last_target(Pa), - ssa_block_1(Is, Sub, [{protected,[Dst],Pa,Pb}|Acc]); -ssa_block_1([{set,[Dst],As,Bif}|Is], Sub0, Acc0) -> - Sub1 = ssa_in_use_list(As, Sub0), - Sub = ssa_assign(Dst, Sub1), - Acc = [{set,[ssa_sub(Dst, Sub)],ssa_sub_list(As, Sub0),Bif}|Acc0], - ssa_block_1(Is, Sub, Acc); -ssa_block_1([], Sub, Acc) -> {reverse(Acc),Sub}. - -ssa_in_use_list(As, Sub) -> - foldl(fun ssa_in_use/2, Sub, As). - -ssa_in_use({x,_}=R, #ssa{sub=Sub0}=Ssa) -> - case gb_trees:is_defined(R, Sub0) of - true -> Ssa; - false -> - Sub = gb_trees:insert(R, R, Sub0), - Ssa#ssa{sub=Sub} - end; -ssa_in_use(_, Ssa) -> Ssa. - -ssa_assign({x,_}=R, #ssa{sub=Sub0}=Ssa0) -> - case gb_trees:is_defined(R, Sub0) of - false -> - Sub = gb_trees:insert(R, R, Sub0), - Ssa0#ssa{sub=Sub}; - true -> - {NewReg,Ssa} = ssa_new_reg(Ssa0), - Sub1 = gb_trees:update(R, NewReg, Sub0), - Sub = gb_trees:insert(NewReg, NewReg, Sub1), - Ssa#ssa{sub=Sub} - end; -ssa_assign(_, Ssa) -> Ssa. - -ssa_sub_list(List, Sub) -> - [ssa_sub(E, Sub) || E <- List]. - -ssa_sub(R0, #ssa{sub=Sub}) -> - case gb_trees:lookup(R0, Sub) of - none -> R0; - {value,R} -> R - end. - -ssa_new_reg(#ssa{live=Reg}=Ssa) -> - {{x,Reg},Ssa#ssa{live=Reg+1}}. - -ssa_first_free([{protected,Ds,_,_}|Is], Next0) -> - Next = ssa_first_free_list(Ds, Next0), - ssa_first_free(Is, Next); -ssa_first_free([{set,[Dst],As,_}|Is], Next0) -> - Next = ssa_first_free_list([Dst|As], Next0), - ssa_first_free(Is, Next); -ssa_first_free([], Next) -> Next. - -ssa_first_free_list(Regs, Next) -> - foldl(fun({x,R}, N) when R >= N -> R+1; - (_, N) -> N end, Next, Regs). - -ssa_last_target([{set,[Dst],_,_},{'%live',_}]) -> Dst; -ssa_last_target([{set,[Dst],_,_}]) -> Dst; -ssa_last_target([_|Is]) -> ssa_last_target(Is). - -%% index_instructions(FunctionIs) -> GbTree([{Label,Is}]) -%% Index the instruction sequence so that we can quickly -%% look up the instruction following a specific label. - -index_instructions(Is) -> - ii_1(Is, []). - -ii_1([{label,Lbl}|Is0], Acc) -> - Is = lists:dropwhile(fun({label,_}) -> true; - (_) -> false end, Is0), - ii_1(Is0, [{Lbl,Is}|Acc]); -ii_1([_|Is], Acc) -> - ii_1(Is, Acc); -ii_1([], Acc) -> gb_trees:from_orddict(sort(Acc)). - -%% is_killed(Register, [Instruction], State) -> true|false -%% Determine whether a register is killed in the instruction sequence. -%% The state is used to allow us to determine the kill state -%% across branches. - -is_killed(R, Is, St) -> - case is_killed_1(R, Is, St) of - false -> - %%io:format("nk ~p: ~P\n", [R,Is,15]), - false; - true -> true - end. - -is_killed_1(R, [{block,Blk}|Is], St) -> - case is_killed_1(R, Blk, St) of - true -> true; - false -> is_killed_1(R, Is, St) - end; -is_killed_1(R, [{test,_,{f,Fail},As}|Is], St) -> - case not member(R, As) andalso is_reg_killed_at(R, Fail, St) of - false -> false; - true -> is_killed_1(R, Is, St) - end; -is_killed_1(R, [{select_val,R,_,_}|_], _) -> false; -is_killed_1(R, [{select_val,_,Fail,{list,Branches}}|_], St) -> - is_killed_at_all(R, [Fail|Branches], St); -is_killed_1(R, [{jump,{f,F}}|_], St) -> - is_reg_killed_at(R, F, St); -is_killed_1(Reg, Is, _) -> - beam_block:is_killed(Reg, Is). - -is_reg_killed_at(R, Lbl, #st{ll=Ll}=St) -> - Is = gb_trees:get(Lbl, Ll), - is_killed_1(R, Is, St). - -is_killed_at_all(R, [{f,Lbl}|T], St) -> - case is_reg_killed_at(R, Lbl, St) of - false -> false; - true -> is_killed_at_all(R, T, St) - end; -is_killed_at_all(R, [_|T], St) -> - is_killed_at_all(R, T, St); -is_killed_at_all(_, [], _) -> true. - -%% is_not_used(Register, [Instruction], State) -> true|false -%% Determine whether a register is never used in the instruction sequence -%% (it could still referenced by an allocate instruction, meaning that -%% it MUST be initialized). -%% The state is used to allow us to determine the usage state -%% across branches. - -is_not_used(R, Is, St) -> - case is_not_used_1(R, Is, St) of - false -> - %%io:format("used ~p: ~P\n", [R,Is,15]), - false; - true -> true - end. - -is_not_used_1(R, [{block,Blk}|Is], St) -> - case is_not_used_1(R, Blk, St) of - true -> true; - false -> is_not_used_1(R, Is, St) - end; -is_not_used_1(R, [{test,_,{f,Fail},As}|Is], St) -> - case not member(R, As) andalso is_reg_not_used_at(R, Fail, St) of - false -> false; - true -> is_not_used_1(R, Is, St) - end; -is_not_used_1(R, [{select_val,R,_,_}|_], _) -> false; -is_not_used_1(R, [{select_val,_,Fail,{list,Branches}}|_], St) -> - is_used_at_none(R, [Fail|Branches], St); -is_not_used_1(R, [{jump,{f,F}}|_], St) -> - is_reg_not_used_at(R, F, St); -is_not_used_1(Reg, Is, _) -> - beam_block:is_not_used(Reg, Is). - -is_reg_not_used_at(R, Lbl, #st{ll=Ll}=St) -> - Is = gb_trees:get(Lbl, Ll), - is_not_used_1(R, Is, St). - -is_used_at_none(R, [{f,Lbl}|T], St) -> - case is_reg_not_used_at(R, Lbl, St) of - false -> false; - true -> is_used_at_none(R, T, St) - end; -is_used_at_none(R, [_|T], St) -> - is_used_at_none(R, T, St); -is_used_at_none(_, [], _) -> true. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_clean.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_clean.erl deleted file mode 100644 index d47ae9c896..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_clean.erl +++ /dev/null @@ -1,232 +0,0 @@ -%% ``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 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. -%% -%% 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: beam_clean.erl,v 1.1 2008/12/17 09:53:41 mikpe Exp $ -%% -%% Purpose : Clean up, such as removing unused labels and unused functions. - --module(beam_clean). - --export([module/2]). --import(lists, [member/2,map/2,foldl/3,mapfoldl/3,reverse/1]). - -module({Mod,Exp,Attr,Fs0,_}, _Opt) -> - Order = [Lbl || {function,_,_,Lbl,_} <- Fs0], - All = foldl(fun({function,_,_,Lbl,_}=Func,D) -> dict:store(Lbl, Func, D) end, - dict:new(), Fs0), - {WorkList,Used0} = exp_to_labels(Fs0, Exp), - Used = find_all_used(WorkList, All, Used0), - Fs1 = remove_unused(Order, Used, All), - {Fs,Lc} = clean_labels(Fs1), - {ok,{Mod,Exp,Attr,Fs,Lc}}. - -%% Convert the export list ({Name,Arity} pairs) to a list of entry labels. - -exp_to_labels(Fs, Exp) -> exp_to_labels(Fs, Exp, [], sets:new()). - -exp_to_labels([{function,Name,Arity,Lbl,_}|Fs], Exp, Acc, Used) -> - case member({Name,Arity}, Exp) of - true -> exp_to_labels(Fs, Exp, [Lbl|Acc], sets:add_element(Lbl, Used)); - false -> exp_to_labels(Fs, Exp, Acc, Used) - end; -exp_to_labels([], _, Acc, Used) -> {Acc,Used}. - -%% Remove the unused functions. - -remove_unused([F|Fs], Used, All) -> - case sets:is_element(F, Used) of - false -> remove_unused(Fs, Used, All); - true -> [dict:fetch(F, All)|remove_unused(Fs, Used, All)] - end; -remove_unused([], _, _) -> []. - -%% Find all used functions. - -find_all_used([F|Fs0], All, Used0) -> - {function,_,_,_,Code} = dict:fetch(F, All), - {Fs,Used} = update_work_list(Code, {Fs0,Used0}), - find_all_used(Fs, All, Used); -find_all_used([], _All, Used) -> Used. - -update_work_list([{call,_,{f,L}}|Is], Sets) -> - update_work_list(Is, add_to_work_list(L, Sets)); -update_work_list([{call_last,_,{f,L},_}|Is], Sets) -> - update_work_list(Is, add_to_work_list(L, Sets)); -update_work_list([{call_only,_,{f,L}}|Is], Sets) -> - update_work_list(Is, add_to_work_list(L, Sets)); -update_work_list([{make_fun,{f,L},_,_}|Is], Sets) -> - update_work_list(Is, add_to_work_list(L, Sets)); -update_work_list([{make_fun2,{f,L},_,_,_}|Is], Sets) -> - update_work_list(Is, add_to_work_list(L, Sets)); -update_work_list([_|Is], Sets) -> - update_work_list(Is, Sets); -update_work_list([], Sets) -> Sets. - -add_to_work_list(F, {Fs,Used}=Sets) -> - case sets:is_element(F, Used) of - true -> Sets; - false -> {[F|Fs],sets:add_element(F, Used)} - end. - - -%%% -%%% Coalesce adjacent labels. Renumber all labels to eliminate gaps. -%%% This cleanup will slightly reduce file size and slightly speed up loading. -%%% -%%% We also expand internal_is_record/3 to a sequence of instructions. It is done -%%% here merely because this module will always be called even if optimization -%%% is turned off. We don't want to do the expansion in beam_asm because we -%%% want to see the expanded code in a .S file. -%%% - --record(st, {lmap, %Translation tables for labels. - entry, %Number of entry label. - lc %Label counter - }). - -clean_labels(Fs0) -> - St0 = #st{lmap=dict:new(),lc=1}, - {Fs1,#st{lmap=Lmap,lc=Lc}} = mapfoldl(fun function_renumber/2, St0, Fs0), - {map(fun(F) -> function_replace(F, Lmap) end, Fs1),Lc}. - -function_renumber({function,Name,Arity,_Entry,Asm0}, St0) -> - {Asm,St} = renumber_labels(Asm0, [], St0), - {{function,Name,Arity,St#st.entry,Asm},St}. - -renumber_labels([{bif,internal_is_record,{f,_}, - [Term,Tag,{integer,Arity}],Dst}|Is], Acc, St) -> - ContLabel = 900000000+2*St#st.lc, - FailLabel = ContLabel+1, - Fail = {f,FailLabel}, - Tmp = Dst, - renumber_labels([{test,is_tuple,Fail,[Term]}, - {test,test_arity,Fail,[Term,Arity]}, - {get_tuple_element,Term,0,Tmp}, - {test,is_eq_exact,Fail,[Tmp,Tag]}, - {move,{atom,true},Dst}, - {jump,{f,ContLabel}}, - {label,FailLabel}, - {move,{atom,false},Dst}, - {label,ContLabel}|Is], Acc, St); -renumber_labels([{test,internal_is_record,{f,_}=Fail, - [Term,Tag,{integer,Arity}]}|Is], Acc, St) -> - Tmp = {x,1023}, - case Term of - {Reg,_} when Reg == x; Reg == y -> - renumber_labels([{test,is_tuple,Fail,[Term]}, - {test,test_arity,Fail,[Term,Arity]}, - {get_tuple_element,Term,0,Tmp}, - {test,is_eq_exact,Fail,[Tmp,Tag]}|Is], Acc, St); - _ -> - renumber_labels([{jump,Fail}|Is], Acc, St) - end; -renumber_labels([{label,Old}|Is], [{label,New}|_]=Acc, #st{lmap=D0}=St) -> - D = dict:store(Old, New, D0), - renumber_labels(Is, Acc, St#st{lmap=D}); -renumber_labels([{label,Old}|Is], Acc, St0) -> - New = St0#st.lc, - D = dict:store(Old, New, St0#st.lmap), - renumber_labels(Is, [{label,New}|Acc], St0#st{lmap=D,lc=New+1}); -renumber_labels([{func_info,_,_,_}=Fi|Is], Acc, St0) -> - renumber_labels(Is, [Fi|Acc], St0#st{entry=St0#st.lc}); -renumber_labels([I|Is], Acc, St0) -> - renumber_labels(Is, [I|Acc], St0); -renumber_labels([], Acc, St0) -> {Acc,St0}. - -function_replace({function,Name,Arity,Entry,Asm0}, Dict) -> - Asm = case catch replace(Asm0, [], Dict) of - {'EXIT',_}=Reason -> - exit(Reason); - {error,{undefined_label,Lbl}=Reason} -> - io:format("Function ~s/~w refers to undefined label ~w\n", - [Name,Arity,Lbl]), - exit(Reason); - Asm1 when list(Asm1) -> Asm1 - end, - {function,Name,Arity,Entry,Asm}. - -replace([{test,Test,{f,Lbl},Ops}|Is], Acc, D) -> - replace(Is, [{test,Test,{f,label(Lbl, D)},Ops}|Acc], D); -replace([{select_val,R,{f,Fail0},{list,Vls0}}|Is], Acc, D) -> - Vls1 = map(fun ({f,L}) -> {f,label(L, D)}; - (Other) -> Other end, Vls0), - Fail = label(Fail0, D), - case redundant_values(Vls1, Fail, []) of - [] -> - %% Oops, no choices left. The loader will not accept that. - %% Convert to a plain jump. - replace(Is, [{jump,{f,Fail}}|Acc], D); - Vls -> - replace(Is, [{select_val,R,{f,Fail},{list,Vls}}|Acc], D) - end; -replace([{select_tuple_arity,R,{f,Fail},{list,Vls0}}|Is], Acc, D) -> - Vls = map(fun ({f,L}) -> {f,label(L, D)}; - (Other) -> Other end, Vls0), - replace(Is, [{select_tuple_arity,R,{f,label(Fail, D)},{list,Vls}}|Acc], D); -replace([{'try',R,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{'try',R,{f,label(Lbl, D)}}|Acc], D); -replace([{'catch',R,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{'catch',R,{f,label(Lbl, D)}}|Acc], D); -replace([{jump,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{jump,{f,label(Lbl, D)}}|Acc], D); -replace([{loop_rec,{f,Lbl},R}|Is], Acc, D) -> - replace(Is, [{loop_rec,{f,label(Lbl, D)},R}|Acc], D); -replace([{loop_rec_end,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{loop_rec_end,{f,label(Lbl, D)}}|Acc], D); -replace([{wait,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{wait,{f,label(Lbl, D)}}|Acc], D); -replace([{wait_timeout,{f,Lbl},To}|Is], Acc, D) -> - replace(Is, [{wait_timeout,{f,label(Lbl, D)},To}|Acc], D); -replace([{bif,Name,{f,Lbl},As,R}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bif,Name,{f,label(Lbl, D)},As,R}|Acc], D); -replace([{call,Ar,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{call,Ar,{f,label(Lbl,D)}}|Acc], D); -replace([{call_last,Ar,{f,Lbl},N}|Is], Acc, D) -> - replace(Is, [{call_last,Ar,{f,label(Lbl,D)},N}|Acc], D); -replace([{call_only,Ar,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{call_only,Ar,{f,label(Lbl, D)}}|Acc], D); -replace([{make_fun,{f,Lbl},U1,U2}|Is], Acc, D) -> - replace(Is, [{make_fun,{f,label(Lbl, D)},U1,U2}|Acc], D); -replace([{make_fun2,{f,Lbl},U1,U2,U3}|Is], Acc, D) -> - replace(Is, [{make_fun2,{f,label(Lbl, D)},U1,U2,U3}|Acc], D); -replace([{bs_init2,{f,Lbl},Sz,Words,R,F,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_init2,{f,label(Lbl, D)},Sz,Words,R,F,Dst}|Acc], D); -replace([{bs_put_integer,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_put_integer,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); -replace([{bs_put_binary,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_put_binary,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); -replace([{bs_put_float,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_put_float,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); -replace([{bs_final,{f,Lbl},R}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_final,{f,label(Lbl, D)},R}|Acc], D); -replace([{bs_add,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_add,{f,label(Lbl, D)},Src,Dst}|Acc], D); -replace([{bs_bits_to_bytes,{f,Lbl},Bits,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_bits_to_bytes,{f,label(Lbl, D)},Bits,Dst}|Acc], D); -replace([I|Is], Acc, D) -> - replace(Is, [I|Acc], D); -replace([], Acc, _) -> Acc. - -label(Old, D) -> - case dict:find(Old, D) of - {ok,Val} -> Val; - error -> throw({error,{undefined_label,Old}}) - end. - -redundant_values([_,{f,Fail}|Vls], Fail, Acc) -> - redundant_values(Vls, Fail, Acc); -redundant_values([Val,Lbl|Vls], Fail, Acc) -> - redundant_values(Vls, Fail, [Lbl,Val|Acc]); -redundant_values([], _, Acc) -> reverse(Acc). diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_dict.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_dict.erl deleted file mode 100644 index ddab957704..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_dict.erl +++ /dev/null @@ -1,196 +0,0 @@ -%% ``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 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. -%% -%% 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: beam_dict.erl,v 1.1 2008/12/17 09:53:41 mikpe Exp $ -%% -%% Purpose : Maintain atom, import, and export tables for assembler. - --module(beam_dict). - --export([new/0, opcode/2, highest_opcode/1, - atom/2, local/4, export/4, import/4, string/2, lambda/5, - atom_table/1, local_table/1, export_table/1, import_table/1, - string_table/1,lambda_table/1]). - --record(asm_dict, - {atoms = [], % [{Index, Atom}] - exports = [], % [{F, A, Label}] - locals = [], % [{F, A, Label}] - imports = [], % [{Index, {M, F, A}] - strings = [], % Deep list of characters - lambdas = [], % [{...}] - next_atom = 1, - next_import = 0, - string_offset = 0, - highest_opcode = 0 - }). - -new() -> - #asm_dict{}. - -%% Remembers highest opcode. - -opcode(Op, Dict) when Dict#asm_dict.highest_opcode > Op -> Dict; -opcode(Op, Dict) -> Dict#asm_dict{highest_opcode=Op}. - -%% Returns the highest opcode encountered. - -highest_opcode(#asm_dict{highest_opcode=Op}) -> Op. - -%% Returns the index for an atom (adding it to the atom table if necessary). -%% atom(Atom, Dict) -> {Index, Dict'} - -atom(Atom, Dict) when atom(Atom) -> - NextIndex = Dict#asm_dict.next_atom, - case lookup_store(Atom, Dict#asm_dict.atoms, NextIndex) of - {Index, _, NextIndex} -> - {Index, Dict}; - {Index, Atoms, NewIndex} -> - {Index, Dict#asm_dict{atoms=Atoms, next_atom=NewIndex}} - end. - -%% Remembers an exported function. -%% export(Func, Arity, Label, Dict) -> Dict' - -export(Func, Arity, Label, Dict0) when atom(Func), integer(Arity), integer(Label) -> - {Index, Dict1} = atom(Func, Dict0), - Dict1#asm_dict{exports = [{Index, Arity, Label}| Dict1#asm_dict.exports]}. - -%% Remembers a local function. -%% local(Func, Arity, Label, Dict) -> Dict' - -local(Func, Arity, Label, Dict0) when atom(Func), integer(Arity), integer(Label) -> - {Index,Dict1} = atom(Func, Dict0), - Dict1#asm_dict{locals = [{Index,Arity,Label}| Dict1#asm_dict.locals]}. - -%% Returns the index for an import entry (adding it to the import table if necessary). -%% import(Mod, Func, Arity, Dict) -> {Index, Dict'} - -import(Mod, Func, Arity, Dict) when atom(Mod), atom(Func), integer(Arity) -> - NextIndex = Dict#asm_dict.next_import, - case lookup_store({Mod, Func, Arity}, Dict#asm_dict.imports, NextIndex) of - {Index, _, NextIndex} -> - {Index, Dict}; - {Index, Imports, NewIndex} -> - {_, D1} = atom(Mod, Dict#asm_dict{imports=Imports, next_import=NewIndex}), - {_, D2} = atom(Func, D1), - {Index, D2} - end. - -%% Returns the index for a string in the string table (adding the string to the -%% table if necessary). -%% string(String, Dict) -> {Offset, Dict'} - -string(Str, Dict) when list(Str) -> - #asm_dict{strings = Strings, string_offset = NextOffset} = Dict, - case old_string(Str, Strings) of - {true, Offset} -> - {Offset, Dict}; - false -> - NewDict = Dict#asm_dict{strings = Strings++Str, - string_offset = NextOffset+length(Str)}, - {NextOffset, NewDict} - end. - -%% Returns the index for a funentry (adding it to the table if necessary). -%% lambda(Dict, Lbl, Index, Uniq, NumFree) -> {Index,Dict'} - -lambda(Lbl, Index, OldUniq, NumFree, #asm_dict{lambdas=Lambdas0}=Dict) -> - OldIndex = length(Lambdas0), - Lambdas = [{Lbl,{OldIndex,Lbl,Index,NumFree,OldUniq}}|Lambdas0], - {OldIndex,Dict#asm_dict{lambdas=Lambdas}}. - -%% Returns the atom table. -%% atom_table(Dict) -> [Length,AtomString...] - -atom_table(#asm_dict{atoms=Atoms, next_atom=NumAtoms}) -> - Sorted = lists:sort(Atoms), - Fun = fun({_, A}) -> - L = atom_to_list(A), - [length(L)|L] - end, - {NumAtoms-1, lists:map(Fun, Sorted)}. - -%% Returns the table of local functions. -%% local_table(Dict) -> {NumLocals, [{Function, Arity, Label}...]} - -local_table(#asm_dict{locals = Locals}) -> - {length(Locals),Locals}. - -%% Returns the export table. -%% export_table(Dict) -> {NumExports, [{Function, Arity, Label}...]} - -export_table(#asm_dict{exports = Exports}) -> - {length(Exports), Exports}. - -%% Returns the import table. -%% import_table(Dict) -> {NumImports, [{Module, Function, Arity}...]} - -import_table(Dict) -> - #asm_dict{imports = Imports, next_import = NumImports} = Dict, - Sorted = lists:sort(Imports), - Fun = fun({_, {Mod, Func, Arity}}) -> - {Atom0, _} = atom(Mod, Dict), - {Atom1, _} = atom(Func, Dict), - {Atom0, Atom1, Arity} - end, - {NumImports, lists:map(Fun, Sorted)}. - -string_table(#asm_dict{strings = Strings, string_offset = Size}) -> - {Size, Strings}. - -lambda_table(#asm_dict{locals=Loc0,lambdas=Lambdas0}) -> - Lambdas1 = sofs:relation(Lambdas0), - Loc = sofs:relation([{Lbl,{F,A}} || {F,A,Lbl} <- Loc0]), - Lambdas2 = sofs:relative_product1(Lambdas1, Loc), - Lambdas = [<<F:32,A:32,Lbl:32,Index:32,NumFree:32,OldUniq:32>> || - {{_,Lbl,Index,NumFree,OldUniq},{F,A}} <- sofs:to_external(Lambdas2)], - {length(Lambdas),Lambdas}. - -%%% Local helper functions. - -lookup_store(Key, Dict, NextIndex) -> - case catch lookup_store1(Key, Dict, NextIndex) of - Index when integer(Index) -> - {Index, Dict, NextIndex}; - {Index, NewDict} -> - {Index, NewDict, NextIndex+1} - end. - -lookup_store1(Key, [Pair|Dict], NextIndex) when Key > element(2, Pair) -> - {Index, NewDict} = lookup_store1(Key, Dict, NextIndex), - {Index, [Pair|NewDict]}; -lookup_store1(Key, [{Index, Key}|_Dict], _NextIndex) -> - throw(Index); -lookup_store1(Key, Dict, NextIndex) -> - {NextIndex, [{NextIndex, Key}|Dict]}. - -%% Search for string Str in the string pool Pool. -%% old_string(Str, Pool) -> false | {true, Offset} - -old_string(Str, Pool) -> - old_string(Str, Pool, 0). - -old_string([C|Str], [C|Pool], Index) -> - case lists:prefix(Str, Pool) of - true -> - {true, Index}; - false -> - old_string([C|Str], Pool, Index+1) - end; -old_string(Str, [_|Pool], Index) -> - old_string(Str, Pool, Index+1); -old_string(_Str, [], _Index) -> - false. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_disasm.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_disasm.erl deleted file mode 100644 index 451b83db66..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_disasm.erl +++ /dev/null @@ -1,964 +0,0 @@ -%% -*- erlang-indent-level: 4 -*- -%%======================================================================= -%% File : beam_disasm.erl -%% Author : Kostis Sagonas -%% Description : Disassembles an R5-R10 .beam file into symbolic BEAM code -%%======================================================================= -%% $Id: beam_disasm.erl,v 1.1 2008/12/17 09:53:41 mikpe Exp $ -%%======================================================================= -%% Notes: -%% 1. It does NOT work for .beam files of previous BEAM versions. -%% 2. If handling of new BEAM instructions is needed, this should be -%% inserted at the end of function resolve_inst(). -%%======================================================================= - --module(beam_disasm). - --export([file/1, format_error/1]). - --author("Kostis Sagonas"). - --include("beam_opcodes.hrl"). - -%%----------------------------------------------------------------------- - --define(NO_DEBUG(Str,Xs),ok). --define(DEBUG(Str,Xs),io:format(Str,Xs)). --define(exit(Reason),exit({?MODULE,?LINE,Reason})). - -%%----------------------------------------------------------------------- -%% Error information - -format_error({error, Module, Error}) -> - Module:format_error(Error); -format_error({internal, Error}) -> - io_lib:format("~p: disassembly failed with reason ~P.", - [?MODULE, Error, 25]). - -%%----------------------------------------------------------------------- -%% The main exported function -%% File is either a file name or a binary containing the code. -%% Returns `{beam_file, [...]}' or `{error, Module, Reason}'. -%% Call `format_error({error, Module, Reason})' for an error string. -%%----------------------------------------------------------------------- - -file(File) -> - case beam_lib:info(File) of - Info when list(Info) -> - {value,{chunks,Chunks}} = lists:keysearch(chunks,1,Info), - case catch process_chunks(File, Chunks) of - {'EXIT', Error} -> - {error, ?MODULE, {internal, Error}}; - Result -> - Result - end; - Error -> - Error - end. - -%%----------------------------------------------------------------------- -%% Interface might need to be revised -- do not depend on it. -%%----------------------------------------------------------------------- - -process_chunks(F,ChunkInfoList) -> - {ok,{_,Chunks}} = beam_lib:chunks(F, ["Atom","Code","StrT","ImpT","ExpT"]), - [{"Atom",AtomBin},{"Code",CodeBin},{"StrT",StrBin}, - {"ImpT",ImpBin},{"ExpT",ExpBin}] = Chunks, - LambdaBin = optional_chunk(F, "FunT", ChunkInfoList), - LocBin = optional_chunk(F, "LocT", ChunkInfoList), - AttrBin = optional_chunk(F, "Attr", ChunkInfoList), - CompBin = optional_chunk(F, "CInf", ChunkInfoList), - Atoms = beam_disasm_atoms(AtomBin), - Exports = beam_disasm_exports(ExpBin, Atoms), - Imports = beam_disasm_imports(ImpBin, Atoms), - LocFuns = beam_disasm_exports(LocBin, Atoms), - Lambdas = beam_disasm_lambdas(LambdaBin, Atoms), - Str = beam_disasm_strings(StrBin), - Str1 = binary_to_list(Str), %% for debugging -- use Str as far as poss. - Sym_Code = beam_disasm_code(CodeBin,Atoms,Imports,Str,Lambdas), - Attributes = beam_disasm_attributes(AttrBin), - CompInfo = beam_disasm_compilation_info(CompBin), - All = [{exports,Exports}, - {imports,Imports}, - {code,Sym_Code}, - {atoms,Atoms}, - {local_funs,LocFuns}, - {strings,Str1}, - {attributes,Attributes}, - {comp_info,CompInfo}], - {beam_file,[Item || {_Key,Data}=Item <- All, Data =/= none]}. - -%%----------------------------------------------------------------------- -%% Retrieve an optional chunk or none if the chunk doesn't exist. -%%----------------------------------------------------------------------- - -optional_chunk(F, ChunkTag, ChunkInfo) -> - case lists:keymember(ChunkTag, 1, ChunkInfo) of - true -> - {ok,{_,[{ChunkTag,Chunk}]}} = beam_lib:chunks(F, [ChunkTag]), - Chunk; - false -> none - end. - -%%----------------------------------------------------------------------- -%% UTILITIES -- these actually exist in file "beam_lib" -%% -- they should be moved into a common utils file. -%%----------------------------------------------------------------------- - -i32([X1,X2,X3,X4]) -> - (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4. - -get_int(B) -> - {I, B1} = split_binary(B, 4), - {i32(binary_to_list(I)), B1}. - -%%----------------------------------------------------------------------- -%% Disassembles the atom table of a BEAM file. -%% - atoms are stored in order 1 ... N (N = Num_atoms, in fact), -%% - each atom name consists of a length byte, followed by that many -%% bytes of name -%% (nb: atom names max 255 chars?!) -%%----------------------------------------------------------------------- - -beam_disasm_atoms(AtomTabBin) -> - {_NumAtoms,B} = get_int(AtomTabBin), - disasm_atoms(B). - -disasm_atoms(AtomBin) -> - disasm_atoms(binary_to_list(AtomBin),1). - -disasm_atoms([Len|Xs],N) -> - {AtomName,Rest} = get_atom_name(Len,Xs), - [{N,list_to_atom(AtomName)}|disasm_atoms(Rest,N+1)]; -disasm_atoms([],_) -> - []. - -get_atom_name(Len,Xs) -> - get_atom_name(Len,Xs,[]). - -get_atom_name(N,[X|Xs],RevName) when N > 0 -> - get_atom_name(N-1,Xs,[X|RevName]); -get_atom_name(0,Xs,RevName) -> - { lists:reverse(RevName), Xs }. - -%%----------------------------------------------------------------------- -%% Disassembles the export table of a BEAM file. -%%----------------------------------------------------------------------- - -beam_disasm_exports(none, _) -> none; -beam_disasm_exports(ExpTabBin, Atoms) -> - {_NumAtoms,B} = get_int(ExpTabBin), - disasm_exports(B,Atoms). - -disasm_exports(Bin,Atoms) -> - resolve_exports(collect_exports(binary_to_list(Bin)),Atoms). - -collect_exports([F3,F2,F1,F0,A3,A2,A1,A0,L3,L2,L1,L0|Exps]) -> - [{i32([F3,F2,F1,F0]), % F = function (atom ID) - i32([A3,A2,A1,A0]), % A = arity (int) - i32([L3,L2,L1,L0])} % L = label (int) - |collect_exports(Exps)]; -collect_exports([]) -> - []. - -resolve_exports(Exps,Atoms) -> - [ {lookup_key(F,Atoms), A, L} || {F,A,L} <- Exps ]. - -%%----------------------------------------------------------------------- -%% Disassembles the import table of a BEAM file. -%%----------------------------------------------------------------------- - -beam_disasm_imports(ExpTabBin,Atoms) -> - {_NumAtoms,B} = get_int(ExpTabBin), - disasm_imports(B,Atoms). - -disasm_imports(Bin,Atoms) -> - resolve_imports(collect_imports(binary_to_list(Bin)),Atoms). - -collect_imports([M3,M2,M1,M0,F3,F2,F1,F0,A3,A2,A1,A0|Exps]) -> - [{i32([M3,M2,M1,M0]), % M = module (atom ID) - i32([F3,F2,F1,F0]), % F = function (atom ID) - i32([A3,A2,A1,A0])} % A = arity (int) - |collect_imports(Exps)]; -collect_imports([]) -> - []. - -resolve_imports(Exps,Atoms) -> - [{extfunc,lookup_key(M,Atoms),lookup_key(F,Atoms),A} || {M,F,A} <- Exps ]. - -%%----------------------------------------------------------------------- -%% Disassembles the lambda (fun) table of a BEAM file. -%%----------------------------------------------------------------------- - -beam_disasm_lambdas(none, _) -> none; -beam_disasm_lambdas(<<_:32,Tab/binary>>, Atoms) -> - disasm_lambdas(Tab, Atoms, 0). - -disasm_lambdas(<<F:32,A:32,Lbl:32,Index:32,NumFree:32,OldUniq:32,More/binary>>, - Atoms, OldIndex) -> - Info = {lookup_key(F, Atoms),A,Lbl,Index,NumFree,OldUniq}, - [{OldIndex,Info}|disasm_lambdas(More, Atoms, OldIndex+1)]; -disasm_lambdas(<<>>, _, _) -> []. - -%%----------------------------------------------------------------------- -%% Disassembles the code chunk of a BEAM file: -%% - The code is first disassembled into a long list of instructions. -%% - This list is then split into functions and all names are resolved. -%%----------------------------------------------------------------------- - -beam_disasm_code(CodeBin,Atoms,Imports,Str,Lambdas) -> - [_SS3,_SS2,_SS1,_SS0, % Sub-Size (length of information before code) - _IS3,_IS2,_IS1,_IS0, % Instruction Set Identifier (always 0) - _OM3,_OM2,_OM1,_OM0, % Opcode Max - _L3,_L2,_L1,_L0,_F3,_F2,_F1,_F0|Code] = binary_to_list(CodeBin), - case catch disasm_code(Code, Atoms) of - {'EXIT',Rsn} -> - ?NO_DEBUG('code disasm failed: ~p~n',[Rsn]), - ?exit(Rsn); - DisasmCode -> - Functions = get_function_chunks(DisasmCode), - LocLabels = local_labels(Functions), - [resolve_names(F,Imports,Str,LocLabels,Lambdas) || F <- Functions] - end. - -%%----------------------------------------------------------------------- - -disasm_code([B|Bs], Atoms) -> - {Instr,RestBs} = disasm_instr(B, Bs, Atoms), - [Instr|disasm_code(RestBs, Atoms)]; -disasm_code([], _) -> []. - -%%----------------------------------------------------------------------- -%% Splits the code stream into chunks representing the code of functions. -%% -%% NOTE: code actually looks like -%% label L1: ... label Ln: -%% func_info ... -%% label entry: -%% ... -%% <on failure, use label Li to show where things died> -%% ... -%% So the labels before each func_info should be included as well. -%% Ideally, only one such label is needed, but the BEAM compiler -%% before R8 didn't care to remove the redundant ones. -%%----------------------------------------------------------------------- - -get_function_chunks([I|Code]) -> - {LastI,RestCode,Labs} = split_head_labels(I,Code,[]), - get_funs(LastI,RestCode,Labs,[]); -get_function_chunks([]) -> - ?exit(empty_code_segment). - -get_funs(PrevI,[I|Is],RevF,RevFs) -> - case I of - {func_info,_Info} -> - [H|T] = RevF, - {Last,Fun,TrailingLabels} = split_head_labels(H,T,[]), - get_funs(I, Is, [PrevI|TrailingLabels], add_funs([Last|Fun],RevFs)); - _ -> - get_funs(I, Is, [PrevI|RevF], RevFs) - end; -get_funs(PrevI,[],RevF,RevFs) -> - case PrevI of - {int_code_end,[]} -> - emit_funs(add_fun(RevF,RevFs)); - _ -> - ?DEBUG('warning: code segment did not end with int_code_end~n',[]), - emit_funs(add_funs([PrevI|RevF],RevFs)) - end. - -split_head_labels({label,L},[I|Code],Labs) -> - split_head_labels(I,Code,[{label,L}|Labs]); -split_head_labels(I,Code,Labs) -> - {I,Code,Labs}. - -add_fun([],Fs) -> - Fs; -add_fun(F,Fs) -> - add_funs(F,Fs). - -add_funs(F,Fs) -> - [ lists:reverse(F) | Fs ]. - -emit_funs(Fs) -> - lists:reverse(Fs). - -%%----------------------------------------------------------------------- -%% Collects local labels -- I am not sure this is 100% what is needed. -%%----------------------------------------------------------------------- - -local_labels(Funs) -> - [local_label(Fun) || Fun <- Funs]. - -%% The first clause below attempts to provide some (limited form of) -%% backwards compatibility; it is not needed for .beam files generated -%% by the R8 compiler. The clause should one fine day be taken out. -local_label([{label,_},{label,L}|Code]) -> - local_label([{label,L}|Code]); -local_label([{label,_}, - {func_info,[M0,F0,{u,A}]}, - {label,[{u,L1}]}|_]) -> - {atom,M} = resolve_arg(M0), - {atom,F} = resolve_arg(F0), - {L1, {M, F, A}}; -local_label(Code) -> - io:format('beam_disasm: no label in ~p~n', [Code]), - {-666,{none,none,0}}. - -%%----------------------------------------------------------------------- -%% Disassembles a single BEAM instruction; most instructions are handled -%% in a generic way; indexing instructions are handled separately. -%%----------------------------------------------------------------------- - -disasm_instr(B, Bs, Atoms) -> - {SymOp,Arity} = beam_opcodes:opname(B), - case SymOp of - select_val -> - disasm_select_inst(select_val, Bs, Atoms); - select_tuple_arity -> - disasm_select_inst(select_tuple_arity, Bs, Atoms); - _ -> - case catch decode_n_args(Arity, Bs, Atoms) of - {'EXIT',Rsn} -> - ?NO_DEBUG("decode_n_args(~p,~p) failed~n",[Arity,Bs]), - {{'EXIT',{SymOp,Arity,Rsn}},[]}; - {Args,RestBs} -> - ?NO_DEBUG("instr ~p~n",[{SymOp,Args}]), - {{SymOp,Args}, RestBs} - end - end. - -%%----------------------------------------------------------------------- -%% Disassembles a BEAM select_* instruction used for indexing. -%% Currently handles {select_val,3} and {select_tuple_arity,3} insts. -%% -%% The arruments of a "select"-type instruction look as follows: -%% <reg>, {f,FailLabel}, {list, <num cases>, [<case1> ... <caseN>]} -%% where each case is of the form [symbol,{f,Label}]. -%%----------------------------------------------------------------------- - -disasm_select_inst(Inst, Bs, Atoms) -> - {X, Bs1} = decode_arg(Bs, Atoms), - {F, Bs2} = decode_arg(Bs1, Atoms), - {Z, Bs3} = decode_arg(Bs2, Atoms), - {U, Bs4} = decode_arg(Bs3, Atoms), - {u,Len} = U, - {List, RestBs} = decode_n_args(Len, Bs4, Atoms), - {{Inst,[X,F,{Z,U,List}]},RestBs}. - -%%----------------------------------------------------------------------- -%% decode_arg([Byte]) -> { Arg, [Byte] } -%% -%% - an arg can have variable length, so we must return arg + remaining bytes -%% - decodes an argument into its 'raw' form: { Tag, Value } -%% several types map to a single tag, so the byte code instr must then -%% assign a type to it -%%----------------------------------------------------------------------- - -decode_arg([B|Bs]) -> - Tag = decode_tag(B band 2#111), - ?NO_DEBUG('Tag = ~p, B = ~p, Bs = ~p~n',[Tag,B,Bs]), - case Tag of - z -> - decode_z_tagged(Tag, B, Bs); - _ -> - %% all other cases are handled as if they were integers - decode_int(Tag, B, Bs) - end. - -decode_arg([B|Bs0], Atoms) -> - Tag = decode_tag(B band 2#111), - ?NO_DEBUG('Tag = ~p, B = ~p, Bs = ~p~n',[Tag,B,Bs]), - case Tag of - z -> - decode_z_tagged(Tag, B, Bs0); - a -> - %% atom or nil - case decode_int(Tag, B, Bs0) of - {{a,0},Bs} -> {nil,Bs}; - {{a,I},Bs} -> {{atom,lookup_key(I, Atoms)},Bs} - end; - _ -> - %% all other cases are handled as if they were integers - decode_int(Tag, B, Bs0) - end. - -%%----------------------------------------------------------------------- -%% Decodes an integer value. Handles positives, negatives, and bignums. -%% -%% Tries to do the opposite of: -%% beam_asm:encode(1, 5) = [81] -%% beam_asm:encode(1, 1000) = [105,232] -%% beam_asm:encode(1, 2047) = [233,255] -%% beam_asm:encode(1, 2048) = [25,8,0] -%% beam_asm:encode(1,-1) = [25,255,255] -%% beam_asm:encode(1,-4294967295) = [121,255,0,0,0,1] -%% beam_asm:encode(1, 4294967295) = [121,0,255,255,255,255] -%% beam_asm:encode(1, 429496729501) = [121,99,255,255,255,157] -%%----------------------------------------------------------------------- - -decode_int(Tag,B,Bs) when (B band 16#08) == 0 -> - %% N < 16 = 4 bits, NNNN:0:TTT - N = B bsr 4, - {{Tag,N},Bs}; -decode_int(Tag,B,Bs) when (B band 16#10) == 0 -> - %% N < 2048 = 11 bits = 3:8 bits, NNN:01:TTT, NNNNNNNN - [B1|Bs1] = Bs, - Val0 = B band 2#11100000, - N = (Val0 bsl 3) bor B1, - ?NO_DEBUG('NNN:01:TTT, NNNNNNNN = ~n~p:01:~p, ~p = ~p~n', [Val0,Tag,B,N]), - {{Tag,N},Bs1}; -decode_int(Tag,B,Bs) -> - {Len,Bs1} = decode_int_length(B,Bs), - {IntBs,RemBs} = take_bytes(Len,Bs1), - N = build_arg(IntBs), - [F|_] = IntBs, - Num = if F > 127, Tag == i -> decode_negative(N,Len); - true -> N - end, - ?NO_DEBUG('Len = ~p, IntBs = ~p, Num = ~p~n', [Len,IntBs,Num]), - {{Tag,Num},RemBs}. - -decode_int_length(B,Bs) -> - %% The following imitates get_erlang_integer() in beam_load.c - %% Len is the size of the integer value in bytes - case B bsr 5 of - 7 -> - {Arg,ArgBs} = decode_arg(Bs), - case Arg of - {u,L} -> - {L+9,ArgBs}; % 9 stands for 7+2 - _ -> - ?exit({decode_int,weird_bignum_sublength,Arg}) - end; - L -> - {L+2,Bs} - end. - -decode_negative(N,Len) -> - N - (1 bsl (Len*8)). % 8 is number of bits in a byte - -%%----------------------------------------------------------------------- -%% Decodes lists and floating point numbers. -%%----------------------------------------------------------------------- - -decode_z_tagged(Tag,B,Bs) when (B band 16#08) == 0 -> - N = B bsr 4, - case N of - 0 -> % float - decode_float(Bs); - 1 -> % list - {{Tag,N},Bs}; - 2 -> % fr - decode_fr(Bs); - 3 -> % allocation list - decode_alloc_list(Bs); - _ -> - ?exit({decode_z_tagged,{invalid_extended_tag,N}}) - end; -decode_z_tagged(_,B,_) -> - ?exit({decode_z_tagged,{weird_value,B}}). - -decode_float(Bs) -> - {FL,RestBs} = take_bytes(8,Bs), - <<Float:64/float>> = list_to_binary(FL), - {{float,Float},RestBs}. - -decode_fr(Bs) -> - {{u,Fr},RestBs} = decode_arg(Bs), - {{fr,Fr},RestBs}. - -decode_alloc_list(Bs) -> - {{u,N},RestBs} = decode_arg(Bs), - decode_alloc_list_1(N, RestBs, []). - -decode_alloc_list_1(0, RestBs, Acc) -> - {{u,{alloc,lists:reverse(Acc)}},RestBs}; -decode_alloc_list_1(N, Bs0, Acc) -> - {{u,Type},Bs1} = decode_arg(Bs0), - {{u,Val},Bs} = decode_arg(Bs1), - case Type of - 0 -> - decode_alloc_list_1(N-1, Bs, [{words,Val}|Acc]); - 1 -> - decode_alloc_list_1(N-1, Bs, [{floats,Val}|Acc]) - end. - -%%----------------------------------------------------------------------- -%% take N bytes from a stream, return { Taken_bytes, Remaining_bytes } -%%----------------------------------------------------------------------- - -take_bytes(N,Bs) -> - take_bytes(N,Bs,[]). - -take_bytes(N,[B|Bs],Acc) when N > 0 -> - take_bytes(N-1,Bs,[B|Acc]); -take_bytes(0,Bs,Acc) -> - { lists:reverse(Acc), Bs }. - -%%----------------------------------------------------------------------- -%% from a list of bytes Bn,Bn-1,...,B1,B0 -%% build (Bn << 8*n) bor ... bor B1 << 8 bor B0 << 0 -%%----------------------------------------------------------------------- - -build_arg(Bs) -> - build_arg(Bs,0). - -build_arg([B|Bs],N) -> - build_arg(Bs, (N bsl 8) bor B); -build_arg([],N) -> - N. - -%%----------------------------------------------------------------------- -%% Decodes a bunch of arguments and returns them in a list -%%----------------------------------------------------------------------- - -decode_n_args(N, Bs, Atoms) when N >= 0 -> - decode_n_args(N, [], Bs, Atoms). - -decode_n_args(N, Acc, Bs0, Atoms) when N > 0 -> - {A1,Bs} = decode_arg(Bs0, Atoms), - decode_n_args(N-1, [A1|Acc], Bs, Atoms); -decode_n_args(0, Acc, Bs, _) -> - {lists:reverse(Acc),Bs}. - -%%----------------------------------------------------------------------- -%% Convert a numeric tag value into a symbolic one -%%----------------------------------------------------------------------- - -decode_tag(?tag_u) -> u; -decode_tag(?tag_i) -> i; -decode_tag(?tag_a) -> a; -decode_tag(?tag_x) -> x; -decode_tag(?tag_y) -> y; -decode_tag(?tag_f) -> f; -decode_tag(?tag_h) -> h; -decode_tag(?tag_z) -> z; -decode_tag(X) -> ?exit({unknown_tag,X}). - -%%----------------------------------------------------------------------- -%% - replace all references {a,I} with the atom with index I (or {atom,A}) -%% - replace all references to {i,K} in an external call position with -%% the proper MFA (position in list, first elt = 0, yields MFA to use) -%% - resolve strings, represented as <offset, length>, into their -%% actual values by using string table -%% (note: string table should be passed as a BINARY so that we can -%% use binary_to_list/3!) -%% - convert instruction to its readable form ... -%% -%% Currently, only the first three are done (systematically, at least). -%% -%% Note: It MAY be premature to remove the lists of args, since that -%% representation means it is simpler to iterate over all args, etc. -%%----------------------------------------------------------------------- - -resolve_names(Fun, Imports, Str, Lbls, Lambdas) -> - [resolve_inst(Instr, Imports, Str, Lbls, Lambdas) || Instr <- Fun]. - -%% -%% New make_fun2/4 instruction added in August 2001 (R8). -%% We handle it specially here to avoid adding an argument to -%% the clause for every instruction. -%% - -resolve_inst({make_fun2,Args},_,_,Lbls,Lambdas) -> - [OldIndex] = resolve_args(Args), - {value,{OldIndex,{F,A,_Lbl,_Index,NumFree,OldUniq}}} = - lists:keysearch(OldIndex, 1, Lambdas), - [{_,{M,_,_}}|_] = Lbls, % Slighly kludgy. - {make_fun2,{M,F,A},OldIndex,OldUniq,NumFree}; -resolve_inst(Instr, Imports, Str, Lbls, _Lambdas) -> - resolve_inst(Instr, Imports, Str, Lbls). - -resolve_inst({label,[{u,L}]},_,_,_) -> - {label,L}; -resolve_inst({func_info,RawMFA},_,_,_) -> - {func_info,resolve_args(RawMFA)}; -% resolve_inst(int_code_end,_,_,_,_) -> % instruction already handled -% int_code_end; % should not really be handled here -resolve_inst({call,[{u,N},{f,L}]},_,_,Lbls) -> - {call,N,catch lookup_key(L,Lbls)}; -resolve_inst({call_last,[{u,N},{f,L},{u,U}]},_,_,Lbls) -> - {call_last,N,catch lookup_key(L,Lbls),U}; -resolve_inst({call_only,[{u,N},{f,L}]},_,_,Lbls) -> - {call_only,N,catch lookup_key(L,Lbls)}; -resolve_inst({call_ext,[{u,N},{u,MFAix}]},Imports,_,_) -> - {call_ext,N,catch lists:nth(MFAix+1,Imports)}; -resolve_inst({call_ext_last,[{u,N},{u,MFAix},{u,X}]},Imports,_,_) -> - {call_ext_last,N,catch lists:nth(MFAix+1,Imports),X}; -resolve_inst({bif0,Args},Imports,_,_) -> - [Bif,Reg] = resolve_args(Args), - {extfunc,_Mod,BifName,_Arity} = lists:nth(Bif+1,Imports), - %?NO_DEBUG('bif0(~p, ~p)~n',[BifName,Reg]), - {bif,BifName,nofail,[],Reg}; -resolve_inst({bif1,Args},Imports,_,_) -> - [F,Bif,A1,Reg] = resolve_args(Args), - {extfunc,_Mod,BifName,_Arity} = lists:nth(Bif+1,Imports), - %?NO_DEBUG('bif1(~p, ~p, ~p, ~p, ~p)~n',[Bif,BifName,F,[A1],Reg]), - {bif,BifName,F,[A1],Reg}; -resolve_inst({bif2,Args},Imports,_,_) -> - [F,Bif,A1,A2,Reg] = resolve_args(Args), - {extfunc,_Mod,BifName,_Arity} = lists:nth(Bif+1,Imports), - %?NO_DEBUG('bif2(~p, ~p, ~p, ~p, ~p)~n',[Bif,BifName,F,[A1,A2],Reg]), - {bif,BifName,F,[A1,A2],Reg}; -resolve_inst({allocate,[{u,X0},{u,X1}]},_,_,_) -> - {allocate,X0,X1}; -resolve_inst({allocate_heap,[{u,X0},{u,X1},{u,X2}]},_,_,_) -> - {allocate_heap,X0,X1,X2}; -resolve_inst({allocate_zero,[{u,X0},{u,X1}]},_,_,_) -> - {allocate_zero,X0,X1}; -resolve_inst({allocate_heap_zero,[{u,X0},{u,X1},{u,X2}]},_,_,_) -> - {allocate_heap_zero,X0,X1,X2}; -resolve_inst({test_heap,[{u,X0},{u,X1}]},_,_,_) -> - {test_heap,X0,X1}; -resolve_inst({init,[Dst]},_,_,_) -> - {init,Dst}; -resolve_inst({deallocate,[{u,L}]},_,_,_) -> - {deallocate,L}; -resolve_inst({return,[]},_,_,_) -> - return; -resolve_inst({send,[]},_,_,_) -> - send; -resolve_inst({remove_message,[]},_,_,_) -> - remove_message; -resolve_inst({timeout,[]},_,_,_) -> - timeout; -resolve_inst({loop_rec,[Lbl,Dst]},_,_,_) -> - {loop_rec,Lbl,Dst}; -resolve_inst({loop_rec_end,[Lbl]},_,_,_) -> - {loop_rec_end,Lbl}; -resolve_inst({wait,[Lbl]},_,_,_) -> - {wait,Lbl}; -resolve_inst({wait_timeout,[Lbl,Int]},_,_,_) -> - {wait_timeout,Lbl,resolve_arg(Int)}; -resolve_inst({m_plus,Args},_,_,_) -> - [W,SrcR1,SrcR2,DstR] = resolve_args(Args), - {arithbif,'+',W,[SrcR1,SrcR2],DstR}; -resolve_inst({m_minus,Args},_,_,_) -> - [W,SrcR1,SrcR2,DstR] = resolve_args(Args), - {arithbif,'-',W,[SrcR1,SrcR2],DstR}; -resolve_inst({m_times,Args},_,_,_) -> - [W,SrcR1,SrcR2,DstR] = resolve_args(Args), - {arithbif,'*',W,[SrcR1,SrcR2],DstR}; -resolve_inst({m_div,Args},_,_,_) -> - [W,SrcR1,SrcR2,DstR] = resolve_args(Args), - {arithbif,'/',W,[SrcR1,SrcR2],DstR}; -resolve_inst({int_div,Args},_,_,_) -> - [W,SrcR1,SrcR2,DstR] = resolve_args(Args), - {arithbif,'div',W,[SrcR1,SrcR2],DstR}; -resolve_inst({int_rem,Args},_,_,_) -> - [W,SrcR1,SrcR2,DstR] = resolve_args(Args), - {arithbif,'rem',W,[SrcR1,SrcR2],DstR}; -resolve_inst({int_band,Args},_,_,_) -> - [W,SrcR1,SrcR2,DstR] = resolve_args(Args), - {arithbif,'band',W,[SrcR1,SrcR2],DstR}; -resolve_inst({int_bor,Args},_,_,_) -> - [W,SrcR1,SrcR2,DstR] = resolve_args(Args), - {arithbif,'bor',W,[SrcR1,SrcR2],DstR}; -resolve_inst({int_bxor,Args},_,_,_) -> - [W,SrcR1,SrcR2,DstR] = resolve_args(Args), - {arithbif,'bxor',W,[SrcR1,SrcR2],DstR}; -resolve_inst({int_bsl,Args},_,_,_) -> - [W,SrcR1,SrcR2,DstR] = resolve_args(Args), - {arithbif,'bsl',W,[SrcR1,SrcR2],DstR}; -resolve_inst({int_bsr,Args},_,_,_) -> - [W,SrcR1,SrcR2,DstR] = resolve_args(Args), - {arithbif,'bsr',W,[SrcR1,SrcR2],DstR}; -resolve_inst({int_bnot,Args},_,_,_) -> - [W,SrcR,DstR] = resolve_args(Args), - {arithbif,'bnot',W,[SrcR],DstR}; -resolve_inst({is_lt=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_ge=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_eq=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_ne=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_eq_exact=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_ne_exact=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_integer=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_float=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_number=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_atom=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_pid=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_reference=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_port=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_nil=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_binary=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_constant=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_list=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_nonempty_list=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({is_tuple=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({test_arity=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({select_val,Args},_,_,_) -> - [Reg,FLbl,{{z,1},{u,_Len},List0}] = Args, - List = resolve_args(List0), - {select_val,Reg,FLbl,{list,List}}; -resolve_inst({select_tuple_arity,Args},_,_,_) -> - [Reg,FLbl,{{z,1},{u,_Len},List0}] = Args, - List = resolve_args(List0), - {select_tuple_arity,Reg,FLbl,{list,List}}; -resolve_inst({jump,[Lbl]},_,_,_) -> - {jump,Lbl}; -resolve_inst({'catch',[Dst,Lbl]},_,_,_) -> - {'catch',Dst,Lbl}; -resolve_inst({catch_end,[Dst]},_,_,_) -> - {catch_end,Dst}; -resolve_inst({move,[Src,Dst]},_,_,_) -> - {move,resolve_arg(Src),Dst}; -resolve_inst({get_list,[Src,Dst1,Dst2]},_,_,_) -> - {get_list,Src,Dst1,Dst2}; -resolve_inst({get_tuple_element,[Src,{u,Off},Dst]},_,_,_) -> - {get_tuple_element,resolve_arg(Src),Off,resolve_arg(Dst)}; -resolve_inst({set_tuple_element,[Src,Dst,{u,Off}]},_,_,_) -> - {set_tuple_element,resolve_arg(Src),resolve_arg(Dst),Off}; -resolve_inst({put_string,[{u,Len},{u,Off},Dst]},_,Strings,_) -> - String = if Len > 0 -> binary_to_list(Strings, Off+1, Off+Len); - true -> "" - end, -?NO_DEBUG('put_string(~p, {string,~p}, ~p)~n',[Len,String,Dst]), - {put_string,Len,{string,String},Dst}; -resolve_inst({put_list,[Src1,Src2,Dst]},_,_,_) -> - {put_list,resolve_arg(Src1),resolve_arg(Src2),Dst}; -resolve_inst({put_tuple,[{u,Arity},Dst]},_,_,_) -> - {put_tuple,Arity,Dst}; -resolve_inst({put,[Src]},_,_,_) -> - {put,resolve_arg(Src)}; -resolve_inst({badmatch,[X]},_,_,_) -> - {badmatch,resolve_arg(X)}; -resolve_inst({if_end,[]},_,_,_) -> - if_end; -resolve_inst({case_end,[X]},_,_,_) -> - {case_end,resolve_arg(X)}; -resolve_inst({call_fun,[{u,N}]},_,_,_) -> - {call_fun,N}; -resolve_inst({make_fun,Args},_,_,Lbls) -> - [{f,L},Magic,FreeVars] = resolve_args(Args), - {make_fun,catch lookup_key(L,Lbls),Magic,FreeVars}; -resolve_inst({is_function=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; -resolve_inst({call_ext_only,[{u,N},{u,MFAix}]},Imports,_,_) -> - {call_ext_only,N,catch lists:nth(MFAix+1,Imports)}; -%% -%% Instructions for handling binaries added in R7A & R7B -%% -resolve_inst({bs_start_match,[F,Reg]},_,_,_) -> - {bs_start_match,F,Reg}; -resolve_inst({bs_get_integer=I,[Lbl,Arg2,{u,N},{u,U},Arg5]},_,_,_) -> - [A2,A5] = resolve_args([Arg2,Arg5]), - {test,I,Lbl,[A2,N,decode_field_flags(U),A5]}; -resolve_inst({bs_get_float=I,[Lbl,Arg2,{u,N},{u,U},Arg5]},_,_,_) -> - [A2,A5] = resolve_args([Arg2,Arg5]), - {test,I,Lbl,[A2,N,decode_field_flags(U),A5]}; -resolve_inst({bs_get_binary=I,[Lbl,Arg2,{u,N},{u,U},Arg5]},_,_,_) -> - [A2,A5] = resolve_args([Arg2,Arg5]), - {test,I,Lbl,[A2,N,decode_field_flags(U),A5]}; -resolve_inst({bs_skip_bits,[Lbl,Arg2,{u,N},{u,U}]},_,_,_) -> - [A2] = resolve_args([Arg2]), - {test,bs_skip_bits,Lbl,[A2,N,decode_field_flags(U)]}; -resolve_inst({bs_test_tail,[F,{u,N}]},_,_,_) -> - {test,bs_test_tail,F,[N]}; -resolve_inst({bs_save,[{u,N}]},_,_,_) -> - {bs_save,N}; -resolve_inst({bs_restore,[{u,N}]},_,_,_) -> - {bs_restore,N}; -resolve_inst({bs_init,[{u,N},{u,U}]},_,_,_) -> - {bs_init,N,decode_field_flags(U)}; -resolve_inst({bs_final,[F,X]},_,_,_) -> - {bs_final,F,X}; -resolve_inst({bs_put_integer,[Lbl,Arg2,{u,N},{u,U},Arg5]},_,_,_) -> - [A2,A5] = resolve_args([Arg2,Arg5]), - {bs_put_integer,Lbl,A2,N,decode_field_flags(U),A5}; -resolve_inst({bs_put_binary,[Lbl,Arg2,{u,N},{u,U},Arg5]},_,_,_) -> - [A2,A5] = resolve_args([Arg2,Arg5]), - ?NO_DEBUG('bs_put_binary(~p,~p,~p,~p,~p})~n',[Lbl,A2,N,U,A5]), - {bs_put_binary,Lbl,A2,N,decode_field_flags(U),A5}; -resolve_inst({bs_put_float,[Lbl,Arg2,{u,N},{u,U},Arg5]},_,_,_) -> - [A2,A5] = resolve_args([Arg2,Arg5]), - ?NO_DEBUG('bs_put_float(~p,~p,~p,~p,~p})~n',[Lbl,A2,N,U,A5]), - {bs_put_float,Lbl,A2,N,decode_field_flags(U),A5}; -resolve_inst({bs_put_string,[{u,Len},{u,Off}]},_,Strings,_) -> - String = if Len > 0 -> binary_to_list(Strings, Off+1, Off+Len); - true -> "" - end, - ?NO_DEBUG('bs_put_string(~p, {string,~p})~n',[Len,String]), - {bs_put_string,Len,{string,String}}; -resolve_inst({bs_need_buf,[{u,N}]},_,_,_) -> - {bs_need_buf,N}; - -%% -%% Instructions for handling floating point numbers added in June 2001 (R8). -%% -resolve_inst({fclearerror,[]},_,_,_) -> - fclearerror; -resolve_inst({fcheckerror,Args},_,_,_) -> - [Fail] = resolve_args(Args), - {fcheckerror,Fail}; -resolve_inst({fmove,Args},_,_,_) -> - [FR,Reg] = resolve_args(Args), - {fmove,FR,Reg}; -resolve_inst({fconv,Args},_,_,_) -> - [Reg,FR] = resolve_args(Args), - {fconv,Reg,FR}; -resolve_inst({fadd=I,Args},_,_,_) -> - [F,A1,A2,Reg] = resolve_args(Args), - {arithfbif,I,F,[A1,A2],Reg}; -resolve_inst({fsub=I,Args},_,_,_) -> - [F,A1,A2,Reg] = resolve_args(Args), - {arithfbif,I,F,[A1,A2],Reg}; -resolve_inst({fmul=I,Args},_,_,_) -> - [F,A1,A2,Reg] = resolve_args(Args), - {arithfbif,I,F,[A1,A2],Reg}; -resolve_inst({fdiv=I,Args},_,_,_) -> - [F,A1,A2,Reg] = resolve_args(Args), - {arithfbif,I,F,[A1,A2],Reg}; -resolve_inst({fnegate,Args},_,_,_) -> - [F,Arg,Reg] = resolve_args(Args), - {arithfbif,fnegate,F,[Arg],Reg}; - -%% -%% Instructions for try expressions added in January 2003 (R10). -%% - -resolve_inst({'try',[Reg,Lbl]},_,_,_) -> % analogous to 'catch' - {'try',Reg,Lbl}; -resolve_inst({try_end,[Reg]},_,_,_) -> % analogous to 'catch_end' - {try_end,Reg}; -resolve_inst({try_case,[Reg]},_,_,_) -> % analogous to 'catch_end' - {try_case,Reg}; -resolve_inst({try_case_end,[Reg]},_,_,_) -> - {try_case_end,Reg}; -resolve_inst({raise,[Reg1,Reg2]},_,_,_) -> - {bif,raise,{f,0},[Reg1,Reg2],{x,0}}; - -%% -%% New bit syntax instructions added in February 2004 (R10B). -%% - -resolve_inst({bs_init2,[Lbl,Arg2,{u,W},{u,R},{u,F},Arg6]},_,_,_) -> - [A2,A6] = resolve_args([Arg2,Arg6]), - {bs_init2,Lbl,A2,W,R,decode_field_flags(F),A6}; -resolve_inst({bs_bits_to_bytes,[Lbl,Arg2,Arg3]},_,_,_) -> - [A2,A3] = resolve_args([Arg2,Arg3]), - {bs_bits_to_bytes,Lbl,A2,A3}; -resolve_inst({bs_add=I,[Lbl,Arg2,Arg3,Arg4,Arg5]},_,_,_) -> - [A2,A3,A4,A5] = resolve_args([Arg2,Arg3,Arg4,Arg5]), - {I,Lbl,[A2,A3,A4],A5}; - -%% -%% New apply instructions added in April 2004 (R10B). -%% -resolve_inst({apply,[{u,Arity}]},_,_,_) -> - {apply,Arity}; -resolve_inst({apply_last,[{u,Arity},{u,D}]},_,_,_) -> - {apply_last,Arity,D}; - -%% -%% New test instruction added in April 2004 (R10B). -%% -resolve_inst({is_boolean=I,Args0},_,_,_) -> - [L|Args] = resolve_args(Args0), - {test,I,L,Args}; - -%% -%% Catches instructions that are not yet handled. -%% - -resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}). - -%%----------------------------------------------------------------------- -%% Resolves arguments in a generic way. -%%----------------------------------------------------------------------- - -resolve_args(Args) -> [resolve_arg(A) || A <- Args]. - -resolve_arg({u,N}) -> N; -resolve_arg({i,N}) -> {integer,N}; -resolve_arg({atom,Atom}=A) when is_atom(Atom) -> A; -resolve_arg(nil) -> nil; -resolve_arg(Arg) -> Arg. - -%%----------------------------------------------------------------------- -%% The purpose of the following is just to add a hook for future changes. -%% Currently, field flags are numbers 1-2-4-8 and only two of these -%% numbers (BSF_LITTLE 2 -- BSF_SIGNED 4) have a semantic significance; -%% others are just hints for speeding up the execution; see "erl_bits.h". -%%----------------------------------------------------------------------- - -decode_field_flags(FF) -> - {field_flags,FF}. - -%%----------------------------------------------------------------------- -%% Each string is denoted in the assembled code by its offset into this -%% binary. This binary contains all strings concatenated together. -%%----------------------------------------------------------------------- - -beam_disasm_strings(Bin) -> - Bin. - -%%----------------------------------------------------------------------- -%% Disassembles the attributes of a BEAM file. -%%----------------------------------------------------------------------- - -beam_disasm_attributes(none) -> none; -beam_disasm_attributes(AttrBin) -> binary_to_term(AttrBin). - -%%----------------------------------------------------------------------- -%% Disassembles the compilation information of a BEAM file. -%%----------------------------------------------------------------------- - -beam_disasm_compilation_info(none) -> none; -beam_disasm_compilation_info(Bin) -> binary_to_term(Bin). - -%%----------------------------------------------------------------------- -%% Private Utilities -%%----------------------------------------------------------------------- - -%%----------------------------------------------------------------------- - -lookup_key(Key,[{Key,Val}|_]) -> - Val; -lookup_key(Key,[_|KVs]) -> - lookup_key(Key,KVs); -lookup_key(Key,[]) -> - ?exit({lookup_key,{key_not_found,Key}}). - -%%----------------------------------------------------------------------- diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_flatten.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_flatten.erl deleted file mode 100644 index a9958f87cd..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_flatten.erl +++ /dev/null @@ -1,137 +0,0 @@ -%% ``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 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. -%% -%% 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: beam_flatten.erl,v 1.1 2008/12/17 09:53:41 mikpe Exp $ -%% -%% Purpose : Converts intermediate assembly code to final format. - --module(beam_flatten). - --export([module/2]). --import(lists, [reverse/1,reverse/2,map/2]). - -module({Mod,Exp,Attr,Fs,Lc}, _Opt) -> - {ok,{Mod,Exp,Attr,map(fun function/1, Fs),Lc}}. - -function({function,Name,Arity,CLabel,Is0}) -> - Is1 = block(Is0), - Is = opt(Is1), - {function,Name,Arity,CLabel,Is}. - -block(Is) -> - block(Is, []). - -block([{block,Is0}|Is1], Acc) -> block(Is1, norm_block(Is0, Acc)); -block([I|Is], Acc) -> block(Is, [I|Acc]); -block([], Acc) -> reverse(Acc). - -norm_block([{allocate,R,Alloc}|Is], Acc0) -> - case insert_alloc_in_bs_init(Acc0, Alloc) of - not_possible -> - norm_block(Is, reverse(norm_allocate(Alloc, R), Acc0)); - Acc -> - norm_block(Is, Acc) - end; -norm_block([I|Is], Acc) -> norm_block(Is, [norm(I)|Acc]); -norm_block([], Acc) -> Acc. - -norm({set,[D],As,{bif,N}}) -> {bif,N,nofail,As,D}; -norm({set,[D],As,{bif,N,F}}) -> {bif,N,F,As,D}; -norm({set,[D],[S],move}) -> {move,S,D}; -norm({set,[D],[S],fmove}) -> {fmove,S,D}; -norm({set,[D],[S],fconv}) -> {fconv,S,D}; -norm({set,[D],[S1,S2],put_list}) -> {put_list,S1,S2,D}; -norm({set,[D],[],{put_tuple,A}}) -> {put_tuple,A,D}; -norm({set,[],[S],put}) -> {put,S}; -norm({set,[D],[],{put_string,L,S}}) -> {put_string,L,S,D}; -norm({set,[D],[S],{get_tuple_element,I}}) -> {get_tuple_element,S,I,D}; -norm({set,[],[S,D],{set_tuple_element,I}}) -> {set_tuple_element,S,D,I}; -norm({set,[D1,D2],[S],get_list}) -> {get_list,S,D1,D2}; -norm({set,[],[],remove_message}) -> remove_message; -norm({set,[],[],fclearerror}) -> fclearerror; -norm({set,[],[],fcheckerror}) -> {fcheckerror,{f,0}}; -norm({'%',_}=Comment) -> Comment; -norm({'%live',R}) -> {'%live',R}. - -norm_allocate({_Zero,nostack,Nh,[]}, Regs) -> - [{test_heap,Nh,Regs}]; -norm_allocate({_Zero,nostack,Nh,Nf,[]}, Regs) -> - [{test_heap,alloc_list(Nh, Nf),Regs}]; -norm_allocate({zero,0,Nh,[]}, Regs) -> - norm_allocate({nozero,0,Nh,[]}, Regs); -norm_allocate({zero,0,Nh,Nf,[]}, Regs) -> - norm_allocate({nozero,0,Nh,Nf,[]}, Regs); -norm_allocate({zero,Ns,0,[]}, Regs) -> - [{allocate_zero,Ns,Regs}]; -norm_allocate({zero,Ns,Nh,[]}, Regs) -> - [{allocate_heap_zero,Ns,Nh,Regs}]; -norm_allocate({nozero,Ns,0,Inits}, Regs) -> - [{allocate,Ns,Regs}|Inits]; -norm_allocate({nozero,Ns,Nh,Inits}, Regs) -> - [{allocate_heap,Ns,Nh,Regs}|Inits]; -norm_allocate({nozero,Ns,Nh,Floats,Inits}, Regs) -> - [{allocate_heap,Ns,alloc_list(Nh, Floats),Regs}|Inits]; -norm_allocate({zero,Ns,Nh,Floats,Inits}, Regs) -> - [{allocate_heap_zero,Ns,alloc_list(Nh, Floats),Regs}|Inits]. - -insert_alloc_in_bs_init([I|_]=Is, Alloc) -> - case is_bs_put(I) of - false -> - not_possible; - true -> - insert_alloc_1(Is, Alloc, []) - end. - -insert_alloc_1([{bs_init2,Fail,Bs,Ws,Regs,F,Dst}|Is], {_,nostack,Nh,Nf,[]}, Acc) -> - Al = alloc_list(Ws+Nh, Nf), - I = {bs_init2,Fail,Bs,Al,Regs,F,Dst}, - reverse(Acc, [I|Is]); -insert_alloc_1([I|Is], Alloc, Acc) -> - insert_alloc_1(Is, Alloc, [I|Acc]). - -is_bs_put({bs_put_integer,_,_,_,_,_}) -> true; -is_bs_put({bs_put_float,_,_,_,_,_}) -> true; -is_bs_put({bs_put_binary,_,_,_,_,_}) -> true; -is_bs_put({bs_put_string,_,_}) -> true; -is_bs_put(_) -> false. - -alloc_list(Words, Floats) -> - {alloc,[{words,Words},{floats,Floats}]}. - - -%% opt(Is0) -> Is -%% Simple peep-hole optimization to move a {move,Any,{x,0}} past -%% any kill up to the next call instruction. - -opt(Is) -> - opt_1(Is, []). - -opt_1([{move,_,{x,0}}=I|Is0], Acc0) -> - case move_past_kill(Is0, I, Acc0) of - impossible -> opt_1(Is0, [I|Acc0]); - {Is,Acc} -> opt_1(Is, Acc) - end; -opt_1([I|Is], Acc) -> - opt_1(Is, [I|Acc]); -opt_1([], Acc) -> reverse(Acc). - -move_past_kill([{'%live',_}|Is], Move, Acc) -> - move_past_kill(Is, Move, Acc); -move_past_kill([{kill,Src}|_], {move,Src,_}, _) -> - impossible; -move_past_kill([{kill,_}=I|Is], Move, Acc) -> - move_past_kill(Is, Move, [I|Acc]); -move_past_kill(Is, Move, Acc) -> - {Is,[Move|Acc]}. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_jump.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_jump.erl deleted file mode 100644 index fd005898b6..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_jump.erl +++ /dev/null @@ -1,477 +0,0 @@ -%% ``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 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. -%% -%% 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: beam_jump.erl,v 1.1 2008/12/17 09:53:41 mikpe Exp $ -%% -%%% Purpose : Optimise jumps and remove unreachable code. - --module(beam_jump). - --export([module/2,module_labels/1, - is_unreachable_after/1,remove_unused_labels/1]). - -%%% The following optimisations are done: -%%% -%%% (1) This code with two identical instruction sequences -%%% -%%% L1: <Instruction sequence> -%%% L2: -%%% . . . -%%% L3: <Instruction sequence> -%%% L4: -%%% -%%% can be replaced with -%%% -%%% L1: jump L3 -%%% L2: -%%% . . . -%%% L3: <Instruction sequence> -%%% L4 -%%% -%%% Note: The instruction sequence must end with an instruction -%%% such as a jump that never transfers control to the instruction -%%% following it. -%%% -%%% (2) case_end, if_end, and badmatch, and function calls that cause an -%%% exit (such as calls to exit/1) are moved to the end of the function. -%%% The purpose is to allow further optimizations at the place from -%%% which the code was moved. -%%% -%%% (3) Any unreachable code is removed. Unreachable code is code after -%%% jump, call_last and other instructions which never transfer control -%%% to the following instruction. Code is unreachable up to the next -%%% *referenced* label. Note that the optimisations below might -%%% generate more possibilities for removing unreachable code. -%%% -%%% (4) This code: -%%% L1: jump L2 -%%% . . . -%%% L2: ... -%%% -%%% will be changed to -%%% -%%% jump L2 -%%% . . . -%%% L1: -%%% L2: ... -%%% -%%% If the jump is unreachable, it will be removed according to (1). -%%% -%%% (5) In -%%% -%%% jump L1 -%%% L1: -%%% -%%% the jump will be removed. -%%% -%%% (6) If test instructions are used to skip a single jump instruction, -%%% the test is inverted and the jump is eliminated (provided that -%%% the test can be inverted). Example: -%%% -%%% is_eq L1 {x,1} {x,2} -%%% jump L2 -%%% L1: -%%% -%%% will be changed to -%%% -%%% is_ne L2 {x,1} {x,2} -%%% -%%% (The label L1 will be retained if there were previous references to it.) -%%% -%%% (7) Some redundant uses of is_boolean/1 is optimized away. -%%% -%%% Terminology note: The optimisation done here is called unreachable-code -%%% elimination, NOT dead-code elimination. Dead code elimination -%%% means the removal of instructions that are executed, but have no visible -%%% effect on the program state. -%%% - --import(lists, [reverse/1,reverse/2,map/2,mapfoldl/3,foldl/3, - last/1,foreach/2,member/2]). - -module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> - Fs = map(fun function/1, Fs0), - {ok,{Mod,Exp,Attr,Fs,Lc}}. - -module_labels({Mod,Exp,Attr,Fs,Lc}) -> - {Mod,Exp,Attr,map(fun function_labels/1, Fs),Lc}. - -function_labels({function,Name,Arity,CLabel,Asm0}) -> - Asm = remove_unused_labels(Asm0), - {function,Name,Arity,CLabel,Asm}. - -function({function,Name,Arity,CLabel,Asm0}) -> - Asm1 = share(Asm0), - Asm2 = bopt(Asm1), - Asm3 = move(Asm2), - Asm4 = opt(Asm3, CLabel), - Asm = remove_unused_labels(Asm4), - {function,Name,Arity,CLabel,Asm}. - -%%% -%%% (1) We try to share the code for identical code segments by replacing all -%%% occurrences except the last with jumps to the last occurrence. -%%% - -share(Is) -> - share_1(reverse(Is), gb_trees:empty(), [], []). - -share_1([{label,_}=Lbl|Is], Dict, [], Acc) -> - share_1(Is, Dict, [], [Lbl|Acc]); -share_1([{label,L}=Lbl|Is], Dict0, Seq, Acc) -> - case is_unreachable_after(last(Seq)) of - false -> - share_1(Is, Dict0, [], [Lbl|Seq ++ Acc]); - true -> - case gb_trees:lookup(Seq, Dict0) of - none -> - Dict = gb_trees:insert(Seq, L, Dict0), - share_1(Is, Dict, [], [Lbl|Seq ++ Acc]); - {value,Label} -> - share_1(Is, Dict0, [], [Lbl,{jump,{f,Label}}|Acc]) - end - end; -share_1([{func_info,_,_,_}=I|Is], _, [], Acc) -> - Is++[I|Acc]; -share_1([I|Is], Dict, Seq, Acc) -> - case is_unreachable_after(I) of - false -> - share_1(Is, Dict, [I|Seq], Acc); - true -> - share_1(Is, Dict, [I], Acc) - end. - -%%% -%%% (2) Move short code sequences ending in an instruction that causes an exit -%%% to the end of the function. -%%% - -move(Is) -> - move_1(Is, [], []). - -move_1([I|Is], End, Acc) -> - case is_exit_instruction(I) of - false -> move_1(Is, End, [I|Acc]); - true -> move_2(I, Is, End, Acc) - end; -move_1([], End, Acc) -> - reverse(Acc, reverse(End)). - -move_2(Exit, Is, End, [{block,_},{label,_},{func_info,_,_,_}|_]=Acc) -> - move_1(Is, End, [Exit|Acc]); -move_2(Exit, Is, End, [{kill,_Y}|Acc]) -> - move_2(Exit, Is, End, Acc); -move_2(Exit, Is, End, [{block,_}=Blk,{label,_}=Lbl,Dead|More]=Acc) -> - case is_unreachable_after(Dead) of - false -> - move_1(Is, End, [Exit|Acc]); - true -> - move_1([Dead|Is], [Exit,Blk,Lbl|End], More) - end; -move_2(Exit, Is, End, [{label,_}=Lbl,Dead|More]=Acc) -> - case is_unreachable_after(Dead) of - false -> - move_1(Is, End, [Exit|Acc]); - true -> - move_1([Dead|Is], [Exit,Lbl|End], More) - end; -move_2(Exit, Is, End, Acc) -> - move_1(Is, End, [Exit|Acc]). - -%%% -%%% (7) Remove redundant is_boolean tests. -%%% - -bopt(Is) -> - bopt_1(Is, []). - -bopt_1([{test,is_boolean,_,_}=I|Is], Acc0) -> - case opt_is_bool(I, Acc0) of - no -> bopt_1(Is, [I|Acc0]); - yes -> bopt_1(Is, Acc0); - {yes,Acc} -> bopt_1(Is, Acc) - end; -bopt_1([I|Is], Acc) -> bopt_1(Is, [I|Acc]); -bopt_1([], Acc) -> reverse(Acc). - -opt_is_bool({test,is_boolean,{f,Lbl},[Reg]}, Acc) -> - opt_is_bool_1(Acc, Reg, Lbl). - -opt_is_bool_1([{test,is_eq_exact,{f,Lbl},[Reg,{atom,true}]}|_], Reg, Lbl) -> - %% Instruction not needed in this context. - yes; -opt_is_bool_1([{test,is_ne_exact,{f,Lbl},[Reg,{atom,true}]}|Acc], Reg, Lbl) -> - %% Rewrite to shorter test. - {yes,[{test,is_eq_exact,{f,Lbl},[Reg,{atom,false}]}|Acc]}; -opt_is_bool_1([{test,_,{f,Lbl},_}=Test|Acc0], Reg, Lbl) -> - case opt_is_bool_1(Acc0, Reg, Lbl) of - {yes,Acc} -> {yes,[Test|Acc]}; - Other -> Other - end; -opt_is_bool_1(_, _, _) -> no. - -%%% -%%% (3) (4) (5) (6) Jump and unreachable code optimizations. -%%% - --record(st, {fc, %Label for function class errors. - entry, %Entry label (must not be moved). - mlbl, %Moved labels. - labels %Set of referenced labels. - }). - -opt([{label,Fc}|_]=Is, CLabel) -> - Lbls = initial_labels(Is), - St = #st{fc=Fc,entry=CLabel,mlbl=dict:new(),labels=Lbls}, - opt(Is, [], St). - -opt([{test,Test0,{f,Lnum}=Lbl,Ops}=I|Is0], Acc, St) -> - case Is0 of - [{jump,To}|[{label,Lnum}|Is2]=Is1] -> - case invert_test(Test0) of - not_possible -> - opt(Is0, [I|Acc], label_used(Lbl, St)); - Test -> - Is = case is_label_used(Lnum, St) of - true -> Is1; - false -> Is2 - end, - opt([{test,Test,To,Ops}|Is], Acc, label_used(To, St)) - end; - _Other -> - opt(Is0, [I|Acc], label_used(Lbl, St)) - end; -opt([{select_val,_R,Fail,{list,Vls}}=I|Is], Acc, St) -> - skip_unreachable(Is, [I|Acc], label_used([Fail|Vls], St)); -opt([{select_tuple_arity,_R,Fail,{list,Vls}}=I|Is], Acc, St) -> - skip_unreachable(Is, [I|Acc], label_used([Fail|Vls], St)); -opt([{'try',_R,Lbl}=I|Is], Acc, St) -> - opt(Is, [I|Acc], label_used(Lbl, St)); -opt([{'catch',_R,Lbl}=I|Is], Acc, St) -> - opt(Is, [I|Acc], label_used(Lbl, St)); -opt([{label,L}=I|Is], Acc, #st{entry=L}=St) -> - %% NEVER move the entry label. - opt(Is, [I|Acc], St); -opt([{label,L1},{jump,{f,L2}}=I|Is], [Prev|Acc], St0) -> - St = St0#st{mlbl=dict:append(L2, L1, St0#st.mlbl)}, - opt([Prev,I|Is], Acc, label_used({f,L2}, St)); -opt([{label,Lbl}=I|Is], Acc, #st{mlbl=Mlbl}=St0) -> - case dict:find(Lbl, Mlbl) of - {ok,Lbls} -> - %% Essential to remove the list of labels from the dictionary, - %% since we will rescan the inserted labels. We MUST rescan. - St = St0#st{mlbl=dict:erase(Lbl, Mlbl)}, - insert_labels([Lbl|Lbls], Is, Acc, St); - error -> opt(Is, [I|Acc], St0) - end; -opt([{jump,{f,Lbl}},{label,Lbl}=I|Is], Acc, St) -> - opt([I|Is], Acc, St); -opt([{jump,Lbl}=I|Is], Acc, St) -> - skip_unreachable(Is, [I|Acc], label_used(Lbl, St)); -opt([{loop_rec,Lbl,_R}=I|Is], Acc, St) -> - opt(Is, [I|Acc], label_used(Lbl, St)); -opt([{bif,_Name,Lbl,_As,_R}=I|Is], Acc, St) -> - opt(Is, [I|Acc], label_used(Lbl, St)); -opt([{bs_put_integer,Lbl,_Bits,_Unit,_Fl,_Val}=I|Is], Acc, St) -> - opt(Is, [I|Acc], label_used(Lbl, St)); -opt([{bs_put_binary,Lbl,_Bits,_Unit,_Fl,_Val}=I|Is], Acc, St) -> - opt(Is, [I|Acc], label_used(Lbl, St)); -opt([{bs_put_float,Lbl,_Bits,_Unit,_Fl,_Val}=I|Is], Acc, St) -> - opt(Is, [I|Acc], label_used(Lbl, St)); -opt([{bs_final,Lbl,_R}=I|Is], Acc, St) -> - opt(Is, [I|Acc], label_used(Lbl, St)); -opt([{bs_init2,Lbl,_,_,_,_,_}=I|Is], Acc, St) -> - opt(Is, [I|Acc], label_used(Lbl, St)); -opt([{bs_add,Lbl,_,_}=I|Is], Acc, St) -> - opt(Is, [I|Acc], label_used(Lbl, St)); -opt([{bs_bits_to_bytes,Lbl,_,_}=I|Is], Acc, St) -> - opt(Is, [I|Acc], label_used(Lbl, St)); -opt([I|Is], Acc, St) -> - case is_unreachable_after(I) of - true -> skip_unreachable(Is, [I|Acc], St); - false -> opt(Is, [I|Acc], St) - end; -opt([], Acc, #st{fc=Fc,mlbl=Mlbl}) -> - Code = reverse(Acc), - case dict:find(Fc, Mlbl) of - {ok,Lbls} -> insert_fc_labels(Lbls, Mlbl, Code); - error -> Code - end. - -insert_fc_labels([L|Ls], Mlbl, Acc0) -> - Acc = [{label,L}|Acc0], - case dict:find(L, Mlbl) of - error -> - insert_fc_labels(Ls, Mlbl, Acc); - {ok,Lbls} -> - insert_fc_labels(Lbls++Ls, Mlbl, Acc) - end; -insert_fc_labels([], _, Acc) -> Acc. - -%% invert_test(Test0) -> not_possible | Test - -invert_test(is_ge) -> is_lt; -invert_test(is_lt) -> is_ge; -invert_test(is_eq) -> is_ne; -invert_test(is_ne) -> is_eq; -invert_test(is_eq_exact) -> is_ne_exact; -invert_test(is_ne_exact) -> is_eq_exact; -invert_test(_) -> not_possible. - -insert_labels([L|Ls], Is, [{jump,{f,L}}|Acc], St) -> - insert_labels(Ls, [{label,L}|Is], Acc, St); -insert_labels([L|Ls], Is, Acc, St) -> - insert_labels(Ls, [{label,L}|Is], Acc, St); -insert_labels([], Is, Acc, St) -> - opt(Is, Acc, St). - -%% Skip unreachable code up to the next referenced label. - -skip_unreachable([{label,L}|Is], [{jump,{f,L}}|Acc], St) -> - opt([{label,L}|Is], Acc, St); -skip_unreachable([{label,L}|Is], Acc, St) -> - case is_label_used(L, St) of - true -> opt([{label,L}|Is], Acc, St); - false -> skip_unreachable(Is, Acc, St) - end; -skip_unreachable([_|Is], Acc, St) -> - skip_unreachable(Is, Acc, St); -skip_unreachable([], Acc, St) -> - opt([], Acc, St). - -%% Add one or more label to the set of used labels. - -label_used({f,0}, St) -> St; -label_used({f,L}, St) -> St#st{labels=gb_sets:add(L, St#st.labels)}; -label_used([H|T], St0) -> label_used(T, label_used(H, St0)); -label_used([], St) -> St; -label_used(_Other, St) -> St. - -%% Test if label is used. - -is_label_used(L, St) -> - gb_sets:is_member(L, St#st.labels). - -%% is_unreachable_after(Instruction) -> true|false -%% Test whether the code after Instruction is unreachable. - -is_unreachable_after({func_info,_M,_F,_A}) -> true; -is_unreachable_after(return) -> true; -is_unreachable_after({call_ext_last,_Ar,_ExtFunc,_D}) -> true; -is_unreachable_after({call_ext_only,_Ar,_ExtFunc}) -> true; -is_unreachable_after({call_last,_Ar,_Lbl,_D}) -> true; -is_unreachable_after({call_only,_Ar,_Lbl}) -> true; -is_unreachable_after({apply_last,_Ar,_N}) -> true; -is_unreachable_after({jump,_Lbl}) -> true; -is_unreachable_after({select_val,_R,_Lbl,_Cases}) -> true; -is_unreachable_after({select_tuple_arity,_R,_Lbl,_Cases}) -> true; -is_unreachable_after({loop_rec_end,_}) -> true; -is_unreachable_after({wait,_}) -> true; -is_unreachable_after(I) -> is_exit_instruction(I). - -%% is_exit_instruction(Instruction) -> true|false -%% Test whether the instruction Instruction always -%% causes an exit/failure. - -is_exit_instruction({call_ext,_,{extfunc,M,F,A}}) -> - is_exit_instruction_1(M, F, A); -is_exit_instruction({call_ext_last,_,{extfunc,M,F,A},_}) -> - is_exit_instruction_1(M, F, A); -is_exit_instruction({call_ext_only,_,{extfunc,M,F,A}}) -> - is_exit_instruction_1(M, F, A); -is_exit_instruction(if_end) -> true; -is_exit_instruction({case_end,_}) -> true; -is_exit_instruction({try_case_end,_}) -> true; -is_exit_instruction({badmatch,_}) -> true; -is_exit_instruction(_) -> false. - -is_exit_instruction_1(erlang, exit, 1) -> true; -is_exit_instruction_1(erlang, throw, 1) -> true; -is_exit_instruction_1(erlang, error, 1) -> true; -is_exit_instruction_1(erlang, error, 2) -> true; -is_exit_instruction_1(erlang, fault, 1) -> true; -is_exit_instruction_1(erlang, fault, 2) -> true; -is_exit_instruction_1(_, _, _) -> false. - -%% remove_unused_labels(Instructions0) -> Instructions -%% Remove all unused labels. - -remove_unused_labels(Is) -> - Used0 = initial_labels(Is), - Used = foldl(fun ulbl/2, Used0, Is), - rem_unused(Is, Used, []). - -rem_unused([{label,Lbl}=I|Is], Used, Acc) -> - case gb_sets:is_member(Lbl, Used) of - false -> rem_unused(Is, Used, Acc); - true -> rem_unused(Is, Used, [I|Acc]) - end; -rem_unused([I|Is], Used, Acc) -> - rem_unused(Is, Used, [I|Acc]); -rem_unused([], _, Acc) -> reverse(Acc). - -initial_labels(Is) -> - initial_labels(Is, []). - -initial_labels([{label,Lbl}|Is], Acc) -> - initial_labels(Is, [Lbl|Acc]); -initial_labels([{func_info,_,_,_},{label,Lbl}|_], Acc) -> - gb_sets:from_list([Lbl|Acc]). - -ulbl({test,_,Fail,_}, Used) -> - mark_used(Fail, Used); -ulbl({select_val,_,Fail,{list,Vls}}, Used) -> - mark_used_list(Vls, mark_used(Fail, Used)); -ulbl({select_tuple_arity,_,Fail,{list,Vls}}, Used) -> - mark_used_list(Vls, mark_used(Fail, Used)); -ulbl({'try',_,Lbl}, Used) -> - mark_used(Lbl, Used); -ulbl({'catch',_,Lbl}, Used) -> - mark_used(Lbl, Used); -ulbl({jump,Lbl}, Used) -> - mark_used(Lbl, Used); -ulbl({loop_rec,Lbl,_}, Used) -> - mark_used(Lbl, Used); -ulbl({loop_rec_end,Lbl}, Used) -> - mark_used(Lbl, Used); -ulbl({wait,Lbl}, Used) -> - mark_used(Lbl, Used); -ulbl({wait_timeout,Lbl,_To}, Used) -> - mark_used(Lbl, Used); -ulbl({bif,_Name,Lbl,_As,_R}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_init2,Lbl,_,_,_,_,_}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_put_integer,Lbl,_Bits,_Unit,_Fl,_Val}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_put_float,Lbl,_Bits,_Unit,_Fl,_Val}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_put_binary,Lbl,_Bits,_Unit,_Fl,_Val}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_final,Lbl,_}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_add,Lbl,_,_}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_bits_to_bytes,Lbl,_,_}, Used) -> - mark_used(Lbl, Used); -ulbl(_, Used) -> Used. - -mark_used({f,0}, Used) -> Used; -mark_used({f,L}, Used) -> gb_sets:add(L, Used); -mark_used(_, Used) -> Used. - -mark_used_list([H|T], Used) -> - mark_used_list(T, mark_used(H, Used)); -mark_used_list([], Used) -> Used. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_listing.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_listing.erl deleted file mode 100644 index 006b8c551a..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_listing.erl +++ /dev/null @@ -1,117 +0,0 @@ -%% ``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 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. -%% -%% 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: beam_listing.erl,v 1.1 2008/12/17 09:53:41 mikpe Exp $ -%% --module(beam_listing). - --export([module/2]). - --include("v3_life.hrl"). - --import(lists, [foreach/2]). - -module(File, Core) when element(1, Core) == c_module -> - %% This is a core module. - io:put_chars(File, core_pp:format(Core)); -module(File, Kern) when element(1, Kern) == k_mdef -> - %% This is a kernel module. - io:put_chars(File, v3_kernel_pp:format(Kern)); - %%io:put_chars(File, io_lib:format("~p~n", [Kern])); -module(File, {Mod,Exp,Attr,Kern}) -> - %% This is output from beam_life (v3). - io:fwrite(File, "~w.~n~p.~n~p.~n", [Mod,Exp,Attr]), - foreach(fun (F) -> function(File, F) end, Kern); -module(Stream, {Mod,Exp,Attr,Code,NumLabels}) -> - %% This is output from beam_codegen. - io:format(Stream, "{module, ~s}. %% version = ~w\n", - [Mod, beam_opcodes:format_number()]), - io:format(Stream, "\n{exports, ~p}.\n", [Exp]), - io:format(Stream, "\n{attributes, ~p}.\n", [Attr]), - io:format(Stream, "\n{labels, ~p}.\n", [NumLabels]), - foreach( - fun ({function,Name,Arity,Entry,Asm}) -> - io:format(Stream, "\n\n{function, ~w, ~w, ~w}.\n", - [Name, Arity, Entry]), - foreach(fun(Op) -> print_op(Stream, Op) end, Asm) end, - Code); -module(Stream, {Mod,Exp,Inter}) -> - %% Other kinds of intermediate formats. - io:fwrite(Stream, "~w.~n~p.~n", [Mod,Exp]), - foreach(fun (F) -> io:format(Stream, "~p.\n", [F]) end, Inter); -module(Stream, [_|_]=Fs) -> - %% Form-based abstract format. - foreach(fun (F) -> io:format(Stream, "~p.\n", [F]) end, Fs). - -print_op(Stream, Label) when element(1, Label) == label -> - io:format(Stream, " ~p.\n", [Label]); -print_op(Stream, Op) -> - io:format(Stream, " ~p.\n", [Op]). - -function(File, {function,Name,Arity,Args,Body,Vdb}) -> - io:nl(File), - io:format(File, "function ~p/~p.\n", [Name,Arity]), - io:format(File, " ~p.\n", [Args]), - print_vdb(File, Vdb), - put(beam_listing_nl, true), - foreach(fun(F) -> format(File, F, []) end, Body), - nl(File), - erase(beam_listing_nl). - -format(File, #l{ke=Ke,i=I,vdb=Vdb}, Ind) -> - nl(File), - ind_format(File, Ind, "~p ", [I]), - print_vdb(File, Vdb), - nl(File), - format(File, Ke, Ind); -format(File, Tuple, Ind) when is_tuple(Tuple) -> - ind_format(File, Ind, "{", []), - format_list(File, tuple_to_list(Tuple), [$\s|Ind]), - ind_format(File, Ind, "}", []); -format(File, List, Ind) when is_list(List) -> - ind_format(File, Ind, "[", []), - format_list(File, List, [$\s|Ind]), - ind_format(File, Ind, "]", []); -format(File, F, Ind) -> - ind_format(File, Ind, "~p", [F]). - -format_list(File, [F], Ind) -> - format(File, F, Ind); -format_list(File, [F|Fs], Ind) -> - format(File, F, Ind), - ind_format(File, Ind, ",", []), - format_list(File, Fs, Ind); -format_list(_, [], _) -> ok. - - -print_vdb(File, [{Var,F,E}|Vs]) -> - io:format(File, "~p:~p..~p ", [Var,F,E]), - print_vdb(File, Vs); -print_vdb(_, []) -> ok. - -ind_format(File, Ind, Format, Args) -> - case get(beam_listing_nl) of - true -> - put(beam_listing_nl, false), - io:put_chars(File, Ind); - false -> ok - end, - io:format(File, Format, Args). - -nl(File) -> - case put(beam_listing_nl, true) of - true -> ok; - false -> io:nl(File) - end. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_opcodes.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_opcodes.erl deleted file mode 100644 index a4f5fd34d2..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_opcodes.erl +++ /dev/null @@ -1,240 +0,0 @@ --module(beam_opcodes). -%% Warning: Do not edit this file. It was automatically -%% generated by 'beam_makeops' on Wed Nov 24 17:52:43 2004. - --export([format_number/0]). --export([opcode/2,opname/1]). - -format_number() -> 0. - -opcode(label, 1) -> 1; -opcode(func_info, 3) -> 2; -opcode(int_code_end, 0) -> 3; -opcode(call, 2) -> 4; -opcode(call_last, 3) -> 5; -opcode(call_only, 2) -> 6; -opcode(call_ext, 2) -> 7; -opcode(call_ext_last, 3) -> 8; -opcode(bif0, 2) -> 9; -opcode(bif1, 4) -> 10; -opcode(bif2, 5) -> 11; -opcode(allocate, 2) -> 12; -opcode(allocate_heap, 3) -> 13; -opcode(allocate_zero, 2) -> 14; -opcode(allocate_heap_zero, 3) -> 15; -opcode(test_heap, 2) -> 16; -opcode(init, 1) -> 17; -opcode(deallocate, 1) -> 18; -opcode(return, 0) -> 19; -opcode(send, 0) -> 20; -opcode(remove_message, 0) -> 21; -opcode(timeout, 0) -> 22; -opcode(loop_rec, 2) -> 23; -opcode(loop_rec_end, 1) -> 24; -opcode(wait, 1) -> 25; -opcode(wait_timeout, 2) -> 26; -opcode(m_plus, 4) -> 27; -opcode(m_minus, 4) -> 28; -opcode(m_times, 4) -> 29; -opcode(m_div, 4) -> 30; -opcode(int_div, 4) -> 31; -opcode(int_rem, 4) -> 32; -opcode(int_band, 4) -> 33; -opcode(int_bor, 4) -> 34; -opcode(int_bxor, 4) -> 35; -opcode(int_bsl, 4) -> 36; -opcode(int_bsr, 4) -> 37; -opcode(int_bnot, 3) -> 38; -opcode(is_lt, 3) -> 39; -opcode(is_ge, 3) -> 40; -opcode(is_eq, 3) -> 41; -opcode(is_ne, 3) -> 42; -opcode(is_eq_exact, 3) -> 43; -opcode(is_ne_exact, 3) -> 44; -opcode(is_integer, 2) -> 45; -opcode(is_float, 2) -> 46; -opcode(is_number, 2) -> 47; -opcode(is_atom, 2) -> 48; -opcode(is_pid, 2) -> 49; -opcode(is_reference, 2) -> 50; -opcode(is_port, 2) -> 51; -opcode(is_nil, 2) -> 52; -opcode(is_binary, 2) -> 53; -opcode(is_constant, 2) -> 54; -opcode(is_list, 2) -> 55; -opcode(is_nonempty_list, 2) -> 56; -opcode(is_tuple, 2) -> 57; -opcode(test_arity, 3) -> 58; -opcode(select_val, 3) -> 59; -opcode(select_tuple_arity, 3) -> 60; -opcode(jump, 1) -> 61; -opcode('catch', 2) -> 62; -opcode(catch_end, 1) -> 63; -opcode(move, 2) -> 64; -opcode(get_list, 3) -> 65; -opcode(get_tuple_element, 3) -> 66; -opcode(set_tuple_element, 3) -> 67; -opcode(put_string, 3) -> 68; -opcode(put_list, 3) -> 69; -opcode(put_tuple, 2) -> 70; -opcode(put, 1) -> 71; -opcode(badmatch, 1) -> 72; -opcode(if_end, 0) -> 73; -opcode(case_end, 1) -> 74; -opcode(call_fun, 1) -> 75; -opcode(make_fun, 3) -> 76; -opcode(is_function, 2) -> 77; -opcode(call_ext_only, 2) -> 78; -opcode(bs_start_match, 2) -> 79; -opcode(bs_get_integer, 5) -> 80; -opcode(bs_get_float, 5) -> 81; -opcode(bs_get_binary, 5) -> 82; -opcode(bs_skip_bits, 4) -> 83; -opcode(bs_test_tail, 2) -> 84; -opcode(bs_save, 1) -> 85; -opcode(bs_restore, 1) -> 86; -opcode(bs_init, 2) -> 87; -opcode(bs_final, 2) -> 88; -opcode(bs_put_integer, 5) -> 89; -opcode(bs_put_binary, 5) -> 90; -opcode(bs_put_float, 5) -> 91; -opcode(bs_put_string, 2) -> 92; -opcode(bs_need_buf, 1) -> 93; -opcode(fclearerror, 0) -> 94; -opcode(fcheckerror, 1) -> 95; -opcode(fmove, 2) -> 96; -opcode(fconv, 2) -> 97; -opcode(fadd, 4) -> 98; -opcode(fsub, 4) -> 99; -opcode(fmul, 4) -> 100; -opcode(fdiv, 4) -> 101; -opcode(fnegate, 3) -> 102; -opcode(make_fun2, 1) -> 103; -opcode('try', 2) -> 104; -opcode(try_end, 1) -> 105; -opcode(try_case, 1) -> 106; -opcode(try_case_end, 1) -> 107; -opcode(raise, 2) -> 108; -opcode(bs_init2, 6) -> 109; -opcode(bs_bits_to_bytes, 3) -> 110; -opcode(bs_add, 5) -> 111; -opcode(apply, 1) -> 112; -opcode(apply_last, 2) -> 113; -opcode(is_boolean, 2) -> 114; -opcode(Name, Arity) -> erlang:error(badarg, [Name,Arity]). - -opname(1) -> {label,1}; -opname(2) -> {func_info,3}; -opname(3) -> {int_code_end,0}; -opname(4) -> {call,2}; -opname(5) -> {call_last,3}; -opname(6) -> {call_only,2}; -opname(7) -> {call_ext,2}; -opname(8) -> {call_ext_last,3}; -opname(9) -> {bif0,2}; -opname(10) -> {bif1,4}; -opname(11) -> {bif2,5}; -opname(12) -> {allocate,2}; -opname(13) -> {allocate_heap,3}; -opname(14) -> {allocate_zero,2}; -opname(15) -> {allocate_heap_zero,3}; -opname(16) -> {test_heap,2}; -opname(17) -> {init,1}; -opname(18) -> {deallocate,1}; -opname(19) -> {return,0}; -opname(20) -> {send,0}; -opname(21) -> {remove_message,0}; -opname(22) -> {timeout,0}; -opname(23) -> {loop_rec,2}; -opname(24) -> {loop_rec_end,1}; -opname(25) -> {wait,1}; -opname(26) -> {wait_timeout,2}; -opname(27) -> {m_plus,4}; -opname(28) -> {m_minus,4}; -opname(29) -> {m_times,4}; -opname(30) -> {m_div,4}; -opname(31) -> {int_div,4}; -opname(32) -> {int_rem,4}; -opname(33) -> {int_band,4}; -opname(34) -> {int_bor,4}; -opname(35) -> {int_bxor,4}; -opname(36) -> {int_bsl,4}; -opname(37) -> {int_bsr,4}; -opname(38) -> {int_bnot,3}; -opname(39) -> {is_lt,3}; -opname(40) -> {is_ge,3}; -opname(41) -> {is_eq,3}; -opname(42) -> {is_ne,3}; -opname(43) -> {is_eq_exact,3}; -opname(44) -> {is_ne_exact,3}; -opname(45) -> {is_integer,2}; -opname(46) -> {is_float,2}; -opname(47) -> {is_number,2}; -opname(48) -> {is_atom,2}; -opname(49) -> {is_pid,2}; -opname(50) -> {is_reference,2}; -opname(51) -> {is_port,2}; -opname(52) -> {is_nil,2}; -opname(53) -> {is_binary,2}; -opname(54) -> {is_constant,2}; -opname(55) -> {is_list,2}; -opname(56) -> {is_nonempty_list,2}; -opname(57) -> {is_tuple,2}; -opname(58) -> {test_arity,3}; -opname(59) -> {select_val,3}; -opname(60) -> {select_tuple_arity,3}; -opname(61) -> {jump,1}; -opname(62) -> {'catch',2}; -opname(63) -> {catch_end,1}; -opname(64) -> {move,2}; -opname(65) -> {get_list,3}; -opname(66) -> {get_tuple_element,3}; -opname(67) -> {set_tuple_element,3}; -opname(68) -> {put_string,3}; -opname(69) -> {put_list,3}; -opname(70) -> {put_tuple,2}; -opname(71) -> {put,1}; -opname(72) -> {badmatch,1}; -opname(73) -> {if_end,0}; -opname(74) -> {case_end,1}; -opname(75) -> {call_fun,1}; -opname(76) -> {make_fun,3}; -opname(77) -> {is_function,2}; -opname(78) -> {call_ext_only,2}; -opname(79) -> {bs_start_match,2}; -opname(80) -> {bs_get_integer,5}; -opname(81) -> {bs_get_float,5}; -opname(82) -> {bs_get_binary,5}; -opname(83) -> {bs_skip_bits,4}; -opname(84) -> {bs_test_tail,2}; -opname(85) -> {bs_save,1}; -opname(86) -> {bs_restore,1}; -opname(87) -> {bs_init,2}; -opname(88) -> {bs_final,2}; -opname(89) -> {bs_put_integer,5}; -opname(90) -> {bs_put_binary,5}; -opname(91) -> {bs_put_float,5}; -opname(92) -> {bs_put_string,2}; -opname(93) -> {bs_need_buf,1}; -opname(94) -> {fclearerror,0}; -opname(95) -> {fcheckerror,1}; -opname(96) -> {fmove,2}; -opname(97) -> {fconv,2}; -opname(98) -> {fadd,4}; -opname(99) -> {fsub,4}; -opname(100) -> {fmul,4}; -opname(101) -> {fdiv,4}; -opname(102) -> {fnegate,3}; -opname(103) -> {make_fun2,1}; -opname(104) -> {'try',2}; -opname(105) -> {try_end,1}; -opname(106) -> {try_case,1}; -opname(107) -> {try_case_end,1}; -opname(108) -> {raise,2}; -opname(109) -> {bs_init2,6}; -opname(110) -> {bs_bits_to_bytes,3}; -opname(111) -> {bs_add,5}; -opname(112) -> {apply,1}; -opname(113) -> {apply_last,2}; -opname(114) -> {is_boolean,2}; -opname(Number) -> erlang:error(badarg, [Number]). diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_opcodes.hrl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_opcodes.hrl deleted file mode 100644 index 1ad0887314..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_opcodes.hrl +++ /dev/null @@ -1,12 +0,0 @@ -%% Warning: Do not edit this file. It was automatically -%% generated by 'beam_makeops' on Wed Nov 24 17:52:43 2004. - --define(tag_u, 0). --define(tag_i, 1). --define(tag_a, 2). --define(tag_x, 3). --define(tag_y, 4). --define(tag_f, 5). --define(tag_h, 6). --define(tag_z, 7). - diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_type.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_type.erl deleted file mode 100644 index 7d288b249c..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_type.erl +++ /dev/null @@ -1,551 +0,0 @@ -%% ``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 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. -%% -%% 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: beam_type.erl,v 1.1 2008/12/17 09:53:41 mikpe Exp $ -%% -%% Purpose : Type-based optimisations. - --module(beam_type). - --export([module/2]). - --import(lists, [map/2,foldl/3,reverse/1,reverse/2,filter/2,member/2]). - -module({Mod,Exp,Attr,Fs0,Lc}, Opt) -> - AllowFloatOpts = not member(no_float_opt, Opt), - Fs = map(fun(F) -> function(F, AllowFloatOpts) end, Fs0), - {ok,{Mod,Exp,Attr,Fs,Lc}}. - -function({function,Name,Arity,CLabel,Asm0}, AllowFloatOpts) -> - Asm = opt(Asm0, AllowFloatOpts, [], tdb_new()), - {function,Name,Arity,CLabel,Asm}. - -%% opt([Instruction], AllowFloatOpts, Accumulator, TypeDb) -> {[Instruction'],TypeDb'} -%% Keep track of type information; try to simplify. - -opt([{block,Body1}|Is], AllowFloatOpts, [{block,Body0}|Acc], Ts0) -> - {Body2,Ts} = simplify(Body1, Ts0, AllowFloatOpts), - Body = beam_block:merge_blocks(Body0, Body2), - opt(Is, AllowFloatOpts, [{block,Body}|Acc], Ts); -opt([{block,Body0}|Is], AllowFloatOpts, Acc, Ts0) -> - {Body,Ts} = simplify(Body0, Ts0, AllowFloatOpts), - opt(Is, AllowFloatOpts, [{block,Body}|Acc], Ts); -opt([I0|Is], AllowFloatOpts, Acc, Ts0) -> - case simplify([I0], Ts0, AllowFloatOpts) of - {[],Ts} -> opt(Is, AllowFloatOpts, Acc, Ts); - {[I],Ts} -> opt(Is, AllowFloatOpts, [I|Acc], Ts) - end; -opt([], _, Acc, _) -> reverse(Acc). - -%% simplify(Instruction, TypeDb, AllowFloatOpts) -> NewInstruction -%% Simplify an instruction using type information (this is -%% technically a "strength reduction"). - -simplify(Is, TypeDb, false) -> - simplify(Is, TypeDb, no_float_opt, []); -simplify(Is, TypeDb, true) -> - case are_live_regs_determinable(Is) of - false -> simplify(Is, TypeDb, no_float_opt, []); - true -> simplify(Is, TypeDb, [], []) - end. - -simplify([{set,[D],[{integer,Index},Reg],{bif,element,_}}=I0|Is]=Is0, Ts0, Rs0, Acc0) -> - I = case max_tuple_size(Reg, Ts0) of - Sz when 0 < Index, Index =< Sz -> - {set,[D],[Reg],{get_tuple_element,Index-1}}; - _Other -> I0 - end, - Ts = update(I, Ts0), - {Rs,Acc} = flush(Rs0, Is0, Acc0), - simplify(Is, Ts, Rs, [I|checkerror(Acc)]); -simplify([{set,[D0],[A],{bif,'-',{f,0}}}=I|Is]=Is0, Ts0, Rs0, Acc0) - when Rs0 =/= no_float_opt -> - case tdb_find(A, Ts0) of - float -> - {Rs1,Acc1} = load_reg(A, Ts0, Rs0, Acc0), - {D,Rs} = find_dest(D0, Rs1), - Areg = fetch_reg(A, Rs), - Acc = [{set,[D],[Areg],{bif,fnegate,{f,0}}}|clearerror(Acc1)], - Ts = tdb_update([{D0,float}], Ts0), - simplify(Is, Ts, Rs, Acc); - _Other -> - Ts = update(I, Ts0), - {Rs,Acc} = flush(Rs0, Is0, Acc0), - simplify(Is, Ts, Rs, [I|checkerror(Acc)]) - end; -simplify([{set,[_],[_],{bif,_,{f,0}}}=I|Is]=Is0, Ts0, Rs0, Acc0) -> - Ts = update(I, Ts0), - {Rs,Acc} = flush(Rs0, Is0, Acc0), - simplify(Is, Ts, Rs, [I|checkerror(Acc)]); -simplify([{set,[D0],[A,B],{bif,Op0,{f,0}}}=I|Is]=Is0, Ts0, Rs0, Acc0) - when Rs0 =/= no_float_opt -> - case float_op(Op0, A, B, Ts0) of - no -> - Ts = update(I, Ts0), - {Rs,Acc} = flush(Rs0, Is0, Acc0), - simplify(Is, Ts, Rs, [I|checkerror(Acc)]); - {yes,Op} -> - {Rs1,Acc1} = load_reg(A, Ts0, Rs0, Acc0), - {Rs2,Acc2} = load_reg(B, Ts0, Rs1, Acc1), - {D,Rs} = find_dest(D0, Rs2), - Areg = fetch_reg(A, Rs), - Breg = fetch_reg(B, Rs), - Acc = [{set,[D],[Areg,Breg],{bif,Op,{f,0}}}|clearerror(Acc2)], - Ts = tdb_update([{D0,float}], Ts0), - simplify(Is, Ts, Rs, Acc) - end; -simplify([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Rs0, Acc0) -> - case tdb_find(TupleReg, Ts0) of - {tuple,_,[Contents]} -> - Ts = tdb_update([{D,Contents}], Ts0), - {Rs,Acc} = flush(Rs0, Is0, Acc0), - simplify(Is0, Ts, Rs, [{set,[D],[Contents],move}|Acc]); - _ -> - Ts = update(I, Ts0), - {Rs,Acc} = flush(Rs0, Is0, Acc0), - simplify(Is0, Ts, Rs, [I|checkerror(Acc)]) - end; -simplify([{set,_,_,{'catch',_}}=I|Is]=Is0, _Ts, Rs0, Acc0) -> - Acc = flush_all(Rs0, Is0, Acc0), - simplify(Is, tdb_new(), Rs0, [I|Acc]); -simplify([{test,is_tuple,_,[R]}=I|Is], Ts, Rs, Acc) -> - case tdb_find(R, Ts) of - {tuple,_,_} -> simplify(Is, Ts, Rs, Acc); - _ -> - simplify(Is, Ts, Rs, [I|Acc]) - end; -simplify([{test,test_arity,_,[R,Arity]}=I|Is], Ts0, Rs, Acc) -> - case tdb_find(R, Ts0) of - {tuple,Arity,_} -> - simplify(Is, Ts0, Rs, Acc); - _Other -> - Ts = update(I, Ts0), - simplify(Is, Ts, Rs, [I|Acc]) - end; -simplify([{test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I|Is0], Ts0, Rs0, Acc0) -> - Acc1 = case tdb_find(R, Ts0) of - {atom,_}=Atom -> Acc0; - {atom,_} -> [{jump,Fail}|Acc0]; - _ -> [I|Acc0] - end, - Ts = update(I, Ts0), - {Rs,Acc} = flush(Rs0, Is0, Acc1), - simplify(Is0, Ts, Rs, Acc); -simplify([I|Is]=Is0, Ts0, Rs0, Acc0) -> - Ts = update(I, Ts0), - {Rs,Acc} = flush(Rs0, Is0, Acc0), - simplify(Is, Ts, Rs, [I|Acc]); -simplify([], Ts, Rs, Acc) -> - Is0 = reverse(flush_all(Rs, [], Acc)), - Is1 = opt_fmoves(Is0, []), - Is = add_ftest_heap(Is1), - {Is,Ts}. - -opt_fmoves([{set,[{x,_}=R],[{fr,_}]=Src,fmove}=I1, - {set,[{y,_}]=Dst,[{x,_}=R],move}=I2|Is], Acc) -> - case beam_block:is_killed(R, Is) of - false -> opt_fmoves(Is, [I2,I1|Acc]); - true -> opt_fmoves(Is, [{set,Dst,Src,fmove}|Acc]) - end; -opt_fmoves([I|Is], Acc) -> - opt_fmoves(Is, [I|Acc]); -opt_fmoves([], Acc) -> reverse(Acc). - -clearerror(Is) -> - clearerror(Is, Is). - -clearerror([{set,[],[],fclearerror}|_], OrigIs) -> OrigIs; -clearerror([{set,[],[],fcheckerror}|_], OrigIs) -> [{set,[],[],fclearerror}|OrigIs]; -clearerror([_|Is], OrigIs) -> clearerror(Is, OrigIs); -clearerror([], OrigIs) -> [{set,[],[],fclearerror}|OrigIs]. - -%% update(Instruction, TypeDb) -> NewTypeDb -%% Update the type database to account for executing an instruction. -%% -%% First the cases for instructions inside basic blocks. -update({set,[D],[S],move}, Ts0) -> - Ops = case tdb_find(S, Ts0) of - error -> [{D,kill}]; - Info -> [{D,Info}] - end, - tdb_update(Ops, Ts0); -update({set,[D],[{integer,I},Reg],{bif,element,_}}, Ts0) -> - tdb_update([{Reg,{tuple,I,[]}},{D,kill}], Ts0); -update({set,[D],[_Index,Reg],{bif,element,_}}, Ts0) -> - tdb_update([{Reg,{tuple,0,[]}},{D,kill}], Ts0); -update({set,[D],[S],{get_tuple_element,0}}, Ts) -> - tdb_update([{D,{tuple_element,S,0}}], Ts); -update({set,[D],[S],{bif,float,{f,0}}}, Ts0) -> - %% Make sure we reject non-numeric literal argument. - case possibly_numeric(S) of - true -> tdb_update([{D,float}], Ts0); - false -> Ts0 - end; -update({set,[D],[S1,S2],{bif,'/',{f,0}}}, Ts0) -> - %% Make sure we reject non-numeric literals. - case possibly_numeric(S1) andalso possibly_numeric(S2) of - true -> tdb_update([{D,float}], Ts0); - false -> Ts0 - end; -update({set,[D],[S1,S2],{bif,Op,{f,0}}}, Ts0) -> - case arith_op(Op) of - no -> - tdb_update([{D,kill}], Ts0); - {yes,_} -> - case {tdb_find(S1, Ts0),tdb_find(S2, Ts0)} of - {float,_} -> tdb_update([{D,float}], Ts0); - {_,float} -> tdb_update([{D,float}], Ts0); - {_,_} -> tdb_update([{D,kill}], Ts0) - end - end; -update({set,[],_Src,_Op}, Ts0) -> Ts0; -update({set,[D],_Src,_Op}, Ts0) -> - tdb_update([{D,kill}], Ts0); -update({set,[D1,D2],_Src,_Op}, Ts0) -> - tdb_update([{D1,kill},{D2,kill}], Ts0); -update({allocate,_,_}, Ts) -> Ts; -update({init,D}, Ts) -> - tdb_update([{D,kill}], Ts); -update({kill,D}, Ts) -> - tdb_update([{D,kill}], Ts); -update({'%live',_}, Ts) -> Ts; - -%% Instructions outside of blocks. -update({test,is_float,_Fail,[Src]}, Ts0) -> - tdb_update([{Src,float}], Ts0); -update({test,test_arity,_Fail,[Src,Arity]}, Ts0) -> - tdb_update([{Src,{tuple,Arity,[]}}], Ts0); -update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) -> - case tdb_find(Reg, Ts) of - error -> - Ts; - {tuple_element,TupleReg,0} -> - tdb_update([{TupleReg,{tuple,1,[Atom]}}], Ts); - _ -> - Ts - end; -update({test,_Test,_Fail,_Other}, Ts) -> Ts; -update({call_ext,1,{extfunc,math,Math,1}}, Ts) -> - case is_math_bif(Math, 1) of - true -> tdb_update([{{x,0},float}], Ts); - false -> tdb_kill_xregs(Ts) - end; -update({call_ext,2,{extfunc,math,Math,2}}, Ts) -> - case is_math_bif(Math, 2) of - true -> tdb_update([{{x,0},float}], Ts); - false -> tdb_kill_xregs(Ts) - end; -update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) -> - Op = case tdb_find({x,1}, Ts0) of - error -> kill; - Info -> Info - end, - Ts1 = tdb_kill_xregs(Ts0), - tdb_update([{{x,0},Op}], Ts1); -update({call,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); -update({call_ext,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); -update({make_fun2,_,_,_,_}, Ts) -> tdb_kill_xregs(Ts); - -%% The instruction is unknown. Kill all information. -update(_I, _Ts) -> tdb_new(). - -is_math_bif(cos, 1) -> true; -is_math_bif(cosh, 1) -> true; -is_math_bif(sin, 1) -> true; -is_math_bif(sinh, 1) -> true; -is_math_bif(tan, 1) -> true; -is_math_bif(tanh, 1) -> true; -is_math_bif(acos, 1) -> true; -is_math_bif(acosh, 1) -> true; -is_math_bif(asin, 1) -> true; -is_math_bif(asinh, 1) -> true; -is_math_bif(atan, 1) -> true; -is_math_bif(atanh, 1) -> true; -is_math_bif(erf, 1) -> true; -is_math_bif(erfc, 1) -> true; -is_math_bif(exp, 1) -> true; -is_math_bif(log, 1) -> true; -is_math_bif(log10, 1) -> true; -is_math_bif(sqrt, 1) -> true; -is_math_bif(atan2, 2) -> true; -is_math_bif(pow, 2) -> true; -is_math_bif(pi, 0) -> true; -is_math_bif(_, _) -> false. - -%% Reject non-numeric literals. -possibly_numeric({x,_}) -> true; -possibly_numeric({y,_}) -> true; -possibly_numeric({integer,_}) -> true; -possibly_numeric({float,_}) -> true; -possibly_numeric(_) -> false. - -max_tuple_size(Reg, Ts) -> - case tdb_find(Reg, Ts) of - {tuple,Sz,_} -> Sz; - _Other -> 0 - end. - -float_op('/', A, B, _) -> - case possibly_numeric(A) andalso possibly_numeric(B) of - true -> {yes,fdiv}; - false -> no - end; -float_op(Op, {float,_}, B, _) -> - case possibly_numeric(B) of - true -> arith_op(Op); - false -> no - end; -float_op(Op, A, {float,_}, _) -> - case possibly_numeric(A) of - true -> arith_op(Op); - false -> no - end; -float_op(Op, A, B, Ts) -> - case {tdb_find(A, Ts),tdb_find(B, Ts)} of - {float,_} -> arith_op(Op); - {_,float} -> arith_op(Op); - {_,_} -> no - end. - -find_dest(V, Rs0) -> - case find_reg(V, Rs0) of - {ok,FR} -> - {FR,mark(V, Rs0, dirty)}; - error -> - Rs = put_reg(V, Rs0, dirty), - {ok,FR} = find_reg(V, Rs), - {FR,Rs} - end. - -load_reg({float,_}=F, _, Rs0, Is0) -> - Rs = put_reg(F, Rs0, clean), - {ok,FR} = find_reg(F, Rs), - Is = [{set,[FR],[F],fmove}|Is0], - {Rs,Is}; -load_reg(V, Ts, Rs0, Is0) -> - case find_reg(V, Rs0) of - {ok,_FR} -> {Rs0,Is0}; - error -> - Rs = put_reg(V, Rs0, clean), - {ok,FR} = find_reg(V, Rs), - Op = case tdb_find(V, Ts) of - float -> fmove; - _ -> fconv - end, - Is = [{set,[FR],[V],Op}|Is0], - {Rs,Is} - end. - -arith_op('+') -> {yes,fadd}; -arith_op('-') -> {yes,fsub}; -arith_op('*') -> {yes,fmul}; -arith_op('/') -> {yes,fdiv}; -arith_op(_) -> no. - -flush(no_float_opt, _, Acc) -> {no_float_opt,Acc}; -flush(Rs, [{set,[_],[],{put_tuple,_}}|_]=Is0, Acc0) -> - Acc = flush_all(Rs, Is0, Acc0), - {[],Acc}; -flush(Rs0, [{set,Ds,Ss,_Op}|_], Acc0) -> - Save = gb_sets:from_list(Ss), - Acc = save_regs(Rs0, Save, Acc0), - Rs1 = foldl(fun(S, A) -> mark(S, A, clean) end, Rs0, Ss), - Kill = gb_sets:from_list(Ds), - Rs = kill_regs(Rs1, Kill), - {Rs,Acc}; -flush(Rs0, Is, Acc0) -> - Acc = flush_all(Rs0, Is, Acc0), - {[],Acc}. - -flush_all(no_float_opt, _, Acc) -> Acc; -flush_all([{_,{float,_},_}|Rs], Is, Acc) -> - flush_all(Rs, Is, Acc); -flush_all([{I,V,dirty}|Rs], Is, Acc0) -> - Acc = checkerror(Acc0), - case beam_block:is_killed(V, Is) of - true -> flush_all(Rs, Is, Acc); - false -> flush_all(Rs, Is, [{set,[V],[{fr,I}],fmove}|Acc]) - end; -flush_all([{_,_,clean}|Rs], Is, Acc) -> flush_all(Rs, Is, Acc); -flush_all([free|Rs], Is, Acc) -> flush_all(Rs, Is, Acc); -flush_all([], _, Acc) -> Acc. - -save_regs(Rs, Save, Acc) -> - foldl(fun(R, A) -> save_reg(R, Save, A) end, Acc, Rs). - -save_reg({I,V,dirty}, Save, Acc) -> - case gb_sets:is_member(V, Save) of - true -> [{set,[V],[{fr,I}],fmove}|checkerror(Acc)]; - false -> Acc - end; -save_reg(_, _, Acc) -> Acc. - -kill_regs(Rs, Kill) -> - map(fun(R) -> kill_reg(R, Kill) end, Rs). - -kill_reg({_,V,_}=R, Kill) -> - case gb_sets:is_member(V, Kill) of - true -> free; - false -> R - end; -kill_reg(R, _) -> R. - -mark(V, [{I,V,_}|Rs], Mark) -> [{I,V,Mark}|Rs]; -mark(V, [R|Rs], Mark) -> [R|mark(V, Rs, Mark)]; -mark(_, [], _) -> []. - -fetch_reg(V, [{I,V,_}|_]) -> {fr,I}; -fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). - -find_reg(V, [{I,V,_}|_]) -> {ok,{fr,I}}; -find_reg(V, [_|SRs]) -> find_reg(V, SRs); -find_reg(_, []) -> error. - -put_reg(V, Rs, Dirty) -> put_reg_1(V, Rs, Dirty, 0). - -put_reg_1(V, [free|Rs], Dirty, I) -> [{I,V,Dirty}|Rs]; -put_reg_1(V, [R|Rs], Dirty, I) -> [R|put_reg_1(V, Rs, Dirty, I+1)]; -put_reg_1(V, [], Dirty, I) -> [{I,V,Dirty}]. - -checkerror(Is) -> - checkerror_1(Is, Is). - -checkerror_1([{set,[],[],fcheckerror}|_], OrigIs) -> OrigIs; -checkerror_1([{set,[],[],fclearerror}|_], OrigIs) -> OrigIs; -checkerror_1([{set,_,_,{bif,fadd,_}}|_], OrigIs) -> checkerror_2(OrigIs); -checkerror_1([{set,_,_,{bif,fsub,_}}|_], OrigIs) -> checkerror_2(OrigIs); -checkerror_1([{set,_,_,{bif,fmul,_}}|_], OrigIs) -> checkerror_2(OrigIs); -checkerror_1([{set,_,_,{bif,fdiv,_}}|_], OrigIs) -> checkerror_2(OrigIs); -checkerror_1([{set,_,_,{bif,fnegate,_}}|_], OrigIs) -> checkerror_2(OrigIs); -checkerror_1([_|Is], OrigIs) -> checkerror_1(Is, OrigIs); -checkerror_1([], OrigIs) -> OrigIs. - -checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs]. - -add_ftest_heap(Is) -> - add_ftest_heap_1(reverse(Is), 0, []). - -add_ftest_heap_1([{set,_,[{fr,_}],fmove}=I|Is], Floats, Acc) -> - add_ftest_heap_1(Is, Floats+1, [I|Acc]); -add_ftest_heap_1([{allocate,_,_}=I|Is], 0, Acc) -> - reverse(Is, [I|Acc]); -add_ftest_heap_1([{allocate,Regs,{Z,Stk,Heap,Inits}}|Is], Floats, Acc) -> - reverse(Is, [{allocate,Regs,{Z,Stk,Heap,Floats,Inits}}|Acc]); -add_ftest_heap_1([I|Is], Floats, Acc) -> - add_ftest_heap_1(Is, Floats, [I|Acc]); -add_ftest_heap_1([], 0, Acc) -> - Acc; -add_ftest_heap_1([], Floats, Is) -> - Regs = beam_block:live_at_entry(Is), - [{allocate,Regs,{nozero,nostack,0,Floats,[]}}|Is]. - -are_live_regs_determinable([{allocate,_,_}|_]) -> true; -are_live_regs_determinable([{'%live',_}|_]) -> true; -are_live_regs_determinable([_|Is]) -> are_live_regs_determinable(Is); -are_live_regs_determinable([]) -> false. - - -%%% Routines for maintaining a type database. The type database -%%% associates type information with registers. -%%% -%%% {tuple,Size,First} means that the corresponding register contains a -%%% tuple with *at least* Size elements. An tuple with unknown -%%% size is represented as {tuple,0}. First is either [] (meaning that -%%% the tuple's first element is unknown) or [FirstElement] (the contents -%%% of the first element). -%%% -%%% 'float' means that the register contains a float. - -%% tdb_new() -> EmptyDataBase -%% Creates a new, empty type database. - -tdb_new() -> []. - -%% tdb_find(Register, Db) -> Information|error -%% Returns type information or the atom error if there are no type -%% information available for Register. - -tdb_find(Key, [{K,_}|_]) when Key < K -> error; -tdb_find(Key, [{Key,Info}|_]) -> Info; -tdb_find(Key, [_|Db]) -> tdb_find(Key, Db); -tdb_find(_, []) -> error. - -%% tdb_update([UpdateOp], Db) -> NewDb -%% UpdateOp = {Register,kill}|{Register,NewInfo} -%% Updates a type database. If a 'kill' operation is given, the type -%% information for that register will be removed from the database. -%% A kill operation takes precende over other operations for the same -%% register (i.e. [{{x,0},kill},{{x,0},{tuple,5}}] means that the -%% the existing type information, if any, will be discarded, and the -%% the '{tuple,5}' information ignored. -%% -%% If NewInfo information is given and there exists information about -%% the register, the old and new type information will be merged. -%% For instance, {tuple,5} and {tuple,10} will be merged to produce -%% {tuple,10}. - -tdb_update(Uis0, Ts0) -> - Uis1 = filter(fun ({{x,_},_Op}) -> true; - ({{y,_},_Op}) -> true; - (_) -> false - end, Uis0), - tdb_update1(lists:sort(Uis1), Ts0). - -tdb_update1([{Key,kill}|Ops], [{K,_Old}|_]=Db) when Key < K -> - tdb_update1(remove_key(Key, Ops), Db); -tdb_update1([{Key,_New}=New|Ops], [{K,_Old}|_]=Db) when Key < K -> - [New|tdb_update1(Ops, Db)]; -tdb_update1([{Key,kill}|Ops], [{Key,_}|Db]) -> - tdb_update1(remove_key(Key, Ops), Db); -tdb_update1([{Key,NewInfo}|Ops], [{Key,OldInfo}|Db]) -> - [{Key,merge_type_info(NewInfo, OldInfo)}|tdb_update1(Ops, Db)]; -tdb_update1([{_,_}|_]=Ops, [Old|Db]) -> - [Old|tdb_update1(Ops, Db)]; -tdb_update1([{Key,kill}|Ops], []) -> - tdb_update1(remove_key(Key, Ops), []); -tdb_update1([{_,_}=New|Ops], []) -> - [New|tdb_update1(Ops, [])]; -tdb_update1([], Db) -> Db. - -%% tdb_kill_xregs(Db) -> NewDb -%% Kill all information about x registers. Also kill all tuple_element -%% dependencies from y registers to x registers. - -tdb_kill_xregs([{{x,_},_Type}|Db]) -> tdb_kill_xregs(Db); -tdb_kill_xregs([{{y,_},{tuple_element,{x,_},_}}|Db]) -> tdb_kill_xregs(Db); -tdb_kill_xregs([Any|Db]) -> [Any|tdb_kill_xregs(Db)]; -tdb_kill_xregs([]) -> []. - -remove_key(Key, [{Key,_Op}|Ops]) -> remove_key(Key, Ops); -remove_key(_, Ops) -> Ops. - -merge_type_info(I, I) -> I; -merge_type_info({tuple,Sz1,Same}, {tuple,Sz2,Same}=Max) when Sz1 < Sz2 -> - Max; -merge_type_info({tuple,Sz1,Same}=Max, {tuple,Sz2,Same}) when Sz1 > Sz2 -> - Max; -merge_type_info({tuple,Sz1,[]}, {tuple,Sz2,First}) -> - merge_type_info({tuple,Sz1,First}, {tuple,Sz2,First}); -merge_type_info({tuple,Sz1,First}, {tuple,Sz2,_}) -> - merge_type_info({tuple,Sz1,First}, {tuple,Sz2,First}); -merge_type_info(NewType, _) -> - verify_type(NewType), - NewType. - -verify_type({tuple,Sz,[]}) when is_integer(Sz) -> ok; -verify_type({tuple,Sz,[_]}) when is_integer(Sz) -> ok; -verify_type({tuple_element,_,_}) -> ok; -verify_type(float) -> ok; -verify_type({atom,_}) -> ok. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_validator.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_validator.erl deleted file mode 100644 index a01be447b0..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_validator.erl +++ /dev/null @@ -1,1022 +0,0 @@ -%% ``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 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. -%% -%% 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: beam_validator.erl,v 1.1 2008/12/17 09:53:41 mikpe Exp $ - --module(beam_validator). - --export([file/1,files/1]). - -%% Interface for compiler. --export([module/2,format_error/1]). - --import(lists, [reverse/1,foldl/3]). - --define(MAXREG, 1024). - --define(DEBUG, 1). --undef(DEBUG). --ifdef(DEBUG). --define(DBG_FORMAT(F, D), (io:format((F), (D)))). --else. --define(DBG_FORMAT(F, D), ok). --endif. - -%%% -%%% API functions. -%%% - -files([F|Fs]) -> - ?DBG_FORMAT("# Verifying: ~p~n", [F]), - case file(F) of - ok -> ok; - {error,Es} -> - io:format("~p:~n~s~n", [F,format_error(Es)]) - end, - files(Fs); -files([]) -> ok. - -file(Name) when is_list(Name) -> - case case filename:extension(Name) of - ".S" -> s_file(Name); - ".beam" -> beam_file(Name) - end of - [] -> ok; - Es -> {error,Es} - end. - -%% To be called by the compiler. -module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts) - when is_atom(Mod), is_list(Exp), is_list(Attr), is_integer(Lc) -> - case validate(Fs) of - [] -> {ok,Code}; - Es0 -> - Es = [{?MODULE,E} || E <- Es0], - {error,[{atom_to_list(Mod),Es}]} - end. - -format_error([]) -> []; -format_error([{{M,F,A},{I,Off,Desc}}|Es]) -> - [io_lib:format(" ~p:~p/~p+~p:~n ~p - ~p~n", - [M,F,A,Off,I,Desc])|format_error(Es)]; -format_error({{_M,F,A},{I,Off,Desc}}) -> - io_lib:format( - "function ~p/~p+~p:~n" - " Internal consistency check failed - please report this bug.~n" - " Instruction: ~p~n" - " Error: ~p:~n", [F,A,Off,I,Desc]). - -%%% -%%% Local functions follow. -%%% - -s_file(Name) -> - {ok,Is} = file:consult(Name), - Fs = find_functions(Is), - validate(Fs). - -find_functions(Fs) -> - find_functions_1(Fs, none, [], []). - -find_functions_1([{function,Name,Arity,Entry}|Is], Func, FuncAcc, Acc0) -> - Acc = add_func(Func, FuncAcc, Acc0), - find_functions_1(Is, {Name,Arity,Entry}, [], Acc); -find_functions_1([I|Is], Func, FuncAcc, Acc) -> - find_functions_1(Is, Func, [I|FuncAcc], Acc); -find_functions_1([], Func, FuncAcc, Acc) -> - reverse(add_func(Func, FuncAcc, Acc)). - -add_func(none, _, Acc) -> Acc; -add_func({Name,Arity,Entry}, Is, Acc) -> - [{function,Name,Arity,Entry,reverse(Is)}|Acc]. - -beam_file(Name) -> - try beam_disasm:file(Name) of - {error,beam_lib,Reason} -> [{beam_lib,Reason}]; - {beam_file,L} -> - {value,{code,Code0}} = lists:keysearch(code, 1, L), - Code = beam_file_1(Code0, []), - validate(Code) - catch _:_ -> [disassembly_failed] - end. - -beam_file_1([F0|Fs], Acc) -> - F = conv_func(F0), - beam_file_1(Fs, [F|Acc]); -beam_file_1([], Acc) -> reverse(Acc). - -%% Convert from the disassembly format to the internal format -%% used by the compiler (as passed to the assembler). - -conv_func(Is) -> - conv_func_1(labels(Is)). - -conv_func_1({Ls,[{func_info,[{atom,M},{atom,F},Ar]}, - {label,Entry}=Le|Is]}) -> - %% The entry label gets maybe not correct here - {function,F,Ar,Entry, - [{label,L}||L<-Ls]++[{func_info,{atom,M},{atom,F},Ar},Le|Is]}. - -%%% -%%% The validator follows. -%%% -%%% The purpose of the validator is find errors in the generated code -%%% that may cause the emulator to crash or behave strangely. -%%% We don't care about type errors in the user's code that will -%%% cause a proper exception at run-time. -%%% - -%%% Things currently not checked. XXX -%%% -%%% - That floating point registers are initialized before used. -%%% - That fclearerror and fcheckerror are used properly. -%%% - Heap allocation for floating point numbers. -%%% - Heap allocation for binaries. -%%% - That a catchtag or trytag is not overwritten by the wrong -%%% type of instruction (such as move/2). -%%% - Make sure that all catchtags and trytags have been removed -%%% from the stack at return/tail call. -%%% - Verify get_list instructions. -%%% - -%% validate([Function]) -> [] | [Error] -%% A list of functions with their code. The code is in the same -%% format as used in the compiler and in .S files. -validate([]) -> []; -validate([{function,Name,Ar,Entry,Code}|Fs]) -> - try validate_1(Code, Name, Ar, Entry) of - _ -> validate(Fs) - catch - Error -> - [Error|validate(Fs)]; - error:Error -> - [validate_error(Error, Name, Ar)|validate(Fs)] - end. - --ifdef(DEBUG). -validate_error(Error, Name, Ar) -> - exit(validate_error_1(Error, Name, Ar)). --else. -validate_error(Error, Name, Ar) -> - validate_error_1(Error, Name, Ar). --endif. -validate_error_1(Error, Name, Ar) -> - {{'_',Name,Ar}, - {internal_error,'_',{Error,erlang:get_stacktrace()}}}. - --record(st, %Emulation state - {x=init_regs(0, term), %x register info. - y=init_regs(0, initialized), %y register info. - numy=none, %Number of y registers. - h=0, %Available heap size. - ct=[] %List of hot catch/try labels - }). - --record(vst, %Validator state - {current=none, %Current state - branched=gb_trees:empty() %States at jumps - }). - --ifdef(DEBUG). -print_st(#st{x=Xs,y=Ys,numy=NumY,h=H,ct=Ct}) -> - io:format(" #st{x=~p~n" - " y=~p~n" - " numy=~p,h=~p,ct=~w~n", - [gb_trees:to_list(Xs),gb_trees:to_list(Ys),NumY,H,Ct]). --endif. - -validate_1(Is, Name, Arity, Entry) -> - validate_2(labels(Is), Name, Arity, Entry). - -validate_2({Ls1,[{func_info,{atom,Mod},{atom,Name},Arity}=_F|Is]}, - Name, Arity, Entry) -> - lists:foreach(fun (_L) -> ?DBG_FORMAT(" ~p.~n", [_L]) end, Ls1), - ?DBG_FORMAT(" ~p.~n", [_F]), - validate_3(labels(Is), Name, Arity, Entry, Mod, Ls1); -validate_2({Ls1,Is}, Name, Arity, _Entry) -> - error({{'_',Name,Arity},{first(Is),length(Ls1),illegal_instruction}}). - -validate_3({Ls2,Is}, Name, Arity, Entry, Mod, Ls1) -> - lists:foreach(fun (_L) -> ?DBG_FORMAT(" ~p.~n", [_L]) end, Ls2), - Offset = 1 + length(Ls2), - case lists:member(Entry, Ls2) of - true -> - St = init_state(Arity), - Vst = #vst{current=St, - branched=gb_trees_from_list([{L,St} || L <- Ls1])}, - valfun(Is, {Mod,Name,Arity}, Offset, Vst); - false -> - error({{Mod,Name,Arity},{first(Is),Offset,no_entry_label}}) - end. - -first([X|_]) -> X; -first([]) -> []. - -labels(Is) -> - labels_1(Is, []). - -labels_1([{label,L}|Is], R) -> - labels_1(Is, [L|R]); -labels_1(Is, R) -> - {lists:reverse(R),Is}. - -init_state(Arity) -> - Xs = init_regs(Arity, term), - Ys = init_regs(0, initialized), - #st{x=Xs,y=Ys,numy=none,h=0,ct=[]}. - -init_regs(0, _) -> - gb_trees:empty(); -init_regs(N, Type) -> - gb_trees_from_list([{R,Type} || R <- lists:seq(0, N-1)]). - -valfun([], _MFA, _Offset, Vst) -> Vst; -valfun([I|Is], MFA, Offset, Vst) -> - ?DBG_FORMAT(" ~p.\n", [I]), - valfun(Is, MFA, Offset+1, - try valfun_1(I, Vst) - catch Error -> - error({MFA,{I,Offset,Error}}) - end). - -%% Instructions that are allowed in dead code or when failing, -%% that is while the state is undecided in some way. -valfun_1({label,Lbl}, #vst{current=St0,branched=B}=Vst) -> - St = merge_states(Lbl, St0, B), - Vst#vst{current=St,branched=gb_trees:enter(Lbl, St, B)}; -valfun_1(_I, #vst{current=none}=Vst) -> - %% Ignore instructions after erlang:error/1,2, which - %% the original R10B compiler thought would return. - ?DBG_FORMAT("Ignoring ~p\n", [_I]), - Vst; -valfun_1({badmatch,Src}, Vst) -> - assert_term(Src, Vst), - kill_state(Vst); -valfun_1({case_end,Src}, Vst) -> - assert_term(Src, Vst), - kill_state(Vst); -valfun_1(if_end, Vst) -> - kill_state(Vst); -valfun_1({try_case_end,Src}, Vst) -> - assert_term(Src, Vst), - kill_state(Vst); -%% Instructions that can not cause exceptions -valfun_1({move,Src,Dst}, Vst) -> - Type = get_term_type(Src, Vst), - set_type_reg(Type, Dst, Vst); -valfun_1({fmove,Src,{fr,_}}, Vst) -> - assert_type(float, Src, Vst); -valfun_1({fmove,{fr,_},Dst}, Vst) -> - set_type_reg({float,[]}, Dst, Vst); -valfun_1({kill,{y,_}=Reg}, Vst) -> - set_type_y(initialized, Reg, Vst); -valfun_1({test_heap,Heap,Live}, Vst) -> - test_heap(Heap, Live, Vst); -valfun_1({bif,_Op,nofail,Src,Dst}, Vst) -> - validate_src(Src, Vst), - set_type_reg(term, Dst, Vst); -%% Put instructions. -valfun_1({put_list,A,B,Dst}, Vst0) -> - assert_term(A, Vst0), - assert_term(B, Vst0), - Vst = eat_heap(2, Vst0), - set_type_reg(cons, Dst, Vst); -valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) -> - Vst = eat_heap(1, Vst0), - set_type_reg({tuple,Sz}, Dst, Vst); -valfun_1({put,Src}, Vst) -> - assert_term(Src, Vst), - eat_heap(1, Vst); -valfun_1({put_string,Sz,_,Dst}, Vst0) when is_integer(Sz) -> - Vst = eat_heap(2*Sz, Vst0), - set_type_reg(cons, Dst, Vst); -%% Allocate and deallocate, et.al -valfun_1({allocate,Stk,Live}, Vst) -> - allocate(false, Stk, 0, Live, Vst); -valfun_1({allocate_heap,Stk,Heap,Live}, Vst) -> - allocate(false, Stk, Heap, Live, Vst); -valfun_1({allocate_zero,Stk,Live}, Vst) -> - allocate(true, Stk, 0, Live, Vst); -valfun_1({allocate_heap_zero,Stk,Heap,Live}, Vst) -> - allocate(true, Stk, Heap, Live, Vst); -valfun_1({init,{y,_}=Reg}, Vst) -> - set_type_y(initialized, Reg, Vst); -valfun_1({deallocate,StkSize}, #vst{current=#st{numy=StkSize,ct=[]}}=Vst) -> - deallocate(Vst); -valfun_1({deallocate,_}, #vst{current=#st{numy=NumY,ct=[]}}) -> - error({allocated,NumY}); -valfun_1({deallocate,_}, #vst{current=#st{ct=Fails}}) -> - error({catch_try_stack,Fails}); -%% Catch & try. -valfun_1({'catch',Dst,{f,Fail}}, Vst0) when Fail /= none -> - Vst = #vst{current=#st{ct=Fails}=St} = - set_type_y({catchtag,Fail}, Dst, Vst0), - Vst#vst{current=St#st{ct=[Fail|Fails]}}; -valfun_1({'try',Dst,{f,Fail}}, Vst0) -> - Vst = #vst{current=#st{ct=Fails}=St} = - set_type_y({trytag,Fail}, Dst, Vst0), - Vst#vst{current=St#st{ct=[Fail|Fails]}}; -%% Do a postponed state branch if necessary and try next set of instructions -valfun_1(I, #vst{current=#st{ct=[]}}=Vst) -> - valfun_2(I, Vst); -valfun_1(I, #vst{current=#st{ct=Fails}}=Vst0) -> - %% Perform a postponed state branch - Vst = #vst{current=St} = lists:foldl(fun branch_state/2, Vst0, Fails), - valfun_2(I, Vst#vst{current=St#st{ct=[]}}). - -%% Instructions that can cause exceptions. -valfun_2({apply,Live}, Vst) -> - call(Live+2, Vst); -valfun_2({apply_last,Live,_}, Vst) -> - tail_call(Live+2, Vst); -valfun_2({call_fun,Live}, Vst) -> - call(Live, Vst); -valfun_2({call,Live,_}, Vst) -> - call(Live, Vst); -valfun_2({call_ext,Live,Func}, Vst) -> - call(Func, Live, Vst); -valfun_2({call_only,Live,_}, Vst) -> - tail_call(Live, Vst); -valfun_2({call_ext_only,Live,_}, Vst) -> - tail_call(Live, Vst); -valfun_2({call_last,Live,_,_}, Vst) -> - tail_call(Live, Vst); -valfun_2({call_ext_last,Live,_,_}, Vst) -> - tail_call(Live, Vst); -valfun_2({make_fun,_,_,Live}, Vst) -> - call(Live, Vst); -valfun_2({make_fun2,_,_,_,Live}, Vst) -> - call(Live, Vst); -%% Floating point. -valfun_2({fconv,Src,{fr,_}}, Vst) -> - assert_term(Src, Vst); -valfun_2({bif,fadd,_,[{fr,_},{fr,_}],{fr,_}}, Vst) -> - Vst; -valfun_2({bif,fdiv,_,[{fr,_},{fr,_}],{fr,_}}, Vst) -> - Vst; -valfun_2({bif,fmul,_,[{fr,_},{fr,_}],{fr,_}}, Vst) -> - Vst; -valfun_2({bif,fnegate,_,[{fr,_}],{fr,_}}, Vst) -> - Vst; -valfun_2({bif,fsub,_,[{fr,_},{fr,_}],{fr,_}}, Vst) -> - Vst; -valfun_2(fclearerror, Vst) -> - Vst; -valfun_2({fcheckerror,_}, Vst) -> - Vst; -%% Other BIFs -valfun_2({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) -> - TupleType0 = get_term_type(Tuple, Vst0), - PosType = get_term_type(Pos, Vst0), - Vst1 = branch_state(Fail, Vst0), - TupleType = upgrade_type({tuple,[get_tuple_size(PosType)]}, TupleType0), - Vst = set_type(TupleType, Tuple, Vst1), - set_type_reg(term, Dst, Vst); -valfun_2({bif,Op,{f,Fail},Src,Dst}, Vst0) -> - validate_src(Src, Vst0), - Vst = branch_state(Fail, Vst0), - Type = bif_type(Op, Src, Vst), - set_type_reg(Type, Dst, Vst); -valfun_2(return, #vst{current=#st{numy=none}}=Vst) -> - kill_state(Vst); -valfun_2(return, #vst{current=#st{numy=NumY}}) -> - error({stack_frame,NumY}); -valfun_2({jump,{f,_}}, #vst{current=none}=Vst) -> - %% Must be an unreachable jump which was not optimized away. - %% Do nothing. - Vst; -valfun_2({jump,{f,Lbl}}, Vst) -> - kill_state(branch_state(Lbl, Vst)); -valfun_2({loop_rec,{f,Fail},Dst}, Vst0) -> - Vst = branch_state(Fail, Vst0), - set_type_reg(term, Dst, Vst); -valfun_2(remove_message, Vst) -> - Vst; -valfun_2({wait,_}, Vst) -> - kill_state(Vst); -valfun_2({wait_timeout,_,Src}, Vst) -> - assert_term(Src, Vst); -valfun_2({loop_rec_end,_}, Vst) -> - kill_state(Vst); -valfun_2(timeout, #vst{current=St}=Vst) -> - Vst#vst{current=St#st{x=init_regs(0, term)}}; -valfun_2(send, Vst) -> - call(2, Vst); -%% Catch & try. -valfun_2({catch_end,Reg}, Vst0) -> - case get_type(Reg, Vst0) of - {catchtag,_} -> - Vst = #vst{current=St} = set_type_reg(initialized, Reg, Vst0), - Xs = gb_trees_from_list([{0,term}]), - Vst#vst{current=St#st{x=Xs}}; - Type -> - error({bad_type,Type}) - end; -valfun_2({try_end,Reg}, Vst) -> - case get_type(Reg, Vst) of - {trytag,_} -> - set_type_reg(initialized, Reg, Vst); - Type -> - error({bad_type,Type}) - end; -valfun_2({try_case,Reg}, Vst0) -> - case get_type(Reg, Vst0) of - {trytag,_} -> - Vst = #vst{current=St} = set_type_reg(initialized, Reg, Vst0), - Xs = gb_trees_from_list([{0,{atom,[]}},{1,term},{2,term}]), - Vst#vst{current=St#st{x=Xs}}; - Type -> - error({bad_type,Type}) - end; -valfun_2({set_tuple_element,Src,Tuple,I}, Vst) -> - assert_term(Src, Vst), - assert_type({tuple_element,I+1}, Tuple, Vst); -%% Match instructions. -valfun_2({select_val,Src,{f,Fail},{list,Choices}}, Vst) -> - assert_term(Src, Vst), - Lbls = [L || {f,L} <- Choices]++[Fail], - kill_state(foldl(fun(L, S) -> branch_state(L, S) end, Vst, Lbls)); -valfun_2({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) -> - assert_type(tuple, Tuple, Vst), - kill_state(branch_arities(Choices, Tuple, branch_state(Fail, Vst))); -valfun_2({get_list,Src,D1,D2}, Vst0) -> - assert_term(Src, Vst0), - Vst = set_type_reg(term, D1, Vst0), - set_type_reg(term, D2, Vst); -valfun_2({get_tuple_element,Src,I,Dst}, Vst) -> - assert_type({tuple_element,I+1}, Src, Vst), - set_type_reg(term, Dst, Vst); -valfun_2({bs_restore,_}, Vst) -> - Vst; -valfun_2({bs_save,_}, Vst) -> - Vst; -valfun_2({bs_start_match,{f,Fail},Src}, Vst) -> - assert_term(Src, Vst), - branch_state(Fail, Vst); -valfun_2({test,bs_skip_bits,{f,Fail},[Src,_,_]}, Vst) -> - assert_term(Src, Vst), - branch_state(Fail, Vst); -valfun_2({test,_,{f,Fail},[_,_,_,Dst]}, Vst0) -> - Vst = branch_state(Fail, Vst0), - set_type_reg({integer,[]}, Dst, Vst); -valfun_2({test,bs_test_tail,{f,Fail},_}, Vst) -> - branch_state(Fail, Vst); -%% Other test instructions. -valfun_2({test,is_float,{f,Lbl},[Float]}, Vst0) -> - assert_term(Float, Vst0), - Vst = branch_state(Lbl, Vst0), - set_type({float,[]}, Float, Vst); -valfun_2({test,is_tuple,{f,Lbl},[Tuple]}, Vst0) -> - assert_term(Tuple, Vst0), - Vst = branch_state(Lbl, Vst0), - set_type({tuple,[0]}, Tuple, Vst); -valfun_2({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst0) when is_integer(Sz) -> - assert_type(tuple, Tuple, Vst0), - Vst = branch_state(Lbl, Vst0), - set_type_reg({tuple,Sz}, Tuple, Vst); -valfun_2({test,_Op,{f,Lbl},Src}, Vst) -> - validate_src(Src, Vst), - branch_state(Lbl, Vst); -valfun_2({bs_add,{f,Fail},[A,B,_],Dst}, Vst0) -> - assert_term(A, Vst0), - assert_term(B, Vst0), - Vst = branch_state(Fail, Vst0), - set_type_reg({integer,[]}, Dst, Vst); -valfun_2({bs_bits_to_bytes,{f,Fail},Src,Dst}, Vst0) -> - assert_term(Src, Vst0), - Vst = branch_state(Fail, Vst0), - set_type_reg({integer,[]}, Dst, Vst); -valfun_2({bs_init2,{f,Fail},_,Heap,_,_,Dst}, Vst0) -> - Vst1 = heap_alloc(Heap, Vst0), - Vst = branch_state(Fail, Vst1), - set_type_reg(binary, Dst, Vst); -valfun_2({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> - Vst; -valfun_2({bs_put_binary,{f,Fail},_,_,_,Src}, Vst0) -> - assert_term(Src, Vst0), - branch_state(Fail, Vst0); -valfun_2({bs_put_float,{f,Fail},_,_,_,Src}, Vst0) -> - assert_term(Src, Vst0), - branch_state(Fail, Vst0); -valfun_2({bs_put_integer,{f,Fail},_,_,_,Src}, Vst0) -> - assert_term(Src, Vst0), - branch_state(Fail, Vst0); -%% Old bit syntax construction (before R10B). -valfun_2({bs_init,_,_}, Vst) -> Vst; -valfun_2({bs_need_buf,_}, Vst) -> Vst; -valfun_2({bs_final,{f,Fail},Dst}, Vst0) -> - Vst = branch_state(Fail, Vst0), - set_type_reg(binary, Dst, Vst); -%% Misc. -valfun_2({'%live',Live}, Vst) -> - verify_live(Live, Vst), - Vst; -valfun_2(_, _) -> - error(unknown_instruction). - -kill_state(#vst{current=#st{ct=[]}}=Vst) -> - Vst#vst{current=none}; -kill_state(#vst{current=#st{ct=Fails}}=Vst0) -> - Vst = lists:foldl(fun branch_state/2, Vst0, Fails), - Vst#vst{current=none}. - -%% A "plain" call. -%% The stackframe must have a known size and be initialized. -%% The instruction will return to the instruction following the call. -call(Live, #vst{current=St}=Vst) -> - verify_live(Live, Vst), - verify_y_init(Vst), - Xs = gb_trees_from_list([{0,term}]), - Vst#vst{current=St#st{x=Xs}}. - -%% A "plain" call. -%% The stackframe must have a known size and be initialized. -%% The instruction will return to the instruction following the call. -call(Name, Live, #vst{current=St}=Vst) -> - verify_live(Live, Vst), - case return_type(Name, Vst) of - exception -> - kill_state(Vst); - Type -> - verify_y_init(Vst), - Xs = gb_trees_from_list([{0,Type}]), - Vst#vst{current=St#st{x=Xs}} - end. - -%% Tail call. -%% The stackframe must have a known size and be initialized. -%% Does not return to the instruction following the call. -tail_call(Live, Vst) -> - kill_state(call(Live, Vst)). - -allocate(Zero, Stk, Heap, Live, #vst{current=#st{numy=none}=St}=Vst) -> - verify_live(Live, Vst), - Ys = init_regs(case Zero of - true -> Stk; - false -> 0 - end, initialized), - Vst#vst{current=St#st{y=Ys,numy=Stk,h=heap_alloc_1(Heap)}}; -allocate(_, _, _, _, #vst{current=#st{numy=Numy}}) -> - error({existing_stack_frame,{size,Numy}}). - -deallocate(#vst{current=St}=Vst) -> - Vst#vst{current=St#st{y=init_regs(0, initialized),numy=none}}. - -test_heap(Heap, Live, Vst) -> - verify_live(Live, Vst), - heap_alloc(Heap, Vst). - -heap_alloc(Heap, #vst{current=St}=Vst) -> - Vst#vst{current=St#st{h=heap_alloc_1(Heap)}}. - -heap_alloc_1({alloc,Alloc}) -> - {value,{_,Heap}} = lists:keysearch(words, 1, Alloc), - Heap; -heap_alloc_1(Heap) when is_integer(Heap) -> Heap. - - -set_type(Type, {x,_}=Reg, Vst) -> set_type_reg(Type, Reg, Vst); -set_type(Type, {y,_}=Reg, Vst) -> set_type_y(Type, Reg, Vst); -set_type(_, _, #vst{}=Vst) -> Vst. - -set_type_reg(Type, {x,X}, #vst{current=#st{x=Xs}=St}=Vst) - when 0 =< X, X < ?MAXREG -> - Vst#vst{current=St#st{x=gb_trees:enter(X, Type, Xs)}}; -set_type_reg(Type, Reg, Vst) -> - set_type_y(Type, Reg, Vst). - -set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys,numy=NumY}=St}=Vst) - when is_integer(Y), 0 =< Y, Y < ?MAXREG -> - case {Y,NumY} of - {_,none} -> - error({no_stack_frame,Reg}); - {_,_} when Y > NumY -> - error({y_reg_out_of_range,Reg,NumY}); - {_,_} -> - Vst#vst{current=St#st{y=gb_trees:enter(Y, Type, Ys)}} - end; -set_type_y(Type, Reg, #vst{}) -> error({invalid_store,Reg,Type}). - -assert_term(Src, Vst) -> - get_term_type(Src, Vst), - Vst. - -%% The possible types. -%% -%% First non-term types: -%% -%% initialized Only for Y registers. Means that the Y register -%% has been initialized with some valid term so that -%% it is safe to pass to the garbage collector. -%% NOT safe to use in any other way (will not crash the -%% emulator, but clearly points to a bug in the compiler). -%% -%% {catchtag,Lbl} A special term used within a catch. Must only be used -%% by the catch instructions; NOT safe to use in other -%% instructions. -%% -%% {trytag,Lbl} A special term used within a try block. Must only be -%% used by the catch instructions; NOT safe to use in other -%% instructions. -%% -%% exception Can only be used as a type returned by return_type/2 -%% (which gives the type of the value returned by a BIF). -%% Thus 'exception' is never stored as type descriptor -%% for a register. -%% -%% Normal terms: -%% -%% term Any valid Erlang (but not of the special types above). -%% -%% bool The atom 'true' or the atom 'false'. -%% -%% cons Cons cell: [_|_] -%% -%% nil Empty list: [] -%% -%% {tuple,[Sz]} Tuple. An element has been accessed using -%% element/2 or setelement/3 so that it is known that -%% the type is a tuple of size at least Sz. -%% -%% {tuple,Sz} Tuple. A test_arity instruction has been seen -%% so that it is known that the size is exactly Sz. -%% -%% {atom,[]} Atom. -%% {atom,Atom} -%% -%% {integer,[]} Integer. -%% {integer,Integer} -%% -%% {float,[]} Float. -%% {float,Float} -%% -%% number Integer or Float of unknown value -%% - -assert_type(WantedType, Term, Vst) -> - assert_type(WantedType, get_type(Term, Vst)), - Vst. - -assert_type(float, {float,_}) -> ok; -assert_type(tuple, {tuple,_}) -> ok; -assert_type({tuple_element,I}, {tuple,[Sz]}) - when 1 =< I, I =< Sz -> - ok; -assert_type({tuple_element,I}, {tuple,Sz}) - when is_integer(Sz), 1 =< I, I =< Sz -> - ok; -assert_type(Needed, Actual) -> - error({bad_type,{needed,Needed},{actual,Actual}}). - -%% upgrade_type/2 is used when linear code finds out more and -%% more information about a type, so the type gets "narrower" -%% or perhaps inconsistent. In the case of inconsistency -%% we mostly widen the type to 'term' to make subsequent -%% code fail if it assumes anything about the type. - -upgrade_type(Same, Same) -> Same; -upgrade_type(term, OldT) -> OldT; -upgrade_type(NewT, term) -> NewT; -upgrade_type({Type,New}=NewT, {Type,Old}=OldT) - when Type == atom; Type == integer; Type == float -> - if New =:= Old -> OldT; - New =:= [] -> OldT; - Old =:= [] -> NewT; - true -> term - end; -upgrade_type({Type,_}=NewT, number) - when Type == integer; Type == float -> - NewT; -upgrade_type(number, {Type,_}=OldT) - when Type == integer; Type == float -> - OldT; -upgrade_type(bool, {atom,A}) -> - upgrade_bool(A); -upgrade_type({atom,A}, bool) -> - upgrade_bool(A); -upgrade_type({tuple,[Sz]}, {tuple,[OldSz]}) - when is_integer(Sz) -> - {tuple,[max(Sz, OldSz)]}; -upgrade_type({tuple,Sz}=T, {tuple,[_]}) - when is_integer(Sz) -> - %% This also takes care of the user error when a tuple element - %% is accesed outside the known exact tuple size; there is - %% no more type information, just a runtime error which is not - %% our problem. - T; -upgrade_type({tuple,[Sz]}, {tuple,_}=T) - when is_integer(Sz) -> - %% Same as the previous clause but mirrored. - T; -upgrade_type(_A, _B) -> - %%io:format("upgrade_type: ~p ~p\n", [_A,_B]), - term. - -upgrade_bool([]) -> bool; -upgrade_bool(true) -> {atom,true}; -upgrade_bool(false) -> {atom,false}; -upgrade_bool(_) -> term. - -get_tuple_size({integer,[]}) -> 0; -get_tuple_size({integer,Sz}) -> Sz; -get_tuple_size(_) -> 0. - -validate_src(Ss, Vst) when is_list(Ss) -> - foldl(fun(S, _) -> get_type(S, Vst) end, ok, Ss). - -get_term_type(Src, Vst) -> - case get_type(Src, Vst) of - initialized -> error({not_assigned,Src}); - exception -> error({exception,Src}); - {catchtag,_} -> error({catchtag,Src}); - {trytag,_} -> error({trytag,Src}); - Type -> Type - end. - -get_type(nil=T, _) -> T; -get_type({atom,A}=T, _) when is_atom(A) -> T; -get_type({float,F}=T, _) when is_float(F) -> T; -get_type({integer,I}=T, _) when is_integer(I) -> T; -get_type({x,X}=Reg, #vst{current=#st{x=Xs}}) when is_integer(X) -> - case gb_trees:lookup(X, Xs) of - {value,Type} -> Type; - none -> error({uninitialized_reg,Reg}) - end; -get_type({y,Y}=Reg, #vst{current=#st{y=Ys}}) when is_integer(Y) -> - case gb_trees:lookup(Y, Ys) of - {value,initialized} -> error({unassigned_reg,Reg}); - {value,Type} -> Type; - none -> error({uninitialized_reg,Reg}) - end; -get_type(Src, _) -> error({bad_source,Src}). - -branch_arities([], _, #vst{}=Vst) -> Vst; -branch_arities([Sz,{f,L}|T], Tuple, #vst{current=St}=Vst0) - when is_integer(Sz) -> - Vst1 = set_type_reg({tuple,Sz}, Tuple, Vst0), - Vst = branch_state(L, Vst1), - branch_arities(T, Tuple, Vst#vst{current=St}). - -branch_state(0, #vst{}=Vst) -> Vst; -branch_state(L, #vst{current=St,branched=B}=Vst) -> - Vst#vst{ - branched=case gb_trees:is_defined(L, B) of - false -> - gb_trees:insert(L, St#st{ct=[]}, B); - true -> - MergedSt = merge_states(L, St, B), - gb_trees:update(L, MergedSt#st{ct=[]}, B) - end}. - -%% merge_states/3 is used when there are more than one way to arrive -%% at this point, and the type states for the different paths has -%% to be merged. The type states are downgraded to the least common -%% subset for the subsequent code. - -merge_states(0, St, _Branched) -> St; -merge_states(L, St, Branched) -> - case gb_trees:lookup(L, Branched) of - none -> St; - {value,OtherSt} when St == none -> OtherSt; - {value,OtherSt} -> - merge_states_1(St, OtherSt) - end. - -merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0}=St, - #st{x=Xs1,y=Ys1,numy=NumY1,h=H1}) -> - NumY = merge_stk(NumY0, NumY1), - Xs = merge_regs(Xs0, Xs1), - Ys = merge_regs(Ys0, Ys1), - St#st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1)}. - -merge_stk(S, S) -> S; -merge_stk(_, _) -> undecided. - -merge_regs(Rs0, Rs1) -> - Rs = merge_regs_1(gb_trees:to_list(Rs0), gb_trees:to_list(Rs1)), - gb_trees_from_list(Rs). - -merge_regs_1([Same|Rs1], [Same|Rs2]) -> - [Same|merge_regs_1(Rs1, Rs2)]; -merge_regs_1([{R1,_}|Rs1], [{R2,_}|_]=Rs2) when R1 < R2 -> - merge_regs_1(Rs1, Rs2); -merge_regs_1([{R1,_}|_]=Rs1, [{R2,_}|Rs2]) when R1 > R2 -> - merge_regs_1(Rs1, Rs2); -merge_regs_1([{R,Type1}|Rs1], [{R,Type2}|Rs2]) -> - [{R,merge_types(Type1, Type2)}|merge_regs_1(Rs1, Rs2)]; -merge_regs_1([], []) -> []; -merge_regs_1([], [_|_]) -> []; -merge_regs_1([_|_], []) -> []. - -merge_types(T, T) -> T; -merge_types(initialized=I, _) -> I; -merge_types(_, initialized=I) -> I; -merge_types({tuple,Same}=T, {tuple,Same}) -> T; -merge_types({tuple,A}, {tuple,B}) -> - {tuple,[min(tuple_sz(A), tuple_sz(B))]}; -merge_types({Type,A}, {Type,B}) - when Type == atom; Type == integer; Type == float -> - if A =:= B -> {Type,A}; - true -> {Type,[]} - end; -merge_types({Type,_}, number) - when Type == integer; Type == float -> - number; -merge_types(number, {Type,_}) - when Type == integer; Type == float -> - number; -merge_types(bool, {atom,A}) -> - merge_bool(A); -merge_types({atom,A}, bool) -> - merge_bool(A); -merge_types(_, _) -> term. - -tuple_sz([Sz]) -> Sz; -tuple_sz(Sz) -> Sz. - -merge_bool([]) -> {atom,[]}; -merge_bool(true) -> bool; -merge_bool(false) -> bool; -merge_bool(_) -> {atom,[]}. - -verify_y_init(#vst{current=#st{numy=none}}) -> ok; -verify_y_init(#vst{current=#st{numy=undecided}}) -> - error(unknown_size_of_stackframe); -verify_y_init(#vst{current=#st{y=Ys,numy=NumY}}) -> - verify_y_init_1(NumY, Ys). - -verify_y_init_1(0, _) -> ok; -verify_y_init_1(N, Ys) -> - Y = N-1, - case gb_trees:is_defined(Y, Ys) of - false -> error({{y,Y},not_initialized}); - true -> verify_y_init_1(Y, Ys) - end. - -verify_live(0, #vst{}) -> ok; -verify_live(N, #vst{current=#st{x=Xs}}) -> - verify_live_1(N, Xs). - -verify_live_1(0, _) -> ok; -verify_live_1(N, Xs) -> - X = N-1, - case gb_trees:is_defined(X, Xs) of - false -> error({{x,X},not_live}); - true -> verify_live_1(X, Xs) - end. - -eat_heap(N, #vst{current=#st{h=Heap0}=St}=Vst) -> - case Heap0-N of - Neg when Neg < 0 -> - error({heap_overflow,{left,Heap0},{wanted,N}}); - Heap -> - Vst#vst{current=St#st{h=Heap}} - end. - -bif_type('-', Src, Vst) -> - arith_type(Src, Vst); -bif_type('+', Src, Vst) -> - arith_type(Src, Vst); -bif_type('*', Src, Vst) -> - arith_type(Src, Vst); -bif_type(abs, [Num], Vst) -> - case get_type(Num, Vst) of - {float,_}=T -> T; - {integer,_}=T -> T; - _ -> number - end; -bif_type(float, _, _) -> {float,[]}; -bif_type('/', _, _) -> {float,[]}; -%% Integer operations. -bif_type('div', [_,_], _) -> {integer,[]}; -bif_type('rem', [_,_], _) -> {integer,[]}; -bif_type(length, [_], _) -> {integer,[]}; -bif_type(size, [_], _) -> {integer,[]}; -bif_type(trunc, [_], _) -> {integer,[]}; -bif_type(round, [_], _) -> {integer,[]}; -bif_type('band', [_,_], _) -> {integer,[]}; -bif_type('bor', [_,_], _) -> {integer,[]}; -bif_type('bxor', [_,_], _) -> {integer,[]}; -bif_type('bnot', [_], _) -> {integer,[]}; -bif_type('bsl', [_,_], _) -> {integer,[]}; -bif_type('bsr', [_,_], _) -> {integer,[]}; -%% Booleans. -bif_type('==', [_,_], _) -> bool; -bif_type('/=', [_,_], _) -> bool; -bif_type('=<', [_,_], _) -> bool; -bif_type('<', [_,_], _) -> bool; -bif_type('>=', [_,_], _) -> bool; -bif_type('>', [_,_], _) -> bool; -bif_type('=:=', [_,_], _) -> bool; -bif_type('=/=', [_,_], _) -> bool; -bif_type('not', [_], _) -> bool; -bif_type('and', [_,_], _) -> bool; -bif_type('or', [_,_], _) -> bool; -bif_type('xor', [_,_], _) -> bool; -bif_type(is_atom, [_], _) -> bool; -bif_type(is_boolean, [_], _) -> bool; -bif_type(is_binary, [_], _) -> bool; -bif_type(is_constant, [_], _) -> bool; -bif_type(is_float, [_], _) -> bool; -bif_type(is_function, [_], _) -> bool; -bif_type(is_integer, [_], _) -> bool; -bif_type(is_list, [_], _) -> bool; -bif_type(is_number, [_], _) -> bool; -bif_type(is_pid, [_], _) -> bool; -bif_type(is_port, [_], _) -> bool; -bif_type(is_reference, [_], _) -> bool; -bif_type(is_tuple, [_], _) -> bool; -%% Misc. -bif_type(node, [], _) -> {atom,[]}; -bif_type(node, [_], _) -> {atom,[]}; -bif_type(hd, [_], _) -> term; -bif_type(tl, [_], _) -> term; -bif_type(get, [_], _) -> term; -bif_type(raise, [_,_], _) -> exception; -bif_type(_, _, _) -> term. - -arith_type([A,B], Vst) -> - case {get_type(A, Vst),get_type(B, Vst)} of - {{float,_},_} -> {float,[]}; - {_,{float,_}} -> {float,[]}; - {_,_} -> number - end; -arith_type(_, _) -> number. - -return_type({extfunc,M,F,A}, Vst) -> - return_type_1(M, F, A, Vst). - -return_type_1(erlang, setelement, 3, Vst) -> - Tuple = {x,1}, - TupleType = - case get_type(Tuple, Vst) of - {tuple,_}=TT -> TT; - _ -> {tuple,[0]} - end, - case get_type({x,0}, Vst) of - {integer,[]} -> TupleType; - {integer,I} -> upgrade_type({tuple,[I]}, TupleType); - _ -> TupleType - end; -return_type_1(erlang, F, A, _) -> - return_type_erl(F, A); -return_type_1(math, F, A, _) -> - return_type_math(F, A); -return_type_1(_, _, _, _) -> term. - -return_type_erl(exit, 1) -> exception; -return_type_erl(throw, 1) -> exception; -return_type_erl(fault, 1) -> exception; -return_type_erl(fault, 2) -> exception; -return_type_erl(error, 1) -> exception; -return_type_erl(error, 2) -> exception; -return_type_erl(_, _) -> term. - -return_type_math(cos, 1) -> {float,[]}; -return_type_math(cosh, 1) -> {float,[]}; -return_type_math(sin, 1) -> {float,[]}; -return_type_math(sinh, 1) -> {float,[]}; -return_type_math(tan, 1) -> {float,[]}; -return_type_math(tanh, 1) -> {float,[]}; -return_type_math(acos, 1) -> {float,[]}; -return_type_math(acosh, 1) -> {float,[]}; -return_type_math(asin, 1) -> {float,[]}; -return_type_math(asinh, 1) -> {float,[]}; -return_type_math(atan, 1) -> {float,[]}; -return_type_math(atanh, 1) -> {float,[]}; -return_type_math(erf, 1) -> {float,[]}; -return_type_math(erfc, 1) -> {float,[]}; -return_type_math(exp, 1) -> {float,[]}; -return_type_math(log, 1) -> {float,[]}; -return_type_math(log10, 1) -> {float,[]}; -return_type_math(sqrt, 1) -> {float,[]}; -return_type_math(atan2, 2) -> {float,[]}; -return_type_math(pow, 2) -> {float,[]}; -return_type_math(pi, 0) -> {float,[]}; -return_type_math(_, _) -> term. - -min(A, B) when is_integer(A), is_integer(B), A < B -> A; -min(A, B) when is_integer(A), is_integer(B) -> B. - -max(A, B) when is_integer(A), is_integer(B), A > B -> A; -max(A, B) when is_integer(A), is_integer(B) -> B. - -gb_trees_from_list(L) -> gb_trees:from_orddict(orddict:from_list(L)). - --ifdef(DEBUG). -error(Error) -> exit(Error). --else. -error(Error) -> throw(Error). --endif. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl.erl deleted file mode 100644 index be9e088276..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl.erl +++ /dev/null @@ -1,4169 +0,0 @@ -%% ``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 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. -%% -%% The Initial Developer of the Original Code is Richard Carlsson. -%% Copyright (C) 1999-2002 Richard Carlsson. -%% Portions created by Ericsson are Copyright 2001, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id: cerl.erl,v 1.3 2010/03/04 13:54:20 maria Exp $ - -%% ===================================================================== -%% @doc Core Erlang abstract syntax trees. -%% -%% <p> This module defines an abstract data type for representing Core -%% Erlang source code as syntax trees.</p> -%% -%% <p>A recommended starting point for the first-time user is the -%% documentation of the function <a -%% href="#type-1"><code>type/1</code></a>.</p> -%% -%% <h3><b>NOTES:</b></h3> -%% -%% <p>This module deals with the composition and decomposition of -%% <em>syntactic</em> entities (as opposed to semantic ones); its -%% purpose is to hide all direct references to the data structures -%% used to represent these entities. With few exceptions, the -%% functions in this module perform no semantic interpretation of -%% their inputs, and in general, the user is assumed to pass -%% type-correct arguments - if this is not done, the effects are not -%% defined.</p> -%% -%% <p>The internal representations of abstract syntax trees are -%% subject to change without notice, and should not be documented -%% outside this module. Furthermore, we do not give any guarantees on -%% how an abstract syntax tree may or may not be represented, <em>with -%% the following exceptions</em>: no syntax tree is represented by a -%% single atom, such as <code>none</code>, by a list constructor -%% <code>[X | Y]</code>, or by the empty list <code>[]</code>. This -%% can be relied on when writing functions that operate on syntax -%% trees.</p> -%% -%% @type cerl(). An abstract Core Erlang syntax tree. -%% -%% <p>Every abstract syntax tree has a <em>type</em>, given by the -%% function <a href="#type-1"><code>type/1</code></a>. In addition, -%% each syntax tree has a list of <em>user annotations</em> (cf. <a -%% href="#get_ann-1"><code>get_ann/1</code></a>), which are included -%% in the Core Erlang syntax.</p> - --module(cerl). - --export([abstract/1, add_ann/2, alias_pat/1, alias_var/1, - ann_abstract/2, ann_c_alias/3, ann_c_apply/3, ann_c_atom/2, - ann_c_call/4, ann_c_case/3, ann_c_catch/2, ann_c_char/2, - ann_c_clause/3, ann_c_clause/4, ann_c_cons/3, ann_c_float/2, - ann_c_fname/3, ann_c_fun/3, ann_c_int/2, ann_c_let/4, - ann_c_letrec/3, ann_c_module/4, ann_c_module/5, ann_c_nil/1, - ann_c_cons_skel/3, ann_c_tuple_skel/2, ann_c_primop/3, - ann_c_receive/2, ann_c_receive/4, ann_c_seq/3, ann_c_string/2, - ann_c_try/6, ann_c_tuple/2, ann_c_values/2, ann_c_var/2, - ann_make_data/3, ann_make_list/2, ann_make_list/3, - ann_make_data_skel/3, ann_make_tree/3, apply_args/1, - apply_arity/1, apply_op/1, atom_lit/1, atom_name/1, atom_val/1, - c_alias/2, c_apply/2, c_atom/1, c_call/3, c_case/2, c_catch/1, - c_char/1, c_clause/2, c_clause/3, c_cons/2, c_float/1, - c_fname/2, c_fun/2, c_int/1, c_let/3, c_letrec/2, c_module/3, - c_module/4, c_nil/0, c_cons_skel/2, c_tuple_skel/1, c_primop/2, - c_receive/1, c_receive/3, c_seq/2, c_string/1, c_try/5, - c_tuple/1, c_values/1, c_var/1, call_args/1, call_arity/1, - call_module/1, call_name/1, case_arg/1, case_arity/1, - case_clauses/1, catch_body/1, char_lit/1, char_val/1, - clause_arity/1, clause_body/1, clause_guard/1, clause_pats/1, - clause_vars/1, concrete/1, cons_hd/1, cons_tl/1, copy_ann/2, - data_arity/1, data_es/1, data_type/1, float_lit/1, float_val/1, - fname_arity/1, fname_id/1, fold_literal/1, from_records/1, - fun_arity/1, fun_body/1, fun_vars/1, get_ann/1, int_lit/1, - int_val/1, is_c_alias/1, is_c_apply/1, is_c_atom/1, - is_c_call/1, is_c_case/1, is_c_catch/1, is_c_char/1, - is_c_clause/1, is_c_cons/1, is_c_float/1, is_c_fname/1, - is_c_fun/1, is_c_int/1, is_c_let/1, is_c_letrec/1, is_c_list/1, - is_c_module/1, is_c_nil/1, is_c_primop/1, is_c_receive/1, - is_c_seq/1, is_c_string/1, is_c_try/1, is_c_tuple/1, - is_c_values/1, is_c_var/1, is_data/1, is_leaf/1, is_literal/1, - is_literal_term/1, is_print_char/1, is_print_string/1, - let_arg/1, let_arity/1, let_body/1, let_vars/1, letrec_body/1, - letrec_defs/1, letrec_vars/1, list_elements/1, list_length/1, - make_data/2, make_list/1, make_list/2, make_data_skel/2, - make_tree/2, meta/1, module_attrs/1, module_defs/1, - module_exports/1, module_name/1, module_vars/1, - pat_list_vars/1, pat_vars/1, primop_args/1, primop_arity/1, - primop_name/1, receive_action/1, receive_clauses/1, - receive_timeout/1, seq_arg/1, seq_body/1, set_ann/2, - string_lit/1, string_val/1, subtrees/1, to_records/1, - try_arg/1, try_body/1, try_vars/1, try_evars/1, try_handler/1, - tuple_arity/1, tuple_es/1, type/1, unfold_literal/1, - update_c_alias/3, update_c_apply/3, update_c_call/4, - update_c_case/3, update_c_catch/2, update_c_clause/4, - update_c_cons/3, update_c_cons_skel/3, update_c_fname/2, - update_c_fname/3, update_c_fun/3, update_c_let/4, - update_c_letrec/3, update_c_module/5, update_c_primop/3, - update_c_receive/4, update_c_seq/3, update_c_try/6, - update_c_tuple/2, update_c_tuple_skel/2, update_c_values/2, - update_c_var/2, update_data/3, update_list/2, update_list/3, - update_data_skel/3, update_tree/2, update_tree/3, - values_arity/1, values_es/1, var_name/1, c_binary/1, - update_c_binary/2, ann_c_binary/2, is_c_binary/1, - binary_segments/1, c_bitstr/3, c_bitstr/4, c_bitstr/5, - update_c_bitstr/5, update_c_bitstr/6, ann_c_bitstr/5, - ann_c_bitstr/6, is_c_bitstr/1, bitstr_val/1, bitstr_size/1, - bitstr_bitsize/1, bitstr_unit/1, bitstr_type/1, - bitstr_flags/1]). - --include("core_parse.hrl"). - - -%% ===================================================================== -%% Representation (general) -%% -%% All nodes are represented by tuples of arity 2 or (generally) -%% greater, whose first element is an atom which uniquely identifies the -%% type of the node, and whose second element is a (proper) list of -%% annotation terms associated with the node - this is by default empty. -%% -%% For most node constructor functions, there are analogous functions -%% named 'ann_...', taking one extra argument 'As' (always the first -%% argument), specifying an annotation list at node creation time. -%% Similarly, there are also functions named 'update_...', taking one -%% extra argument 'Old', specifying a node from which all fields not -%% explicitly given as arguments should be copied (generally, this is -%% the annotation field only). -%% ===================================================================== - -%% This defines the general representation of constant literals: - --record(literal, {ann = [], val}). - - -%% @spec type(Node::cerl()) -> atom() -%% -%% @doc Returns the type tag of <code>Node</code>. Current node types -%% are: -%% -%% <p><center><table border="1"> -%% <tr> -%% <td>alias</td> -%% <td>apply</td> -%% <td>binary</td> -%% <td>bitstr</td> -%% <td>call</td> -%% <td>case</td> -%% <td>catch</td> -%% </tr><tr> -%% <td>clause</td> -%% <td>cons</td> -%% <td>fun</td> -%% <td>let</td> -%% <td>letrec</td> -%% <td>literal</td> -%% <td>module</td> -%% </tr><tr> -%% <td>primop</td> -%% <td>receive</td> -%% <td>seq</td> -%% <td>try</td> -%% <td>tuple</td> -%% <td>values</td> -%% <td>var</td> -%% </tr> -%% </table></center></p> -%% -%% <p>Note: The name of the primary constructor function for a node -%% type is always the name of the type itself, prefixed by -%% "<code>c_</code>"; recognizer predicates are correspondingly -%% prefixed by "<code>is_c_</code>". Furthermore, to simplify -%% preservation of annotations (cf. <code>get_ann/1</code>), there are -%% analogous constructor functions prefixed by "<code>ann_c_</code>" -%% and "<code>update_c_</code>", for setting the annotation list of -%% the new node to either a specific value or to the annotations of an -%% existing node, respectively.</p> -%% -%% @see abstract/1 -%% @see c_alias/2 -%% @see c_apply/2 -%% @see c_binary/1 -%% @see c_bitstr/5 -%% @see c_call/3 -%% @see c_case/2 -%% @see c_catch/1 -%% @see c_clause/3 -%% @see c_cons/2 -%% @see c_fun/2 -%% @see c_let/3 -%% @see c_letrec/2 -%% @see c_module/3 -%% @see c_primop/2 -%% @see c_receive/1 -%% @see c_seq/2 -%% @see c_try/3 -%% @see c_tuple/1 -%% @see c_values/1 -%% @see c_var/1 -%% @see get_ann/1 -%% @see to_records/1 -%% @see from_records/1 -%% @see data_type/1 -%% @see subtrees/1 -%% @see meta/1 - -type(Node) -> - element(1, Node). - - -%% @spec is_leaf(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is a leaf node, -%% otherwise <code>false</code>. The current leaf node types are -%% <code>literal</code> and <code>var</code>. -%% -%% <p>Note: all literals (cf. <code>is_literal/1</code>) are leaf -%% nodes, even if they represent structured (constant) values such as -%% <code>{foo, [bar, baz]}</code>. Also note that variables are leaf -%% nodes but not literals.</p> -%% -%% @see type/1 -%% @see is_literal/1 - -is_leaf(Node) -> - case type(Node) of - literal -> true; - var -> true; - _ -> false - end. - - -%% @spec get_ann(cerl()) -> [term()] -%% -%% @doc Returns the list of user annotations associated with a syntax -%% tree node. For a newly created node, this is the empty list. The -%% annotations may be any terms. -%% -%% @see set_ann/2 - -get_ann(Node) -> - element(2, Node). - - -%% @spec set_ann(Node::cerl(), Annotations::[term()]) -> cerl() -%% -%% @doc Sets the list of user annotations of <code>Node</code> to -%% <code>Annotations</code>. -%% -%% @see get_ann/1 -%% @see add_ann/2 -%% @see copy_ann/2 - -set_ann(Node, List) -> - setelement(2, Node, List). - - -%% @spec add_ann(Annotations::[term()], Node::cerl()) -> cerl() -%% -%% @doc Appends <code>Annotations</code> to the list of user -%% annotations of <code>Node</code>. -%% -%% <p>Note: this is equivalent to <code>set_ann(Node, Annotations ++ -%% get_ann(Node))</code>, but potentially more efficient.</p> -%% -%% @see get_ann/1 -%% @see set_ann/2 - -add_ann(Terms, Node) -> - set_ann(Node, Terms ++ get_ann(Node)). - - -%% @spec copy_ann(Source::cerl(), Target::cerl()) -> cerl() -%% -%% @doc Copies the list of user annotations from <code>Source</code> -%% to <code>Target</code>. -%% -%% <p>Note: this is equivalent to <code>set_ann(Target, -%% get_ann(Source))</code>, but potentially more efficient.</p> -%% -%% @see get_ann/1 -%% @see set_ann/2 - -copy_ann(Source, Target) -> - set_ann(Target, get_ann(Source)). - - -%% @spec abstract(Term::term()) -> cerl() -%% -%% @doc Creates a syntax tree corresponding to an Erlang term. -%% <code>Term</code> must be a literal term, i.e., one that can be -%% represented as a source code literal. Thus, it may not contain a -%% process identifier, port, reference, binary or function value as a -%% subterm. -%% -%% <p>Note: This is a constant time operation.</p> -%% -%% @see ann_abstract/2 -%% @see concrete/1 -%% @see is_literal/1 -%% @see is_literal_term/1 - -abstract(T) -> - #literal{val = T}. - - -%% @spec ann_abstract(Annotations::[term()], Term::term()) -> cerl() -%% @see abstract/1 - -ann_abstract(As, T) -> - #literal{val = T, ann = As}. - - -%% @spec is_literal_term(Term::term()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Term</code> can be -%% represented as a literal, otherwise <code>false</code>. This -%% function takes time proportional to the size of <code>Term</code>. -%% -%% @see abstract/1 - -is_literal_term(T) when integer(T) -> true; -is_literal_term(T) when float(T) -> true; -is_literal_term(T) when atom(T) -> true; -is_literal_term([]) -> true; -is_literal_term([H | T]) -> - case is_literal_term(H) of - true -> - is_literal_term(T); - false -> - false - end; -is_literal_term(T) when tuple(T) -> - is_literal_term_list(tuple_to_list(T)); -is_literal_term(_) -> - false. - -is_literal_term_list([T | Ts]) -> - case is_literal_term(T) of - true -> - is_literal_term_list(Ts); - false -> - false - end; -is_literal_term_list([]) -> - true. - - -%% @spec concrete(Node::cerl()) -> term() -%% -%% @doc Returns the Erlang term represented by a syntax tree. An -%% exception is thrown if <code>Node</code> does not represent a -%% literal term. -%% -%% <p>Note: This is a constant time operation.</p> -%% -%% @see abstract/1 -%% @see is_literal/1 - -%% Because the normal tuple and list constructor operations always -%% return a literal if the arguments are literals, 'concrete' and -%% 'is_literal' never need to traverse the structure. - -concrete(#literal{val = V}) -> - V. - - -%% @spec is_literal(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> represents a -%% literal term, otherwise <code>false</code>. This function returns -%% <code>true</code> if and only if the value of -%% <code>concrete(Node)</code> is defined. -%% -%% <p>Note: This is a constant time operation.</p> -%% -%% @see abstract/1 -%% @see concrete/1 -%% @see fold_literal/1 - -is_literal(#literal{}) -> - true; -is_literal(_) -> - false. - - -%% @spec fold_literal(Node::cerl()) -> cerl() -%% -%% @doc Assures that literals have a compact representation. This is -%% occasionally useful if <code>c_cons_skel/2</code>, -%% <code>c_tuple_skel/1</code> or <code>unfold_literal/1</code> were -%% used in the construction of <code>Node</code>, and you want to revert -%% to the normal "folded" representation of literals. If -%% <code>Node</code> represents a tuple or list constructor, its -%% elements are rewritten recursively, and the node is reconstructed -%% using <code>c_cons/2</code> or <code>c_tuple/1</code>, respectively; -%% otherwise, <code>Node</code> is not changed. -%% -%% @see is_literal/1 -%% @see c_cons_skel/2 -%% @see c_tuple_skel/1 -%% @see c_cons/2 -%% @see c_tuple/1 -%% @see unfold_literal/1 - -fold_literal(Node) -> - case type(Node) of - tuple -> - update_c_tuple(Node, fold_literal_list(tuple_es(Node))); - cons -> - update_c_cons(Node, fold_literal(cons_hd(Node)), - fold_literal(cons_tl(Node))); - _ -> - Node - end. - -fold_literal_list([E | Es]) -> - [fold_literal(E) | fold_literal_list(Es)]; -fold_literal_list([]) -> - []. - - -%% @spec unfold_literal(Node::cerl()) -> cerl() -%% -%% @doc Assures that literals have a fully expanded representation. If -%% <code>Node</code> represents a literal tuple or list constructor, its -%% elements are rewritten recursively, and the node is reconstructed -%% using <code>c_cons_skel/2</code> or <code>c_tuple_skel/1</code>, -%% respectively; otherwise, <code>Node</code> is not changed. The {@link -%% fold_literal/1} can be used to revert to the normal compact -%% representation. -%% -%% @see is_literal/1 -%% @see c_cons_skel/2 -%% @see c_tuple_skel/1 -%% @see c_cons/2 -%% @see c_tuple/1 -%% @see fold_literal/1 - -unfold_literal(Node) -> - case type(Node) of - literal -> - copy_ann(Node, unfold_concrete(concrete(Node))); - _ -> - Node - end. - -unfold_concrete(Val) -> - case Val of - _ when tuple(Val) -> - c_tuple_skel(unfold_concrete_list(tuple_to_list(Val))); - [H|T] -> - c_cons_skel(unfold_concrete(H), unfold_concrete(T)); - _ -> - abstract(Val) - end. - -unfold_concrete_list([E | Es]) -> - [unfold_concrete(E) | unfold_concrete_list(Es)]; -unfold_concrete_list([]) -> - []. - - -%% --------------------------------------------------------------------- - --record(module, {ann = [], name, exports, attrs, defs}). - - -%% @spec c_module(Name::cerl(), Exports, Definitions) -> cerl() -%% -%% Exports = [cerl()] -%% Definitions = [{cerl(), cerl()}] -%% -%% @equiv c_module(Name, Exports, [], Definitions) - -c_module(Name, Exports, Es) -> - #module{name = Name, exports = Exports, attrs = [], defs = Es}. - - -%% @spec c_module(Name::cerl(), Exports, Attributes, Definitions) -> -%% cerl() -%% -%% Exports = [cerl()] -%% Attributes = [{cerl(), cerl()}] -%% Definitions = [{cerl(), cerl()}] -%% -%% @doc Creates an abstract module definition. The result represents -%% <pre> -%% module <em>Name</em> [<em>E1</em>, ..., <em>Ek</em>] -%% attributes [<em>K1</em> = <em>T1</em>, ..., -%% <em>Km</em> = <em>Tm</em>] -%% <em>V1</em> = <em>F1</em> -%% ... -%% <em>Vn</em> = <em>Fn</em> -%% end</pre> -%% -%% if <code>Exports</code> = <code>[E1, ..., Ek]</code>, -%% <code>Attributes</code> = <code>[{K1, T1}, ..., {Km, Tm}]</code>, -%% and <code>Definitions</code> = <code>[{V1, F1}, ..., {Vn, -%% Fn}]</code>. -%% -%% <p><code>Name</code> and all the <code>Ki</code> must be atom -%% literals, and all the <code>Ti</code> must be constant literals. All -%% the <code>Vi</code> and <code>Ei</code> must have type -%% <code>var</code> and represent function names. All the -%% <code>Fi</code> must have type <code>'fun'</code>.</p> -%% -%% @see c_module/3 -%% @see module_name/1 -%% @see module_exports/1 -%% @see module_attrs/1 -%% @see module_defs/1 -%% @see module_vars/1 -%% @see ann_c_module/4 -%% @see ann_c_module/5 -%% @see update_c_module/5 -%% @see c_atom/1 -%% @see c_var/1 -%% @see c_fun/2 -%% @see is_literal/1 - -c_module(Name, Exports, Attrs, Es) -> - #module{name = Name, exports = Exports, attrs = Attrs, defs = Es}. - - -%% @spec ann_c_module(As::[term()], Name::cerl(), Exports, -%% Definitions) -> cerl() -%% -%% Exports = [cerl()] -%% Definitions = [{cerl(), cerl()}] -%% -%% @see c_module/3 -%% @see ann_c_module/5 - -ann_c_module(As, Name, Exports, Es) -> - #module{name = Name, exports = Exports, attrs = [], defs = Es, - ann = As}. - - -%% @spec ann_c_module(As::[term()], Name::cerl(), Exports, -%% Attributes, Definitions) -> cerl() -%% -%% Exports = [cerl()] -%% Attributes = [{cerl(), cerl()}] -%% Definitions = [{cerl(), cerl()}] -%% -%% @see c_module/4 -%% @see ann_c_module/4 - -ann_c_module(As, Name, Exports, Attrs, Es) -> - #module{name = Name, exports = Exports, attrs = Attrs, defs = Es, - ann = As}. - - -%% @spec update_c_module(Old::cerl(), Name::cerl(), Exports, -%% Attributes, Definitions) -> cerl() -%% -%% Exports = [cerl()] -%% Attributes = [{cerl(), cerl()}] -%% Definitions = [{cerl(), cerl()}] -%% -%% @see c_module/4 - -update_c_module(Node, Name, Exports, Attrs, Es) -> - #module{name = Name, exports = Exports, attrs = Attrs, defs = Es, - ann = get_ann(Node)}. - - -%% @spec is_c_module(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% module definition, otherwise <code>false</code>. -%% -%% @see type/1 - -is_c_module(#module{}) -> - true; -is_c_module(_) -> - false. - - -%% @spec module_name(Node::cerl()) -> cerl() -%% -%% @doc Returns the name subtree of an abstract module definition. -%% -%% @see c_module/4 - -module_name(Node) -> - Node#module.name. - - -%% @spec module_exports(Node::cerl()) -> [cerl()] -%% -%% @doc Returns the list of exports subtrees of an abstract module -%% definition. -%% -%% @see c_module/4 - -module_exports(Node) -> - Node#module.exports. - - -%% @spec module_attrs(Node::cerl()) -> [{cerl(), cerl()}] -%% -%% @doc Returns the list of pairs of attribute key/value subtrees of -%% an abstract module definition. -%% -%% @see c_module/4 - -module_attrs(Node) -> - Node#module.attrs. - - -%% @spec module_defs(Node::cerl()) -> [{cerl(), cerl()}] -%% -%% @doc Returns the list of function definitions of an abstract module -%% definition. -%% -%% @see c_module/4 - -module_defs(Node) -> - Node#module.defs. - - -%% @spec module_vars(Node::cerl()) -> [cerl()] -%% -%% @doc Returns the list of left-hand side function variable subtrees -%% of an abstract module definition. -%% -%% @see c_module/4 - -module_vars(Node) -> - [F || {F, _} <- module_defs(Node)]. - - -%% --------------------------------------------------------------------- - -%% @spec c_int(Value::integer()) -> cerl() -%% -%% -%% @doc Creates an abstract integer literal. The lexical -%% representation is the canonical decimal numeral of -%% <code>Value</code>. -%% -%% @see ann_c_int/2 -%% @see is_c_int/1 -%% @see int_val/1 -%% @see int_lit/1 -%% @see c_char/1 - -c_int(Value) -> - #literal{val = Value}. - - -%% @spec ann_c_int(As::[term()], Value::integer()) -> cerl() -%% @see c_int/1 - -ann_c_int(As, Value) -> - #literal{val = Value, ann = As}. - - -%% @spec is_c_int(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> represents an -%% integer literal, otherwise <code>false</code>. -%% @see c_int/1 - -is_c_int(#literal{val = V}) when integer(V) -> - true; -is_c_int(_) -> - false. - - -%% @spec int_val(cerl()) -> integer() -%% -%% @doc Returns the value represented by an integer literal node. -%% @see c_int/1 - -int_val(Node) -> - Node#literal.val. - - -%% @spec int_lit(cerl()) -> string() -%% -%% @doc Returns the numeral string represented by an integer literal -%% node. -%% @see c_int/1 - -int_lit(Node) -> - integer_to_list(int_val(Node)). - - -%% --------------------------------------------------------------------- - -%% @spec c_float(Value::float()) -> cerl() -%% -%% @doc Creates an abstract floating-point literal. The lexical -%% representation is the decimal floating-point numeral of -%% <code>Value</code>. -%% -%% @see ann_c_float/2 -%% @see is_c_float/1 -%% @see float_val/1 -%% @see float_lit/1 - -%% Note that not all floating-point numerals can be represented with -%% full precision. - -c_float(Value) -> - #literal{val = Value}. - - -%% @spec ann_c_float(As::[term()], Value::float()) -> cerl() -%% @see c_float/1 - -ann_c_float(As, Value) -> - #literal{val = Value, ann = As}. - - -%% @spec is_c_float(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> represents a -%% floating-point literal, otherwise <code>false</code>. -%% @see c_float/1 - -is_c_float(#literal{val = V}) when float(V) -> - true; -is_c_float(_) -> - false. - - -%% @spec float_val(cerl()) -> float() -%% -%% @doc Returns the value represented by a floating-point literal -%% node. -%% @see c_float/1 - -float_val(Node) -> - Node#literal.val. - - -%% @spec float_lit(cerl()) -> string() -%% -%% @doc Returns the numeral string represented by a floating-point -%% literal node. -%% @see c_float/1 - -float_lit(Node) -> - float_to_list(float_val(Node)). - - -%% --------------------------------------------------------------------- - -%% @spec c_atom(Name) -> cerl() -%% Name = atom() | string() -%% -%% @doc Creates an abstract atom literal. The print name of the atom -%% is the character sequence represented by <code>Name</code>. -%% -%% <p>Note: passing a string as argument to this function causes a -%% corresponding atom to be created for the internal representation.</p> -%% -%% @see ann_c_atom/2 -%% @see is_c_atom/1 -%% @see atom_val/1 -%% @see atom_name/1 -%% @see atom_lit/1 - -c_atom(Name) when atom(Name) -> - #literal{val = Name}; -c_atom(Name) -> - #literal{val = list_to_atom(Name)}. - - -%% @spec ann_c_atom(As::[term()], Name) -> cerl() -%% Name = atom() | string() -%% @see c_atom/1 - -ann_c_atom(As, Name) when atom(Name) -> - #literal{val = Name, ann = As}; -ann_c_atom(As, Name) -> - #literal{val = list_to_atom(Name), ann = As}. - - -%% @spec is_c_atom(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> represents an -%% atom literal, otherwise <code>false</code>. -%% -%% @see c_atom/1 - -is_c_atom(#literal{val = V}) when atom(V) -> - true; -is_c_atom(_) -> - false. - -%% @spec atom_val(cerl())-> atom() -%% -%% @doc Returns the value represented by an abstract atom. -%% -%% @see c_atom/1 - -atom_val(Node) -> - Node#literal.val. - - -%% @spec atom_name(cerl()) -> string() -%% -%% @doc Returns the printname of an abstract atom. -%% -%% @see c_atom/1 - -atom_name(Node) -> - atom_to_list(atom_val(Node)). - - -%% @spec atom_lit(cerl()) -> string() -%% -%% @doc Returns the literal string represented by an abstract -%% atom. This always includes surrounding single-quote characters. -%% -%% <p>Note that an abstract atom may have several literal -%% representations, and that the representation yielded by this -%% function is not fixed; e.g., -%% <code>atom_lit(c_atom("a\012b"))</code> could yield the string -%% <code>"\'a\\nb\'"</code>.</p> -%% -%% @see c_atom/1 - -%% TODO: replace the use of the unofficial 'write_string/2'. - -atom_lit(Node) -> - io_lib:write_string(atom_name(Node), $'). %' stupid Emacs. - - -%% --------------------------------------------------------------------- - -%% @spec c_char(Value) -> cerl() -%% -%% Value = char() | integer() -%% -%% @doc Creates an abstract character literal. If the local -%% implementation of Erlang defines <code>char()</code> as a subset of -%% <code>integer()</code>, this function is equivalent to -%% <code>c_int/1</code>. Otherwise, if the given value is an integer, -%% it will be converted to the character with the corresponding -%% code. The lexical representation of a character is -%% "<code>$<em>Char</em></code>", where <code>Char</code> is a single -%% printing character or an escape sequence. -%% -%% @see c_int/1 -%% @see c_string/1 -%% @see ann_c_char/2 -%% @see is_c_char/1 -%% @see char_val/1 -%% @see char_lit/1 -%% @see is_print_char/1 - -c_char(Value) when integer(Value), Value >= 0 -> - #literal{val = Value}. - - -%% @spec ann_c_char(As::[term()], Value::char()) -> cerl() -%% @see c_char/1 - -ann_c_char(As, Value) -> - #literal{val = Value, ann = As}. - - -%% @spec is_c_char(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> may represent a -%% character literal, otherwise <code>false</code>. -%% -%% <p>If the local implementation of Erlang defines -%% <code>char()</code> as a subset of <code>integer()</code>, then -%% <code>is_c_int(<em>Node</em>)</code> will also yield -%% <code>true</code>.</p> -%% -%% @see c_char/1 -%% @see is_print_char/1 - -is_c_char(#literal{val = V}) when integer(V), V >= 0 -> - is_char_value(V); -is_c_char(_) -> - false. - - -%% @spec is_print_char(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> may represent a -%% "printing" character, otherwise <code>false</code>. (Cf. -%% <code>is_c_char/1</code>.) A "printing" character has either a -%% given graphical representation, or a "named" escape sequence such -%% as "<code>\n</code>". Currently, only ISO 8859-1 (Latin-1) -%% character values are recognized. -%% -%% @see c_char/1 -%% @see is_c_char/1 - -is_print_char(#literal{val = V}) when integer(V), V >= 0 -> - is_print_char_value(V); -is_print_char(_) -> - false. - - -%% @spec char_val(cerl()) -> char() -%% -%% @doc Returns the value represented by an abstract character literal. -%% -%% @see c_char/1 - -char_val(Node) -> - Node#literal.val. - - -%% @spec char_lit(cerl()) -> string() -%% -%% @doc Returns the literal string represented by an abstract -%% character. This includes a leading <code>$</code> -%% character. Currently, all characters that are not in the set of ISO -%% 8859-1 (Latin-1) "printing" characters will be escaped. -%% -%% @see c_char/1 - -char_lit(Node) -> - io_lib:write_char(char_val(Node)). - - -%% --------------------------------------------------------------------- - -%% @spec c_string(Value::string()) -> cerl() -%% -%% @doc Creates an abstract string literal. Equivalent to creating an -%% abstract list of the corresponding character literals -%% (cf. <code>is_c_string/1</code>), but is typically more -%% efficient. The lexical representation of a string is -%% "<code>"<em>Chars</em>"</code>", where <code>Chars</code> is a -%% sequence of printing characters or spaces. -%% -%% @see c_char/1 -%% @see ann_c_string/2 -%% @see is_c_string/1 -%% @see string_val/1 -%% @see string_lit/1 -%% @see is_print_string/1 - -c_string(Value) -> - #literal{val = Value}. - - -%% @spec ann_c_string(As::[term()], Value::string()) -> cerl() -%% @see c_string/1 - -ann_c_string(As, Value) -> - #literal{val = Value, ann = As}. - - -%% @spec is_c_string(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> may represent a -%% string literal, otherwise <code>false</code>. Strings are defined -%% as lists of characters; see <code>is_c_char/1</code> for details. -%% -%% @see c_string/1 -%% @see is_c_char/1 -%% @see is_print_string/1 - -is_c_string(#literal{val = V}) -> - is_char_list(V); -is_c_string(_) -> - false. - - -%% @spec is_print_string(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> may represent a -%% string literal containing only "printing" characters, otherwise -%% <code>false</code>. See <code>is_c_string/1</code> and -%% <code>is_print_char/1</code> for details. Currently, only ISO -%% 8859-1 (Latin-1) character values are recognized. -%% -%% @see c_string/1 -%% @see is_c_string/1 -%% @see is_print_char/1 - -is_print_string(#literal{val = V}) -> - is_print_char_list(V); -is_print_string(_) -> - false. - - -%% @spec string_val(cerl()) -> string() -%% -%% @doc Returns the value represented by an abstract string literal. -%% -%% @see c_string/1 - -string_val(Node) -> - Node#literal.val. - - -%% @spec string_lit(cerl()) -> string() -%% -%% @doc Returns the literal string represented by an abstract string. -%% This includes surrounding double-quote characters -%% <code>"..."</code>. Currently, characters that are not in the set -%% of ISO 8859-1 (Latin-1) "printing" characters will be escaped, -%% except for spaces. -%% -%% @see c_string/1 - -string_lit(Node) -> - io_lib:write_string(string_val(Node)). - - -%% --------------------------------------------------------------------- - -%% @spec c_nil() -> cerl() -%% -%% @doc Creates an abstract empty list. The result represents -%% "<code>[]</code>". The empty list is traditionally called "nil". -%% -%% @see ann_c_nil/1 -%% @see is_c_list/1 -%% @see c_cons/2 - -c_nil() -> - #literal{val = []}. - - -%% @spec ann_c_nil(As::[term()]) -> cerl() -%% @see c_nil/0 - -ann_c_nil(As) -> - #literal{val = [], ann = As}. - - -%% @spec is_c_nil(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% empty list, otherwise <code>false</code>. - -is_c_nil(#literal{val = []}) -> - true; -is_c_nil(_) -> - false. - - -%% --------------------------------------------------------------------- - -%% @spec c_cons(Head::cerl(), Tail::cerl()) -> cerl() -%% -%% @doc Creates an abstract list constructor. The result represents -%% "<code>[<em>Head</em> | <em>Tail</em>]</code>". Note that if both -%% <code>Head</code> and <code>Tail</code> have type -%% <code>literal</code>, then the result will also have type -%% <code>literal</code>, and annotations on <code>Head</code> and -%% <code>Tail</code> are lost. -%% -%% <p>Recall that in Erlang, the tail element of a list constructor is -%% not necessarily a list.</p> -%% -%% @see ann_c_cons/3 -%% @see update_c_cons/3 -%% @see c_cons_skel/2 -%% @see is_c_cons/1 -%% @see cons_hd/1 -%% @see cons_tl/1 -%% @see is_c_list/1 -%% @see c_nil/0 -%% @see list_elements/1 -%% @see list_length/1 -%% @see make_list/2 - --record(cons, {ann = [], hd, tl}). - -%% *Always* collapse literals. - -c_cons(#literal{val = Head}, #literal{val = Tail}) -> - #literal{val = [Head | Tail]}; -c_cons(Head, Tail) -> - #cons{hd = Head, tl = Tail}. - - -%% @spec ann_c_cons(As::[term()], Head::cerl(), Tail::cerl()) -> cerl() -%% @see c_cons/2 - -ann_c_cons(As, #literal{val = Head}, #literal{val = Tail}) -> - #literal{val = [Head | Tail], ann = As}; -ann_c_cons(As, Head, Tail) -> - #cons{hd = Head, tl = Tail, ann = As}. - - -%% @spec update_c_cons(Old::cerl(), Head::cerl(), Tail::cerl()) -> -%% cerl() -%% @see c_cons/2 - -update_c_cons(Node, #literal{val = Head}, #literal{val = Tail}) -> - #literal{val = [Head | Tail], ann = get_ann(Node)}; -update_c_cons(Node, Head, Tail) -> - #cons{hd = Head, tl = Tail, ann = get_ann(Node)}. - - -%% @spec c_cons_skel(Head::cerl(), Tail::cerl()) -> cerl() -%% -%% @doc Creates an abstract list constructor skeleton. Does not fold -%% constant literals, i.e., the result always has type -%% <code>cons</code>, representing "<code>[<em>Head</em> | -%% <em>Tail</em>]</code>". -%% -%% <p>This function is occasionally useful when it is necessary to have -%% annotations on the subnodes of a list constructor node, even when the -%% subnodes are constant literals. Note however that -%% <code>is_literal/1</code> will yield <code>false</code> and -%% <code>concrete/1</code> will fail if passed the result from this -%% function.</p> -%% -%% <p><code>fold_literal/1</code> can be used to revert a node to the -%% normal-form representation.</p> -%% -%% @see ann_c_cons_skel/3 -%% @see update_c_cons_skel/3 -%% @see c_cons/2 -%% @see is_c_cons/1 -%% @see is_c_list/1 -%% @see c_nil/0 -%% @see is_literal/1 -%% @see fold_literal/1 -%% @see concrete/1 - -%% *Never* collapse literals. - -c_cons_skel(Head, Tail) -> - #cons{hd = Head, tl = Tail}. - - -%% @spec ann_c_cons_skel(As::[term()], Head::cerl(), Tail::cerl()) -> -%% cerl() -%% @see c_cons_skel/2 - -ann_c_cons_skel(As, Head, Tail) -> - #cons{hd = Head, tl = Tail, ann = As}. - - -%% @spec update_c_cons_skel(Old::cerl(), Head::cerl(), Tail::cerl()) -> -%% cerl() -%% @see c_cons_skel/2 - -update_c_cons_skel(Node, Head, Tail) -> - #cons{hd = Head, tl = Tail, ann = get_ann(Node)}. - - -%% @spec is_c_cons(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% list constructor, otherwise <code>false</code>. - -is_c_cons(#cons{}) -> - true; -is_c_cons(#literal{val = [_ | _]}) -> - true; -is_c_cons(_) -> - false. - - -%% @spec cons_hd(cerl()) -> cerl() -%% -%% @doc Returns the head subtree of an abstract list constructor. -%% -%% @see c_cons/2 - -cons_hd(#cons{hd = Head}) -> - Head; -cons_hd(#literal{val = [Head | _]}) -> - #literal{val = Head}. - - -%% @spec cons_tl(cerl()) -> cerl() -%% -%% @doc Returns the tail subtree of an abstract list constructor. -%% -%% <p>Recall that the tail does not necessarily represent a proper -%% list.</p> -%% -%% @see c_cons/2 - -cons_tl(#cons{tl = Tail}) -> - Tail; -cons_tl(#literal{val = [_ | Tail]}) -> - #literal{val = Tail}. - - -%% @spec is_c_list(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> represents a -%% proper list, otherwise <code>false</code>. A proper list is either -%% the empty list <code>[]</code>, or a cons cell <code>[<em>Head</em> | -%% <em>Tail</em>]</code>, where recursively <code>Tail</code> is a -%% proper list. -%% -%% <p>Note: Because <code>Node</code> is a syntax tree, the actual -%% run-time values corresponding to its subtrees may often be partially -%% or completely unknown. Thus, if <code>Node</code> represents e.g. -%% "<code>[... | Ns]</code>" (where <code>Ns</code> is a variable), then -%% the function will return <code>false</code>, because it is not known -%% whether <code>Ns</code> will be bound to a list at run-time. If -%% <code>Node</code> instead represents e.g. "<code>[1, 2, 3]</code>" or -%% "<code>[A | []]</code>", then the function will return -%% <code>true</code>.</p> -%% -%% @see c_cons/2 -%% @see c_nil/0 -%% @see list_elements/1 -%% @see list_length/1 - -is_c_list(#cons{tl = Tail}) -> - is_c_list(Tail); -is_c_list(#literal{val = V}) -> - is_proper_list(V); -is_c_list(_) -> - false. - -is_proper_list([_ | Tail]) -> - is_proper_list(Tail); -is_proper_list([]) -> - true; -is_proper_list(_) -> - false. - -%% @spec list_elements(cerl()) -> [cerl()] -%% -%% @doc Returns the list of element subtrees of an abstract list. -%% <code>Node</code> must represent a proper list. E.g., if -%% <code>Node</code> represents "<code>[<em>X1</em>, <em>X2</em> | -%% [<em>X3</em>, <em>X4</em> | []]</code>", then -%% <code>list_elements(Node)</code> yields the list <code>[X1, X2, X3, -%% X4]</code>. -%% -%% @see c_cons/2 -%% @see c_nil/1 -%% @see is_c_list/1 -%% @see list_length/1 -%% @see make_list/2 - -list_elements(#cons{hd = Head, tl = Tail}) -> - [Head | list_elements(Tail)]; -list_elements(#literal{val = V}) -> - abstract_list(V). - -abstract_list([X | Xs]) -> - [abstract(X) | abstract_list(Xs)]; -abstract_list([]) -> - []. - - -%% @spec list_length(Node::cerl()) -> integer() -%% -%% @doc Returns the number of element subtrees of an abstract list. -%% <code>Node</code> must represent a proper list. E.g., if -%% <code>Node</code> represents "<code>[X1 | [X2, X3 | [X4, X5, -%% X6]]]</code>", then <code>list_length(Node)</code> returns the -%% integer 6. -%% -%% <p>Note: this is equivalent to -%% <code>length(list_elements(Node))</code>, but potentially more -%% efficient.</p> -%% -%% @see c_cons/2 -%% @see c_nil/1 -%% @see is_c_list/1 -%% @see list_elements/1 - -list_length(L) -> - list_length(L, 0). - -list_length(#cons{tl = Tail}, A) -> - list_length(Tail, A + 1); -list_length(#literal{val = V}, A) -> - A + length(V). - - -%% @spec make_list(List) -> Node -%% @equiv make_list(List, none) - -make_list(List) -> - ann_make_list([], List). - - -%% @spec make_list(List::[cerl()], Tail) -> cerl() -%% -%% Tail = cerl() | none -%% -%% @doc Creates an abstract list from the elements in <code>List</code> -%% and the optional <code>Tail</code>. If <code>Tail</code> is -%% <code>none</code>, the result will represent a nil-terminated list, -%% otherwise it represents "<code>[... | <em>Tail</em>]</code>". -%% -%% @see c_cons/2 -%% @see c_nil/0 -%% @see ann_make_list/3 -%% @see update_list/3 -%% @see list_elements/1 - -make_list(List, Tail) -> - ann_make_list([], List, Tail). - - -%% @spec update_list(Old::cerl(), List::[cerl()]) -> cerl() -%% @equiv update_list(Old, List, none) - -update_list(Node, List) -> - ann_make_list(get_ann(Node), List). - - -%% @spec update_list(Old::cerl(), List::[cerl()], Tail) -> cerl() -%% -%% Tail = cerl() | none -%% -%% @see make_list/2 -%% @see update_list/2 - -update_list(Node, List, Tail) -> - ann_make_list(get_ann(Node), List, Tail). - - -%% @spec ann_make_list(As::[term()], List::[cerl()]) -> cerl() -%% @equiv ann_make_list(As, List, none) - -ann_make_list(As, List) -> - ann_make_list(As, List, none). - - -%% @spec ann_make_list(As::[term()], List::[cerl()], Tail) -> cerl() -%% -%% Tail = cerl() | none -%% -%% @see make_list/2 -%% @see ann_make_list/2 - -ann_make_list(As, [H | T], Tail) -> - ann_c_cons(As, H, make_list(T, Tail)); % `c_cons' folds literals -ann_make_list(As, [], none) -> - ann_c_nil(As); -ann_make_list(_, [], Node) -> - Node. - - -%% --------------------------------------------------------------------- - -%% @spec c_tuple(Elements::[cerl()]) -> cerl() -%% -%% @doc Creates an abstract tuple. If <code>Elements</code> is -%% <code>[E1, ..., En]</code>, the result represents -%% "<code>{<em>E1</em>, ..., <em>En</em>}</code>". Note that if all -%% nodes in <code>Elements</code> have type <code>literal</code>, or if -%% <code>Elements</code> is empty, then the result will also have type -%% <code>literal</code> and annotations on nodes in -%% <code>Elements</code> are lost. -%% -%% <p>Recall that Erlang has distinct 1-tuples, i.e., <code>{X}</code> -%% is always distinct from <code>X</code> itself.</p> -%% -%% @see ann_c_tuple/2 -%% @see update_c_tuple/2 -%% @see is_c_tuple/1 -%% @see tuple_es/1 -%% @see tuple_arity/1 -%% @see c_tuple_skel/1 - --record(tuple, {ann = [], es}). - -%% *Always* collapse literals. - -c_tuple(Es) -> - case is_lit_list(Es) of - false -> - #tuple{es = Es}; - true -> - #literal{val = list_to_tuple(lit_list_vals(Es))} - end. - - -%% @spec ann_c_tuple(As::[term()], Elements::[cerl()]) -> cerl() -%% @see c_tuple/1 - -ann_c_tuple(As, Es) -> - case is_lit_list(Es) of - false -> - #tuple{es = Es, ann = As}; - true -> - #literal{val = list_to_tuple(lit_list_vals(Es)), ann = As} - end. - - -%% @spec update_c_tuple(Old::cerl(), Elements::[cerl()]) -> cerl() -%% @see c_tuple/1 - -update_c_tuple(Node, Es) -> - case is_lit_list(Es) of - false -> - #tuple{es = Es, ann = get_ann(Node)}; - true -> - #literal{val = list_to_tuple(lit_list_vals(Es)), - ann = get_ann(Node)} - end. - - -%% @spec c_tuple_skel(Elements::[cerl()]) -> cerl() -%% -%% @doc Creates an abstract tuple skeleton. Does not fold constant -%% literals, i.e., the result always has type <code>tuple</code>, -%% representing "<code>{<em>E1</em>, ..., <em>En</em>}</code>", if -%% <code>Elements</code> is <code>[E1, ..., En]</code>. -%% -%% <p>This function is occasionally useful when it is necessary to have -%% annotations on the subnodes of a tuple node, even when all the -%% subnodes are constant literals. Note however that -%% <code>is_literal/1</code> will yield <code>false</code> and -%% <code>concrete/1</code> will fail if passed the result from this -%% function.</p> -%% -%% <p><code>fold_literal/1</code> can be used to revert a node to the -%% normal-form representation.</p> -%% -%% @see ann_c_tuple_skel/2 -%% @see update_c_tuple_skel/2 -%% @see c_tuple/1 -%% @see tuple_es/1 -%% @see is_c_tuple/1 -%% @see is_literal/1 -%% @see fold_literal/1 -%% @see concrete/1 - -%% *Never* collapse literals. - -c_tuple_skel(Es) -> - #tuple{es = Es}. - - -%% @spec ann_c_tuple_skel(As::[term()], Elements::[cerl()]) -> cerl() -%% @see c_tuple_skel/1 - -ann_c_tuple_skel(As, Es) -> - #tuple{es = Es, ann = As}. - - -%% @spec update_c_tuple_skel(Old::cerl(), Elements::[cerl()]) -> cerl() -%% @see c_tuple_skel/1 - -update_c_tuple_skel(Old, Es) -> - #tuple{es = Es, ann = get_ann(Old)}. - - -%% @spec is_c_tuple(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% tuple, otherwise <code>false</code>. -%% -%% @see c_tuple/1 - -is_c_tuple(#tuple{}) -> - true; -is_c_tuple(#literal{val = V}) when tuple(V) -> - true; -is_c_tuple(_) -> - false. - - -%% @spec tuple_es(cerl()) -> [cerl()] -%% -%% @doc Returns the list of element subtrees of an abstract tuple. -%% -%% @see c_tuple/1 - -tuple_es(#tuple{es = Es}) -> - Es; -tuple_es(#literal{val = V}) -> - make_lit_list(tuple_to_list(V)). - - -%% @spec tuple_arity(Node::cerl()) -> integer() -%% -%% @doc Returns the number of element subtrees of an abstract tuple. -%% -%% <p>Note: this is equivalent to <code>length(tuple_es(Node))</code>, -%% but potentially more efficient.</p> -%% -%% @see tuple_es/1 -%% @see c_tuple/1 - -tuple_arity(#tuple{es = Es}) -> - length(Es); -tuple_arity(#literal{val = V}) when tuple(V) -> - size(V). - - -%% --------------------------------------------------------------------- - -%% @spec c_var(Name::var_name()) -> cerl() -%% -%% var_name() = integer() | atom() | {atom(), integer()} -%% -%% @doc Creates an abstract variable. A variable is identified by its -%% name, given by the <code>Name</code> parameter. -%% -%% <p>If a name is given by a single atom, it should either be a -%% "simple" atom which does not need to be single-quoted in Erlang, or -%% otherwise its print name should correspond to a proper Erlang -%% variable, i.e., begin with an uppercase character or an -%% underscore. Names on the form <code>{A, N}</code> represent -%% function name variables "<code><em>A</em>/<em>N</em></code>"; these -%% are special variables which may be bound only in the function -%% definitions of a module or a <code>letrec</code>. They may not be -%% bound in <code>let</code> expressions and cannot occur in clause -%% patterns. The atom <code>A</code> in a function name may be any -%% atom; the integer <code>N</code> must be nonnegative. The functions -%% <code>c_fname/2</code> etc. are utilities for handling function -%% name variables.</p> -%% -%% <p>When printing variable names, they must have the form of proper -%% Core Erlang variables and function names. E.g., a name represented -%% by an integer such as <code>42</code> could be formatted as -%% "<code>_42</code>", an atom <code>'Xxx'</code> simply as -%% "<code>Xxx</code>", and an atom <code>foo</code> as -%% "<code>_foo</code>". However, one must assure that any two valid -%% distinct names are never mapped to the same strings. Tuples such -%% as <code>{foo, 2}</code> representing function names can simply by -%% formatted as "<code>'foo'/2</code>", with no risk of conflicts.</p> -%% -%% @see ann_c_var/2 -%% @see update_c_var/2 -%% @see is_c_var/1 -%% @see var_name/1 -%% @see c_fname/2 -%% @see c_module/4 -%% @see c_letrec/2 - --record(var, {ann = [], name}). - -c_var(Name) -> - #var{name = Name}. - - -%% @spec ann_c_var(As::[term()], Name::var_name()) -> cerl() -%% -%% @see c_var/1 - -ann_c_var(As, Name) -> - #var{name = Name, ann = As}. - -%% @spec update_c_var(Old::cerl(), Name::var_name()) -> cerl() -%% -%% @see c_var/1 - -update_c_var(Node, Name) -> - #var{name = Name, ann = get_ann(Node)}. - - -%% @spec is_c_var(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% variable, otherwise <code>false</code>. -%% -%% @see c_var/1 - -is_c_var(#var{}) -> - true; -is_c_var(_) -> - false. - - -%% @spec c_fname(Name::atom(), Arity::integer()) -> cerl() -%% @equiv c_var({Name, Arity}) -%% @see fname_id/1 -%% @see fname_arity/1 -%% @see is_c_fname/1 -%% @see ann_c_fname/3 -%% @see update_c_fname/3 - -c_fname(Atom, Arity) -> - c_var({Atom, Arity}). - - -%% @spec ann_c_fname(As::[term()], Name::atom(), Arity::integer()) -> -%% cerl() -%% @equiv ann_c_var(As, {Atom, Arity}) -%% @see c_fname/2 - -ann_c_fname(As, Atom, Arity) -> - ann_c_var(As, {Atom, Arity}). - - -%% @spec update_c_fname(Old::cerl(), Name::atom()) -> cerl() -%% @doc Like <code>update_c_fname/3</code>, but takes the arity from -%% <code>Node</code>. -%% @see update_c_fname/3 -%% @see c_fname/2 - -update_c_fname(#var{name = {_, Arity}, ann = As}, Atom) -> - #var{name = {Atom, Arity}, ann = As}. - - -%% @spec update_c_fname(Old::cerl(), Name::atom(), Arity::integer()) -> -%% cerl() -%% @equiv update_c_var(Old, {Atom, Arity}) -%% @see update_c_fname/2 -%% @see c_fname/2 - -update_c_fname(Node, Atom, Arity) -> - update_c_var(Node, {Atom, Arity}). - - -%% @spec is_c_fname(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% function name variable, otherwise <code>false</code>. -%% -%% @see c_fname/2 -%% @see c_var/1 -%% @see c_var_name/1 - -is_c_fname(#var{name = {A, N}}) when atom(A), integer(N), N >= 0 -> - true; -is_c_fname(_) -> - false. - - -%% @spec var_name(cerl()) -> var_name() -%% -%% @doc Returns the name of an abstract variable. -%% -%% @see c_var/1 - -var_name(Node) -> - Node#var.name. - - -%% @spec fname_id(cerl()) -> atom() -%% -%% @doc Returns the identifier part of an abstract function name -%% variable. -%% -%% @see fname_arity/1 -%% @see c_fname/2 - -fname_id(#var{name={A,_}}) -> - A. - - -%% @spec fname_arity(cerl()) -> integer() -%% -%% @doc Returns the arity part of an abstract function name variable. -%% -%% @see fname_id/1 -%% @see c_fname/2 - -fname_arity(#var{name={_,N}}) -> - N. - - -%% --------------------------------------------------------------------- - -%% @spec c_values(Elements::[cerl()]) -> cerl() -%% -%% @doc Creates an abstract value list. If <code>Elements</code> is -%% <code>[E1, ..., En]</code>, the result represents -%% "<code><<em>E1</em>, ..., <em>En</em>></code>". -%% -%% @see ann_c_values/2 -%% @see update_c_values/2 -%% @see is_c_values/1 -%% @see values_es/1 -%% @see values_arity/1 - --record(values, {ann = [], es}). - -c_values(Es) -> - #values{es = Es}. - - -%% @spec ann_c_values(As::[term()], Elements::[cerl()]) -> cerl() -%% @see c_values/1 - -ann_c_values(As, Es) -> - #values{es = Es, ann = As}. - - -%% @spec update_c_values(Old::cerl(), Elements::[cerl()]) -> cerl() -%% @see c_values/1 - -update_c_values(Node, Es) -> - #values{es = Es, ann = get_ann(Node)}. - - -%% @spec is_c_values(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% value list; otherwise <code>false</code>. -%% -%% @see c_values/1 - -is_c_values(#values{}) -> - true; -is_c_values(_) -> - false. - - -%% @spec values_es(cerl()) -> [cerl()] -%% -%% @doc Returns the list of element subtrees of an abstract value -%% list. -%% -%% @see c_values/1 -%% @see values_arity/1 - -values_es(Node) -> - Node#values.es. - - -%% @spec values_arity(Node::cerl()) -> integer() -%% -%% @doc Returns the number of element subtrees of an abstract value -%% list. -%% -%% <p>Note: This is equivalent to -%% <code>length(values_es(Node))</code>, but potentially more -%% efficient.</p> -%% -%% @see c_values/1 -%% @see values_es/1 - -values_arity(Node) -> - length(values_es(Node)). - - -%% --------------------------------------------------------------------- - -%% @spec c_binary(Segments::[cerl()]) -> cerl() -%% -%% @doc Creates an abstract binary-template. A binary object is a -%% sequence of 8-bit bytes. It is specified by zero or more bit-string -%% template <em>segments</em> of arbitrary lengths (in number of bits), -%% such that the sum of the lengths is evenly divisible by 8. If -%% <code>Segments</code> is <code>[S1, ..., Sn]</code>, the result -%% represents "<code>#{<em>S1</em>, ..., <em>Sn</em>}#</code>". All the -%% <code>Si</code> must have type <code>bitstr</code>. -%% -%% @see ann_c_binary/2 -%% @see update_c_binary/2 -%% @see is_c_binary/1 -%% @see binary_segments/1 -%% @see c_bitstr/5 - --record(binary, {ann = [], segments}). - -c_binary(Segments) -> - #binary{segments = Segments}. - - -%% @spec ann_c_binary(As::[term()], Segments::[cerl()]) -> cerl() -%% @see c_binary/1 - -ann_c_binary(As, Segments) -> - #binary{segments = Segments, ann = As}. - - -%% @spec update_c_binary(Old::cerl(), Segments::[cerl()]) -> cerl() -%% @see c_binary/1 - -update_c_binary(Node, Segments) -> - #binary{segments = Segments, ann = get_ann(Node)}. - - -%% @spec is_c_binary(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% binary-template; otherwise <code>false</code>. -%% -%% @see c_binary/1 - -is_c_binary(#binary{}) -> - true; -is_c_binary(_) -> - false. - - -%% @spec binary_segments(cerl()) -> [cerl()] -%% -%% @doc Returns the list of segment subtrees of an abstract -%% binary-template. -%% -%% @see c_binary/1 -%% @see c_bitstr/5 - -binary_segments(Node) -> - Node#binary.segments. - - -%% @spec c_bitstr(Value::cerl(), Size::cerl(), Unit::cerl(), -%% Type::cerl(), Flags::cerl()) -> cerl() -%% -%% @doc Creates an abstract bit-string template. These can only occur as -%% components of an abstract binary-template (see {@link c_binary/1}). -%% The result represents "<code>#<<em>Value</em>>(<em>Size</em>, -%% <em>Unit</em>, <em>Type</em>, <em>Flags</em>)</code>", where -%% <code>Unit</code> must represent a positive integer constant, -%% <code>Type</code> must represent a constant atom (one of -%% <code>'integer'</code>, <code>'float'</code>, or -%% <code>'binary'</code>), and <code>Flags</code> must represent a -%% constant list <code>"[<em>F1</em>, ..., <em>Fn</em>]"</code> where -%% all the <code>Fi</code> are atoms. -%% -%% @see c_binary/1 -%% @see ann_c_bitstr/6 -%% @see update_c_bitstr/6 -%% @see is_c_bitstr/1 -%% @see bitstr_val/1 -%% @see bitstr_size/1 -%% @see bitstr_unit/1 -%% @see bitstr_type/1 -%% @see bitstr_flags/1 - --record(bitstr, {ann = [], val, size, unit, type, flags}). - -c_bitstr(Val, Size, Unit, Type, Flags) -> - #bitstr{val = Val, size = Size, unit = Unit, type = Type, - flags = Flags}. - - -%% @spec c_bitstr(Value::cerl(), Size::cerl(), Type::cerl(), -%% Flags::cerl()) -> cerl() -%% @equiv c_bitstr(Value, Size, abstract(1), Type, Flags) - -c_bitstr(Val, Size, Type, Flags) -> - c_bitstr(Val, Size, abstract(1), Type, Flags). - - -%% @spec c_bitstr(Value::cerl(), Type::cerl(), -%% Flags::cerl()) -> cerl() -%% @equiv c_bitstr(Value, abstract(all), abstract(1), Type, Flags) - -c_bitstr(Val, Type, Flags) -> - c_bitstr(Val, abstract(all), abstract(1), Type, Flags). - - -%% @spec ann_c_bitstr(As::[term()], Value::cerl(), Size::cerl(), -%% Unit::cerl(), Type::cerl(), Flags::cerl()) -> cerl() -%% @see c_bitstr/5 -%% @see ann_c_bitstr/5 - -ann_c_bitstr(As, Val, Size, Unit, Type, Flags) -> - #bitstr{val = Val, size = Size, unit = Unit, type = Type, - flags = Flags, ann = As}. - -%% @spec ann_c_bitstr(As::[term()], Value::cerl(), Size::cerl(), -%% Type::cerl(), Flags::cerl()) -> cerl() -%% @equiv ann_c_bitstr(As, Value, Size, abstract(1), Type, Flags) - -ann_c_bitstr(As, Value, Size, Type, Flags) -> - ann_c_bitstr(As, Value, Size, abstract(1), Type, Flags). - - -%% @spec update_c_bitstr(Old::cerl(), Value::cerl(), Size::cerl(), -%% Unit::cerl(), Type::cerl(), Flags::cerl()) -> cerl() -%% @see c_bitstr/5 -%% @see update_c_bitstr/5 - -update_c_bitstr(Node, Val, Size, Unit, Type, Flags) -> - #bitstr{val = Val, size = Size, unit = Unit, type = Type, - flags = Flags, ann = get_ann(Node)}. - - -%% @spec update_c_bitstr(Old::cerl(), Value::cerl(), Size::cerl(), -%% Type::cerl(), Flags::cerl()) -> cerl() -%% @equiv update_c_bitstr(Node, Value, Size, abstract(1), Type, Flags) - -update_c_bitstr(Node, Value, Size, Type, Flags) -> - update_c_bitstr(Node, Value, Size, abstract(1), Type, Flags). - -%% @spec is_c_bitstr(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% bit-string template; otherwise <code>false</code>. -%% -%% @see c_bitstr/5 - -is_c_bitstr(#bitstr{}) -> - true; -is_c_bitstr(_) -> - false. - - -%% @spec bitstr_val(cerl()) -> cerl() -%% -%% @doc Returns the value subtree of an abstract bit-string template. -%% -%% @see c_bitstr/5 - -bitstr_val(Node) -> - Node#bitstr.val. - - -%% @spec bitstr_size(cerl()) -> cerl() -%% -%% @doc Returns the size subtree of an abstract bit-string template. -%% -%% @see c_bitstr/5 - -bitstr_size(Node) -> - Node#bitstr.size. - - -%% @spec bitstr_bitsize(cerl()) -> integer() | any | all -%% -%% @doc Returns the total size in bits of an abstract bit-string -%% template. If the size field is an integer literal, the result is the -%% product of the size and unit values; if the size field is the atom -%% literal <code>all</code>, the atom <code>all</code> is returned; in -%% all other cases, the atom <code>any</code> is returned. -%% -%% @see c_bitstr/5 - -bitstr_bitsize(Node) -> - Size = Node#bitstr.size, - case is_literal(Size) of - true -> - case concrete(Size) of - all -> - all; - S when integer(S) -> - S*concrete(Node#bitstr.unit); - true -> - any - end; - false -> - any - end. - - -%% @spec bitstr_unit(cerl()) -> cerl() -%% -%% @doc Returns the unit subtree of an abstract bit-string template. -%% -%% @see c_bitstr/5 - -bitstr_unit(Node) -> - Node#bitstr.unit. - - -%% @spec bitstr_type(cerl()) -> cerl() -%% -%% @doc Returns the type subtree of an abstract bit-string template. -%% -%% @see c_bitstr/5 - -bitstr_type(Node) -> - Node#bitstr.type. - - -%% @spec bitstr_flags(cerl()) -> cerl() -%% -%% @doc Returns the flags subtree of an abstract bit-string template. -%% -%% @see c_bitstr/5 - -bitstr_flags(Node) -> - Node#bitstr.flags. - - -%% --------------------------------------------------------------------- - -%% @spec c_fun(Variables::[cerl()], Body::cerl()) -> cerl() -%% -%% @doc Creates an abstract fun-expression. If <code>Variables</code> -%% is <code>[V1, ..., Vn]</code>, the result represents "<code>fun -%% (<em>V1</em>, ..., <em>Vn</em>) -> <em>Body</em></code>". All the -%% <code>Vi</code> must have type <code>var</code>. -%% -%% @see ann_c_fun/3 -%% @see update_c_fun/3 -%% @see is_c_fun/1 -%% @see fun_vars/1 -%% @see fun_body/1 -%% @see fun_arity/1 - --record('fun', {ann = [], vars, body}). - -c_fun(Variables, Body) -> - #'fun'{vars = Variables, body = Body}. - - -%% @spec ann_c_fun(As::[term()], Variables::[cerl()], Body::cerl()) -> -%% cerl() -%% @see c_fun/2 - -ann_c_fun(As, Variables, Body) -> - #'fun'{vars = Variables, body = Body, ann = As}. - - -%% @spec update_c_fun(Old::cerl(), Variables::[cerl()], -%% Body::cerl()) -> cerl() -%% @see c_fun/2 - -update_c_fun(Node, Variables, Body) -> - #'fun'{vars = Variables, body = Body, ann = get_ann(Node)}. - - -%% @spec is_c_fun(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% fun-expression, otherwise <code>false</code>. -%% -%% @see c_fun/2 - -is_c_fun(#'fun'{}) -> - true; % Now this is fun! -is_c_fun(_) -> - false. - - -%% @spec fun_vars(cerl()) -> [cerl()] -%% -%% @doc Returns the list of parameter subtrees of an abstract -%% fun-expression. -%% -%% @see c_fun/2 -%% @see fun_arity/1 - -fun_vars(Node) -> - Node#'fun'.vars. - - -%% @spec fun_body(cerl()) -> cerl() -%% -%% @doc Returns the body subtree of an abstract fun-expression. -%% -%% @see c_fun/2 - -fun_body(Node) -> - Node#'fun'.body. - - -%% @spec fun_arity(Node::cerl()) -> integer() -%% -%% @doc Returns the number of parameter subtrees of an abstract -%% fun-expression. -%% -%% <p>Note: this is equivalent to <code>length(fun_vars(Node))</code>, -%% but potentially more efficient.</p> -%% -%% @see c_fun/2 -%% @see fun_vars/1 - -fun_arity(Node) -> - length(fun_vars(Node)). - - -%% --------------------------------------------------------------------- - -%% @spec c_seq(Argument::cerl(), Body::cerl()) -> cerl() -%% -%% @doc Creates an abstract sequencing expression. The result -%% represents "<code>do <em>Argument</em> <em>Body</em></code>". -%% -%% @see ann_c_seq/3 -%% @see update_c_seq/3 -%% @see is_c_seq/1 -%% @see seq_arg/1 -%% @see seq_body/1 - --record(seq, {ann = [], arg, body}). - -c_seq(Argument, Body) -> - #seq{arg = Argument, body = Body}. - - -%% @spec ann_c_seq(As::[term()], Argument::cerl(), Body::cerl()) -> -%% cerl() -%% @see c_seq/2 - -ann_c_seq(As, Argument, Body) -> - #seq{arg = Argument, body = Body, ann = As}. - - -%% @spec update_c_seq(Old::cerl(), Argument::cerl(), Body::cerl()) -> -%% cerl() -%% @see c_seq/2 - -update_c_seq(Node, Argument, Body) -> - #seq{arg = Argument, body = Body, ann = get_ann(Node)}. - - -%% @spec is_c_seq(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% sequencing expression, otherwise <code>false</code>. -%% -%% @see c_seq/2 - -is_c_seq(#seq{}) -> - true; -is_c_seq(_) -> - false. - - -%% @spec seq_arg(cerl()) -> cerl() -%% -%% @doc Returns the argument subtree of an abstract sequencing -%% expression. -%% -%% @see c_seq/2 - -seq_arg(Node) -> - Node#seq.arg. - - -%% @spec seq_body(cerl()) -> cerl() -%% -%% @doc Returns the body subtree of an abstract sequencing expression. -%% -%% @see c_seq/2 - -seq_body(Node) -> - Node#seq.body. - - -%% --------------------------------------------------------------------- - -%% @spec c_let(Variables::[cerl()], Argument::cerl(), Body::cerl()) -> -%% cerl() -%% -%% @doc Creates an abstract let-expression. If <code>Variables</code> -%% is <code>[V1, ..., Vn]</code>, the result represents "<code>let -%% <<em>V1</em>, ..., <em>Vn</em>> = <em>Argument</em> in -%% <em>Body</em></code>". All the <code>Vi</code> must have type -%% <code>var</code>. -%% -%% @see ann_c_let/4 -%% @see update_c_let/4 -%% @see is_c_let/1 -%% @see let_vars/1 -%% @see let_arg/1 -%% @see let_body/1 -%% @see let_arity/1 - --record('let', {ann = [], vars, arg, body}). - -c_let(Variables, Argument, Body) -> - #'let'{vars = Variables, arg = Argument, body = Body}. - - -%% ann_c_let(As, Variables, Argument, Body) -> Node -%% @see c_let/3 - -ann_c_let(As, Variables, Argument, Body) -> - #'let'{vars = Variables, arg = Argument, body = Body, ann = As}. - - -%% update_c_let(Old, Variables, Argument, Body) -> Node -%% @see c_let/3 - -update_c_let(Node, Variables, Argument, Body) -> - #'let'{vars = Variables, arg = Argument, body = Body, - ann = get_ann(Node)}. - - -%% @spec is_c_let(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% let-expression, otherwise <code>false</code>. -%% -%% @see c_let/3 - -is_c_let(#'let'{}) -> - true; -is_c_let(_) -> - false. - - -%% @spec let_vars(cerl()) -> [cerl()] -%% -%% @doc Returns the list of left-hand side variables of an abstract -%% let-expression. -%% -%% @see c_let/3 -%% @see let_arity/1 - -let_vars(Node) -> - Node#'let'.vars. - - -%% @spec let_arg(cerl()) -> cerl() -%% -%% @doc Returns the argument subtree of an abstract let-expression. -%% -%% @see c_let/3 - -let_arg(Node) -> - Node#'let'.arg. - - -%% @spec let_body(cerl()) -> cerl() -%% -%% @doc Returns the body subtree of an abstract let-expression. -%% -%% @see c_let/3 - -let_body(Node) -> - Node#'let'.body. - - -%% @spec let_arity(Node::cerl()) -> integer() -%% -%% @doc Returns the number of left-hand side variables of an abstract -%% let-expression. -%% -%% <p>Note: this is equivalent to <code>length(let_vars(Node))</code>, -%% but potentially more efficient.</p> -%% -%% @see c_let/3 -%% @see let_vars/1 - -let_arity(Node) -> - length(let_vars(Node)). - - -%% --------------------------------------------------------------------- - -%% @spec c_letrec(Definitions::[{cerl(), cerl()}], Body::cerl()) -> -%% cerl() -%% -%% @doc Creates an abstract letrec-expression. If -%% <code>Definitions</code> is <code>[{V1, F1}, ..., {Vn, Fn}]</code>, -%% the result represents "<code>letrec <em>V1</em> = <em>F1</em> -%% ... <em>Vn</em> = <em>Fn</em> in <em>Body</em></code>. All the -%% <code>Vi</code> must have type <code>var</code> and represent -%% function names. All the <code>Fi</code> must have type -%% <code>'fun'</code>. -%% -%% @see ann_c_letrec/3 -%% @see update_c_letrec/3 -%% @see is_c_letrec/1 -%% @see letrec_defs/1 -%% @see letrec_body/1 -%% @see letrec_vars/1 - --record(letrec, {ann = [], defs, body}). - -c_letrec(Defs, Body) -> - #letrec{defs = Defs, body = Body}. - - -%% @spec ann_c_letrec(As::[term()], Definitions::[{cerl(), cerl()}], -%% Body::cerl()) -> cerl() -%% @see c_letrec/2 - -ann_c_letrec(As, Defs, Body) -> - #letrec{defs = Defs, body = Body, ann = As}. - - -%% @spec update_c_letrec(Old::cerl(), -%% Definitions::[{cerl(), cerl()}], -%% Body::cerl()) -> cerl() -%% @see c_letrec/2 - -update_c_letrec(Node, Defs, Body) -> - #letrec{defs = Defs, body = Body, ann = get_ann(Node)}. - - -%% @spec is_c_letrec(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% letrec-expression, otherwise <code>false</code>. -%% -%% @see c_letrec/2 - -is_c_letrec(#letrec{}) -> - true; -is_c_letrec(_) -> - false. - - -%% @spec letrec_defs(Node::cerl()) -> [{cerl(), cerl()}] -%% -%% @doc Returns the list of definitions of an abstract -%% letrec-expression. If <code>Node</code> represents "<code>letrec -%% <em>V1</em> = <em>F1</em> ... <em>Vn</em> = <em>Fn</em> in -%% <em>Body</em></code>", the returned value is <code>[{V1, F1}, ..., -%% {Vn, Fn}]</code>. -%% -%% @see c_letrec/2 - -letrec_defs(Node) -> - Node#letrec.defs. - - -%% @spec letrec_body(cerl()) -> cerl() -%% -%% @doc Returns the body subtree of an abstract letrec-expression. -%% -%% @see c_letrec/2 - -letrec_body(Node) -> - Node#letrec.body. - - -%% @spec letrec_vars(cerl()) -> [cerl()] -%% -%% @doc Returns the list of left-hand side function variable subtrees -%% of a letrec-expression. If <code>Node</code> represents -%% "<code>letrec <em>V1</em> = <em>F1</em> ... <em>Vn</em> = -%% <em>Fn</em> in <em>Body</em></code>", the returned value is -%% <code>[V1, ..., Vn]</code>. -%% -%% @see c_letrec/2 - -letrec_vars(Node) -> - [F || {F, _} <- letrec_defs(Node)]. - - -%% --------------------------------------------------------------------- - -%% @spec c_case(Argument::cerl(), Clauses::[cerl()]) -> cerl() -%% -%% @doc Creates an abstract case-expression. If <code>Clauses</code> -%% is <code>[C1, ..., Cn]</code>, the result represents "<code>case -%% <em>Argument</em> of <em>C1</em> ... <em>Cn</em> -%% end</code>". <code>Clauses</code> must not be empty. -%% -%% @see ann_c_case/3 -%% @see update_c_case/3 -%% @see is_c_case/1 -%% @see c_clause/3 -%% @see case_arg/1 -%% @see case_clauses/1 -%% @see case_arity/1 - --record('case', {ann = [], arg, clauses}). - -c_case(Expr, Clauses) -> - #'case'{arg = Expr, clauses = Clauses}. - - -%% @spec ann_c_case(As::[term()], Argument::cerl(), -%% Clauses::[cerl()]) -> cerl() -%% @see c_case/2 - -ann_c_case(As, Expr, Clauses) -> - #'case'{arg = Expr, clauses = Clauses, ann = As}. - - -%% @spec update_c_case(Old::cerl(), Argument::cerl(), -%% Clauses::[cerl()]) -> cerl() -%% @see c_case/2 - -update_c_case(Node, Expr, Clauses) -> - #'case'{arg = Expr, clauses = Clauses, ann = get_ann(Node)}. - - -%% is_c_case(Node) -> boolean() -%% -%% Node = cerl() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% case-expression; otherwise <code>false</code>. -%% -%% @see c_case/2 - -is_c_case(#'case'{}) -> - true; -is_c_case(_) -> - false. - - -%% @spec case_arg(cerl()) -> cerl() -%% -%% @doc Returns the argument subtree of an abstract case-expression. -%% -%% @see c_case/2 - -case_arg(Node) -> - Node#'case'.arg. - - -%% @spec case_clauses(cerl()) -> [cerl()] -%% -%% @doc Returns the list of clause subtrees of an abstract -%% case-expression. -%% -%% @see c_case/2 -%% @see case_arity/1 - -case_clauses(Node) -> - Node#'case'.clauses. - - -%% @spec case_arity(Node::cerl()) -> integer() -%% -%% @doc Equivalent to -%% <code>clause_arity(hd(case_clauses(Node)))</code>, but potentially -%% more efficient. -%% -%% @see c_case/2 -%% @see case_clauses/1 -%% @see clause_arity/1 - -case_arity(Node) -> - clause_arity(hd(case_clauses(Node))). - - -%% --------------------------------------------------------------------- - -%% @spec c_clause(Patterns::[cerl()], Body::cerl()) -> cerl() -%% @equiv c_clause(Patterns, c_atom(true), Body) -%% @see c_atom/1 - -c_clause(Patterns, Body) -> - c_clause(Patterns, c_atom(true), Body). - - -%% @spec c_clause(Patterns::[cerl()], Guard::cerl(), Body::cerl()) -> -%% cerl() -%% -%% @doc Creates an an abstract clause. If <code>Patterns</code> is -%% <code>[P1, ..., Pn]</code>, the result represents -%% "<code><<em>P1</em>, ..., <em>Pn</em>> when <em>Guard</em> -> -%% <em>Body</em></code>". -%% -%% @see c_clause/2 -%% @see ann_c_clause/4 -%% @see update_c_clause/4 -%% @see is_c_clause/1 -%% @see c_case/2 -%% @see c_receive/3 -%% @see clause_pats/1 -%% @see clause_guard/1 -%% @see clause_body/1 -%% @see clause_arity/1 -%% @see clause_vars/1 - --record(clause, {ann = [], pats, guard, body}). - -c_clause(Patterns, Guard, Body) -> - #clause{pats = Patterns, guard = Guard, body = Body}. - - -%% @spec ann_c_clause(As::[term()], Patterns::[cerl()], -%% Body::cerl()) -> cerl() -%% @equiv ann_c_clause(As, Patterns, c_atom(true), Body) -%% @see c_clause/3 -ann_c_clause(As, Patterns, Body) -> - ann_c_clause(As, Patterns, c_atom(true), Body). - - -%% @spec ann_c_clause(As::[term()], Patterns::[cerl()], Guard::cerl(), -%% Body::cerl()) -> cerl() -%% @see ann_c_clause/3 -%% @see c_clause/3 - -ann_c_clause(As, Patterns, Guard, Body) -> - #clause{pats = Patterns, guard = Guard, body = Body, ann = As}. - - -%% @spec update_c_clause(Old::cerl(), Patterns::[cerl()], -%% Guard::cerl(), Body::cerl()) -> cerl() -%% @see c_clause/3 - -update_c_clause(Node, Patterns, Guard, Body) -> - #clause{pats = Patterns, guard = Guard, body = Body, - ann = get_ann(Node)}. - - -%% @spec is_c_clause(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% clause, otherwise <code>false</code>. -%% -%% @see c_clause/3 - -is_c_clause(#clause{}) -> - true; -is_c_clause(_) -> - false. - - -%% @spec clause_pats(cerl()) -> [cerl()] -%% -%% @doc Returns the list of pattern subtrees of an abstract clause. -%% -%% @see c_clause/3 -%% @see clause_arity/1 - -clause_pats(Node) -> - Node#clause.pats. - - -%% @spec clause_guard(cerl()) -> cerl() -%% -%% @doc Returns the guard subtree of an abstract clause. -%% -%% @see c_clause/3 - -clause_guard(Node) -> - Node#clause.guard. - - -%% @spec clause_body(cerl()) -> cerl() -%% -%% @doc Returns the body subtree of an abstract clause. -%% -%% @see c_clause/3 - -clause_body(Node) -> - Node#clause.body. - - -%% @spec clause_arity(Node::cerl()) -> integer() -%% -%% @doc Returns the number of pattern subtrees of an abstract clause. -%% -%% <p>Note: this is equivalent to -%% <code>length(clause_pats(Node))</code>, but potentially more -%% efficient.</p> -%% -%% @see c_clause/3 -%% @see clause_pats/1 - -clause_arity(Node) -> - length(clause_pats(Node)). - - -%% @spec clause_vars(cerl()) -> [cerl()] -%% -%% @doc Returns the list of all abstract variables in the patterns of -%% an abstract clause. The order of listing is not defined. -%% -%% @see c_clause/3 -%% @see pat_list_vars/1 - -clause_vars(Clause) -> - pat_list_vars(clause_pats(Clause)). - - -%% @spec pat_vars(Pattern::cerl()) -> [cerl()] -%% -%% @doc Returns the list of all abstract variables in a pattern. An -%% exception is thrown if <code>Node</code> does not represent a -%% well-formed Core Erlang clause pattern. The order of listing is not -%% defined. -%% -%% @see pat_list_vars/1 -%% @see clause_vars/1 - -pat_vars(Node) -> - pat_vars(Node, []). - -pat_vars(Node, Vs) -> - case type(Node) of - var -> - [Node | Vs]; - literal -> - Vs; - cons -> - pat_vars(cons_hd(Node), pat_vars(cons_tl(Node), Vs)); - tuple -> - pat_list_vars(tuple_es(Node), Vs); - binary -> - pat_list_vars(binary_segments(Node), Vs); - bitstr -> - pat_vars(bitstr_val(Node), Vs); - alias -> - pat_vars(alias_pat(Node), [alias_var(Node) | Vs]) - end. - - -%% @spec pat_list_vars(Patterns::[cerl()]) -> [cerl()] -%% -%% @doc Returns the list of all abstract variables in the given -%% patterns. An exception is thrown if some element in -%% <code>Patterns</code> does not represent a well-formed Core Erlang -%% clause pattern. The order of listing is not defined. -%% -%% @see pat_vars/1 -%% @see clause_vars/1 - -pat_list_vars(Ps) -> - pat_list_vars(Ps, []). - -pat_list_vars([P | Ps], Vs) -> - pat_list_vars(Ps, pat_vars(P, Vs)); -pat_list_vars([], Vs) -> - Vs. - - -%% --------------------------------------------------------------------- - -%% @spec c_alias(Variable::cerl(), Pattern::cerl()) -> cerl() -%% -%% @doc Creates an abstract pattern alias. The result represents -%% "<code><em>Variable</em> = <em>Pattern</em></code>". -%% -%% @see ann_c_alias/3 -%% @see update_c_alias/3 -%% @see is_c_alias/1 -%% @see alias_var/1 -%% @see alias_pat/1 -%% @see c_clause/3 - --record(alias, {ann = [], var, pat}). - -c_alias(Var, Pattern) -> - #alias{var = Var, pat = Pattern}. - - -%% @spec ann_c_alias(As::[term()], Variable::cerl(), -%% Pattern::cerl()) -> cerl() -%% @see c_alias/2 - -ann_c_alias(As, Var, Pattern) -> - #alias{var = Var, pat = Pattern, ann = As}. - - -%% @spec update_c_alias(Old::cerl(), Variable::cerl(), -%% Pattern::cerl()) -> cerl() -%% @see c_alias/2 - -update_c_alias(Node, Var, Pattern) -> - #alias{var = Var, pat = Pattern, ann = get_ann(Node)}. - - -%% @spec is_c_alias(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% pattern alias, otherwise <code>false</code>. -%% -%% @see c_alias/2 - -is_c_alias(#alias{}) -> - true; -is_c_alias(_) -> - false. - - -%% @spec alias_var(cerl()) -> cerl() -%% -%% @doc Returns the variable subtree of an abstract pattern alias. -%% -%% @see c_alias/2 - -alias_var(Node) -> - Node#alias.var. - - -%% @spec alias_pat(cerl()) -> cerl() -%% -%% @doc Returns the pattern subtree of an abstract pattern alias. -%% -%% @see c_alias/2 - -alias_pat(Node) -> - Node#alias.pat. - - -%% --------------------------------------------------------------------- - -%% @spec c_receive(Clauses::[cerl()]) -> cerl() -%% @equiv c_receive(Clauses, c_atom(infinity), c_atom(true)) -%% @see c_atom/1 - -c_receive(Clauses) -> - c_receive(Clauses, c_atom(infinity), c_atom(true)). - - -%% @spec c_receive(Clauses::[cerl()], Timeout::cerl(), -%% Action::cerl()) -> cerl() -%% -%% @doc Creates an abstract receive-expression. If -%% <code>Clauses</code> is <code>[C1, ..., Cn]</code>, the result -%% represents "<code>receive <em>C1</em> ... <em>Cn</em> after -%% <em>Timeout</em> -> <em>Action</em> end</code>". -%% -%% @see c_receive/1 -%% @see ann_c_receive/4 -%% @see update_c_receive/4 -%% @see is_c_receive/1 -%% @see receive_clauses/1 -%% @see receive_timeout/1 -%% @see receive_action/1 - --record('receive', {ann = [], clauses, timeout, action}). - -c_receive(Clauses, Timeout, Action) -> - #'receive'{clauses = Clauses, timeout = Timeout, action = Action}. - - -%% @spec ann_c_receive(As::[term()], Clauses::[cerl()]) -> cerl() -%% @equiv ann_c_receive(As, Clauses, c_atom(infinity), c_atom(true)) -%% @see c_receive/3 -%% @see c_atom/1 - -ann_c_receive(As, Clauses) -> - ann_c_receive(As, Clauses, c_atom(infinity), c_atom(true)). - - -%% @spec ann_c_receive(As::[term()], Clauses::[cerl()], -%% Timeout::cerl(), Action::cerl()) -> cerl() -%% @see ann_c_receive/2 -%% @see c_receive/3 - -ann_c_receive(As, Clauses, Timeout, Action) -> - #'receive'{clauses = Clauses, timeout = Timeout, action = Action, - ann = As}. - - -%% @spec update_c_receive(Old::cerl(), Clauses::[cerl()], -%% Timeout::cerl(), Action::cerl()) -> cerl() -%% @see c_receive/3 - -update_c_receive(Node, Clauses, Timeout, Action) -> - #'receive'{clauses = Clauses, timeout = Timeout, action = Action, - ann = get_ann(Node)}. - - -%% @spec is_c_receive(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% receive-expression, otherwise <code>false</code>. -%% -%% @see c_receive/3 - -is_c_receive(#'receive'{}) -> - true; -is_c_receive(_) -> - false. - - -%% @spec receive_clauses(cerl()) -> [cerl()] -%% -%% @doc Returns the list of clause subtrees of an abstract -%% receive-expression. -%% -%% @see c_receive/3 - -receive_clauses(Node) -> - Node#'receive'.clauses. - - -%% @spec receive_timeout(cerl()) -> cerl() -%% -%% @doc Returns the timeout subtree of an abstract receive-expression. -%% -%% @see c_receive/3 - -receive_timeout(Node) -> - Node#'receive'.timeout. - - -%% @spec receive_action(cerl()) -> cerl() -%% -%% @doc Returns the action subtree of an abstract receive-expression. -%% -%% @see c_receive/3 - -receive_action(Node) -> - Node#'receive'.action. - - -%% --------------------------------------------------------------------- - -%% @spec c_apply(Operator::cerl(), Arguments::[cerl()]) -> cerl() -%% -%% @doc Creates an abstract function application. If -%% <code>Arguments</code> is <code>[A1, ..., An]</code>, the result -%% represents "<code>apply <em>Operator</em>(<em>A1</em>, ..., -%% <em>An</em>)</code>". -%% -%% @see ann_c_apply/3 -%% @see update_c_apply/3 -%% @see is_c_apply/1 -%% @see apply_op/1 -%% @see apply_args/1 -%% @see apply_arity/1 -%% @see c_call/3 -%% @see c_primop/2 - --record(apply, {ann = [], op, args}). - -c_apply(Operator, Arguments) -> - #apply{op = Operator, args = Arguments}. - - -%% @spec ann_c_apply(As::[term()], Operator::cerl(), -%% Arguments::[cerl()]) -> cerl() -%% @see c_apply/2 - -ann_c_apply(As, Operator, Arguments) -> - #apply{op = Operator, args = Arguments, ann = As}. - - -%% @spec update_c_apply(Old::cerl(), Operator::cerl(), -%% Arguments::[cerl()]) -> cerl() -%% @see c_apply/2 - -update_c_apply(Node, Operator, Arguments) -> - #apply{op = Operator, args = Arguments, ann = get_ann(Node)}. - - -%% @spec is_c_apply(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% function application, otherwise <code>false</code>. -%% -%% @see c_apply/2 - -is_c_apply(#apply{}) -> - true; -is_c_apply(_) -> - false. - - -%% @spec apply_op(cerl()) -> cerl() -%% -%% @doc Returns the operator subtree of an abstract function -%% application. -%% -%% @see c_apply/2 - -apply_op(Node) -> - Node#apply.op. - - -%% @spec apply_args(cerl()) -> [cerl()] -%% -%% @doc Returns the list of argument subtrees of an abstract function -%% application. -%% -%% @see c_apply/2 -%% @see apply_arity/1 - -apply_args(Node) -> - Node#apply.args. - - -%% @spec apply_arity(Node::cerl()) -> integer() -%% -%% @doc Returns the number of argument subtrees of an abstract -%% function application. -%% -%% <p>Note: this is equivalent to -%% <code>length(apply_args(Node))</code>, but potentially more -%% efficient.</p> -%% -%% @see c_apply/2 -%% @see apply_args/1 - -apply_arity(Node) -> - length(apply_args(Node)). - - -%% --------------------------------------------------------------------- - -%% @spec c_call(Module::cerl(), Name::cerl(), Arguments::[cerl()]) -> -%% cerl() -%% -%% @doc Creates an abstract inter-module call. If -%% <code>Arguments</code> is <code>[A1, ..., An]</code>, the result -%% represents "<code>call <em>Module</em>:<em>Name</em>(<em>A1</em>, -%% ..., <em>An</em>)</code>". -%% -%% @see ann_c_call/4 -%% @see update_c_call/4 -%% @see is_c_call/1 -%% @see call_module/1 -%% @see call_name/1 -%% @see call_args/1 -%% @see call_arity/1 -%% @see c_apply/2 -%% @see c_primop/2 - --record(call, {ann = [], module, name, args}). - -c_call(Module, Name, Arguments) -> - #call{module = Module, name = Name, args = Arguments}. - - -%% @spec ann_c_call(As::[term()], Module::cerl(), Name::cerl(), -%% Arguments::[cerl()]) -> cerl() -%% @see c_call/3 - -ann_c_call(As, Module, Name, Arguments) -> - #call{module = Module, name = Name, args = Arguments, ann = As}. - - -%% @spec update_c_call(Old::cerl(), Module::cerl(), Name::cerl(), -%% Arguments::[cerl()]) -> cerl() -%% @see c_call/3 - -update_c_call(Node, Module, Name, Arguments) -> - #call{module = Module, name = Name, args = Arguments, - ann = get_ann(Node)}. - - -%% @spec is_c_call(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% inter-module call expression; otherwise <code>false</code>. -%% -%% @see c_call/3 - -is_c_call(#call{}) -> - true; -is_c_call(_) -> - false. - - -%% @spec call_module(cerl()) -> cerl() -%% -%% @doc Returns the module subtree of an abstract inter-module call. -%% -%% @see c_call/3 - -call_module(Node) -> - Node#call.module. - - -%% @spec call_name(cerl()) -> cerl() -%% -%% @doc Returns the name subtree of an abstract inter-module call. -%% -%% @see c_call/3 - -call_name(Node) -> - Node#call.name. - - -%% @spec call_args(cerl()) -> [cerl()] -%% -%% @doc Returns the list of argument subtrees of an abstract -%% inter-module call. -%% -%% @see c_call/3 -%% @see call_arity/1 - -call_args(Node) -> - Node#call.args. - - -%% @spec call_arity(Node::cerl()) -> integer() -%% -%% @doc Returns the number of argument subtrees of an abstract -%% inter-module call. -%% -%% <p>Note: this is equivalent to -%% <code>length(call_args(Node))</code>, but potentially more -%% efficient.</p> -%% -%% @see c_call/3 -%% @see call_args/1 - -call_arity(Node) -> - length(call_args(Node)). - - -%% --------------------------------------------------------------------- - -%% @spec c_primop(Name::cerl(), Arguments::[cerl()]) -> cerl() -%% -%% @doc Creates an abstract primitive operation call. If -%% <code>Arguments</code> is <code>[A1, ..., An]</code>, the result -%% represents "<code>primop <em>Name</em>(<em>A1</em>, ..., -%% <em>An</em>)</code>". <code>Name</code> must be an atom literal. -%% -%% @see ann_c_primop/3 -%% @see update_c_primop/3 -%% @see is_c_primop/1 -%% @see primop_name/1 -%% @see primop_args/1 -%% @see primop_arity/1 -%% @see c_apply/2 -%% @see c_call/3 - --record(primop, {ann = [], name, args}). - -c_primop(Name, Arguments) -> - #primop{name = Name, args = Arguments}. - - -%% @spec ann_c_primop(As::[term()], Name::cerl(), -%% Arguments::[cerl()]) -> cerl() -%% @see c_primop/2 - -ann_c_primop(As, Name, Arguments) -> - #primop{name = Name, args = Arguments, ann = As}. - - -%% @spec update_c_primop(Old::cerl(), Name::cerl(), -%% Arguments::[cerl()]) -> cerl() -%% @see c_primop/2 - -update_c_primop(Node, Name, Arguments) -> - #primop{name = Name, args = Arguments, ann = get_ann(Node)}. - - -%% @spec is_c_primop(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% primitive operation call, otherwise <code>false</code>. -%% -%% @see c_primop/2 - -is_c_primop(#primop{}) -> - true; -is_c_primop(_) -> - false. - - -%% @spec primop_name(cerl()) -> cerl() -%% -%% @doc Returns the name subtree of an abstract primitive operation -%% call. -%% -%% @see c_primop/2 - -primop_name(Node) -> - Node#primop.name. - - -%% @spec primop_args(cerl()) -> [cerl()] -%% -%% @doc Returns the list of argument subtrees of an abstract primitive -%% operation call. -%% -%% @see c_primop/2 -%% @see primop_arity/1 - -primop_args(Node) -> - Node#primop.args. - - -%% @spec primop_arity(Node::cerl()) -> integer() -%% -%% @doc Returns the number of argument subtrees of an abstract -%% primitive operation call. -%% -%% <p>Note: this is equivalent to -%% <code>length(primop_args(Node))</code>, but potentially more -%% efficient.</p> -%% -%% @see c_primop/2 -%% @see primop_args/1 - -primop_arity(Node) -> - length(primop_args(Node)). - - -%% --------------------------------------------------------------------- - -%% @spec c_try(Argument::cerl(), Variables::[cerl()], Body::cerl(), -%% ExceptionVars::[cerl()], Handler::cerl()) -> cerl() -%% -%% @doc Creates an abstract try-expression. If <code>Variables</code> is -%% <code>[V1, ..., Vn]</code> and <code>ExceptionVars</code> is -%% <code>[X1, ..., Xm]</code>, the result represents "<code>try -%% <em>Argument</em> of <<em>V1</em>, ..., <em>Vn</em>> -> -%% <em>Body</em> catch <<em>X1</em>, ..., <em>Xm</em>> -> -%% <em>Handler</em></code>". All the <code>Vi</code> and <code>Xi</code> -%% must have type <code>var</code>. -%% -%% @see ann_c_try/6 -%% @see update_c_try/6 -%% @see is_c_try/1 -%% @see try_arg/1 -%% @see try_vars/1 -%% @see try_body/1 -%% @see c_catch/1 - --record('try', {ann = [], arg, vars, body, evars, handler}). - -c_try(Expr, Vs, Body, Evs, Handler) -> - #'try'{arg = Expr, vars = Vs, body = Body, - evars = Evs, handler = Handler}. - - -%% @spec ann_c_try(As::[term()], Expression::cerl(), -%% Variables::[cerl()], Body::cerl(), -%% EVars::[cerl()], EBody::[cerl()]) -> cerl() -%% @see c_try/3 - -ann_c_try(As, Expr, Vs, Body, Evs, Handler) -> - #'try'{arg = Expr, vars = Vs, body = Body, - evars = Evs, handler = Handler, ann = As}. - - -%% @spec update_c_try(Old::cerl(), Expression::cerl(), -%% Variables::[cerl()], Body::cerl(), -%% EVars::[cerl()], EBody::[cerl()]) -> cerl() -%% @see c_try/3 - -update_c_try(Node, Expr, Vs, Body, Evs, Handler) -> - #'try'{arg = Expr, vars = Vs, body = Body, - evars = Evs, handler = Handler, ann = get_ann(Node)}. - - -%% @spec is_c_try(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% try-expression, otherwise <code>false</code>. -%% -%% @see c_try/3 - -is_c_try(#'try'{}) -> - true; -is_c_try(_) -> - false. - - -%% @spec try_arg(cerl()) -> cerl() -%% -%% @doc Returns the expression subtree of an abstract try-expression. -%% -%% @see c_try/3 - -try_arg(Node) -> - Node#'try'.arg. - - -%% @spec try_vars(cerl()) -> [cerl()] -%% -%% @doc Returns the list of success variable subtrees of an abstract -%% try-expression. -%% -%% @see c_try/3 - -try_vars(Node) -> - Node#'try'.vars. - - -%% @spec try_body(cerl()) -> cerl() -%% -%% @doc Returns the success body subtree of an abstract try-expression. -%% -%% @see c_try/3 - -try_body(Node) -> - Node#'try'.body. - - -%% @spec try_evars(cerl()) -> [cerl()] -%% -%% @doc Returns the list of exception variable subtrees of an abstract -%% try-expression. -%% -%% @see c_try/3 - -try_evars(Node) -> - Node#'try'.evars. - - -%% @spec try_handler(cerl()) -> cerl() -%% -%% @doc Returns the exception body subtree of an abstract -%% try-expression. -%% -%% @see c_try/3 - -try_handler(Node) -> - Node#'try'.handler. - - -%% --------------------------------------------------------------------- - -%% @spec c_catch(Body::cerl()) -> cerl() -%% -%% @doc Creates an abstract catch-expression. The result represents -%% "<code>catch <em>Body</em></code>". -%% -%% <p>Note: catch-expressions can be rewritten as try-expressions, and -%% will eventually be removed from Core Erlang.</p> -%% -%% @see ann_c_catch/2 -%% @see update_c_catch/2 -%% @see is_c_catch/1 -%% @see catch_body/1 -%% @see c_try/3 - --record('catch', {ann = [], body}). - -c_catch(Body) -> - #'catch'{body = Body}. - - -%% @spec ann_c_catch(As::[term()], Body::cerl()) -> cerl() -%% @see c_catch/1 - -ann_c_catch(As, Body) -> - #'catch'{body = Body, ann = As}. - - -%% @spec update_c_catch(Old::cerl(), Body::cerl()) -> cerl() -%% @see c_catch/1 - -update_c_catch(Node, Body) -> - #'catch'{body = Body, ann = get_ann(Node)}. - - -%% @spec is_c_catch(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> is an abstract -%% catch-expression, otherwise <code>false</code>. -%% -%% @see c_catch/1 - -is_c_catch(#'catch'{}) -> - true; -is_c_catch(_) -> - false. - - -%% @spec catch_body(Node::cerl()) -> cerl() -%% -%% @doc Returns the body subtree of an abstract catch-expression. -%% -%% @see c_catch/1 - -catch_body(Node) -> - Node#'catch'.body. - - -%% --------------------------------------------------------------------- - -%% @spec to_records(Tree::cerl()) -> record(record_types()) -%% -%% @doc Translates an abstract syntax tree to a corresponding explicit -%% record representation. The records are defined in the file -%% "<code>cerl.hrl</code>". -%% -%% <p>Note: Compound constant literals are always unfolded in the -%% record representation.</p> -%% -%% @see type/1 -%% @see from_records/1 - -to_records(Node) -> - A = get_ann(Node), - case type(Node) of - literal -> - lit_to_records(concrete(Node), A); - binary -> - #c_binary{anno = A, - segments = - list_to_records(binary_segments(Node))}; - bitstr -> - #c_bitstr{anno = A, - val = to_records(bitstr_val(Node)), - size = to_records(bitstr_size(Node)), - unit = to_records(bitstr_unit(Node)), - type = to_records(bitstr_type(Node)), - flags = to_records(bitstr_flags(Node))}; - cons -> - #c_cons{anno = A, - hd = to_records(cons_hd(Node)), - tl = to_records(cons_tl(Node))}; - tuple -> - #c_tuple{anno = A, - es = list_to_records(tuple_es(Node))}; - var -> - case is_c_fname(Node) of - true -> - #c_fname{anno = A, - id = fname_id(Node), - arity = fname_arity(Node)}; - false -> - #c_var{anno = A, name = var_name(Node)} - end; - values -> - #c_values{anno = A, - es = list_to_records(values_es(Node))}; - 'fun' -> - #c_fun{anno = A, - vars = list_to_records(fun_vars(Node)), - body = to_records(fun_body(Node))}; - seq -> - #c_seq{anno = A, - arg = to_records(seq_arg(Node)), - body = to_records(seq_body(Node))}; - 'let' -> - #c_let{anno = A, - vars = list_to_records(let_vars(Node)), - arg = to_records(let_arg(Node)), - body = to_records(let_body(Node))}; - letrec -> - #c_letrec{anno = A, - defs = [#c_def{name = to_records(N), - val = to_records(F)} - || {N, F} <- letrec_defs(Node)], - body = to_records(letrec_body(Node))}; - 'case' -> - #c_case{anno = A, - arg = to_records(case_arg(Node)), - clauses = - list_to_records(case_clauses(Node))}; - clause -> - #c_clause{anno = A, - pats = list_to_records(clause_pats(Node)), - guard = to_records(clause_guard(Node)), - body = to_records(clause_body(Node))}; - alias -> - #c_alias{anno = A, - var = to_records(alias_var(Node)), - pat = to_records(alias_pat(Node))}; - 'receive' -> - #c_receive{anno = A, - clauses = - list_to_records(receive_clauses(Node)), - timeout = - to_records(receive_timeout(Node)), - action = - to_records(receive_action(Node))}; - apply -> - #c_apply{anno = A, - op = to_records(apply_op(Node)), - args = list_to_records(apply_args(Node))}; - call -> - #c_call{anno = A, - module = to_records(call_module(Node)), - name = to_records(call_name(Node)), - args = list_to_records(call_args(Node))}; - primop -> - #c_primop{anno = A, - name = to_records(primop_name(Node)), - args = list_to_records(primop_args(Node))}; - 'try' -> - #c_try{anno = A, - arg = to_records(try_arg(Node)), - vars = list_to_records(try_vars(Node)), - body = to_records(try_body(Node)), - evars = list_to_records(try_evars(Node)), - handler = to_records(try_handler(Node))}; - 'catch' -> - #c_catch{anno = A, - body = to_records(catch_body(Node))}; - module -> - #c_module{anno = A, - name = to_records(module_name(Node)), - exports = list_to_records( - module_exports(Node)), - attrs = [#c_def{name = to_records(K), - val = to_records(V)} - || {K, V} <- module_attrs(Node)], - defs = [#c_def{name = to_records(N), - val = to_records(F)} - || {N, F} <- module_defs(Node)]} - end. - -list_to_records([T | Ts]) -> - [to_records(T) | list_to_records(Ts)]; -list_to_records([]) -> - []. - -lit_to_records(V, A) when integer(V) -> - #c_int{anno = A, val = V}; -lit_to_records(V, A) when float(V) -> - #c_float{anno = A, val = V}; -lit_to_records(V, A) when atom(V) -> - #c_atom{anno = A, val = V}; -lit_to_records([H | T] = V, A) -> - case is_print_char_list(V) of - true -> - #c_string{anno = A, val = V}; - false -> - #c_cons{anno = A, - hd = lit_to_records(H, []), - tl = lit_to_records(T, [])} - end; -lit_to_records([], A) -> - #c_nil{anno = A}; -lit_to_records(V, A) when tuple(V) -> - #c_tuple{anno = A, es = lit_list_to_records(tuple_to_list(V))}. - -lit_list_to_records([T | Ts]) -> - [lit_to_records(T, []) | lit_list_to_records(Ts)]; -lit_list_to_records([]) -> - []. - - -%% @spec from_records(Tree::record(record_types())) -> cerl() -%% -%% record_types() = c_alias | c_apply | c_call | c_case | c_catch | -%% c_clause | c_cons | c_def| c_fun | c_let | -%% c_letrec |c_lit | c_module | c_primop | -%% c_receive | c_seq | c_try | c_tuple | -%% c_values | c_var -%% -%% @doc Translates an explicit record representation to a -%% corresponding abstract syntax tree. The records are defined in the -%% file "<code>cerl.hrl</code>". -%% -%% <p>Note: Compound constant literals are folded, discarding -%% annotations on subtrees. There are no <code>c_def</code> nodes in -%% the abstract representation; annotations on <code>c_def</code> -%% records are discarded.</p> -%% -%% @see type/1 -%% @see to_records/1 - -from_records(#c_int{val = V, anno = As}) -> - ann_c_int(As, V); -from_records(#c_float{val = V, anno = As}) -> - ann_c_float(As, V); -from_records(#c_atom{val = V, anno = As}) -> - ann_c_atom(As, V); -from_records(#c_char{val = V, anno = As}) -> - ann_c_char(As, V); -from_records(#c_string{val = V, anno = As}) -> - ann_c_string(As, V); -from_records(#c_nil{anno = As}) -> - ann_c_nil(As); -from_records(#c_binary{segments = Ss, anno = As}) -> - ann_c_binary(As, from_records_list(Ss)); -from_records(#c_bitstr{val = V, size = S, unit = U, type = T, - flags = Fs, anno = As}) -> - ann_c_bitstr(As, from_records(V), from_records(S), from_records(U), - from_records(T), from_records(Fs)); -from_records(#c_cons{hd = H, tl = T, anno = As}) -> - ann_c_cons(As, from_records(H), from_records(T)); -from_records(#c_tuple{es = Es, anno = As}) -> - ann_c_tuple(As, from_records_list(Es)); -from_records(#c_var{name = Name, anno = As}) -> - ann_c_var(As, Name); -from_records(#c_fname{id = Id, arity = Arity, anno = As}) -> - ann_c_fname(As, Id, Arity); -from_records(#c_values{es = Es, anno = As}) -> - ann_c_values(As, from_records_list(Es)); -from_records(#c_fun{vars = Vs, body = B, anno = As}) -> - ann_c_fun(As, from_records_list(Vs), from_records(B)); -from_records(#c_seq{arg = A, body = B, anno = As}) -> - ann_c_seq(As, from_records(A), from_records(B)); -from_records(#c_let{vars = Vs, arg = A, body = B, anno = As}) -> - ann_c_let(As, from_records_list(Vs), from_records(A), - from_records(B)); -from_records(#c_letrec{defs = Fs, body = B, anno = As}) -> - ann_c_letrec(As, [{from_records(N), from_records(F)} - || #c_def{name = N, val = F} <- Fs], - from_records(B)); -from_records(#c_case{arg = A, clauses = Cs, anno = As}) -> - ann_c_case(As, from_records(A), from_records_list(Cs)); -from_records(#c_clause{pats = Ps, guard = G, body = B, anno = As}) -> - ann_c_clause(As, from_records_list(Ps), from_records(G), - from_records(B)); -from_records(#c_alias{var = V, pat = P, anno = As}) -> - ann_c_alias(As, from_records(V), from_records(P)); -from_records(#c_receive{clauses = Cs, timeout = T, action = A, - anno = As}) -> - ann_c_receive(As, from_records_list(Cs), from_records(T), - from_records(A)); -from_records(#c_apply{op = Op, args = Es, anno = As}) -> - ann_c_apply(As, from_records(Op), from_records_list(Es)); -from_records(#c_call{module = M, name = N, args = Es, anno = As}) -> - ann_c_call(As, from_records(M), from_records(N), - from_records_list(Es)); -from_records(#c_primop{name = N, args = Es, anno = As}) -> - ann_c_primop(As, from_records(N), from_records_list(Es)); -from_records(#c_try{arg = E, vars = Vs, body = B, - evars = Evs, handler = H, anno = As}) -> - ann_c_try(As, from_records(E), from_records_list(Vs), - from_records(B), from_records_list(Evs), from_records(H)); -from_records(#c_catch{body = B, anno = As}) -> - ann_c_catch(As, from_records(B)); -from_records(#c_module{name = N, exports = Es, attrs = Ds, defs = Fs, - anno = As}) -> - ann_c_module(As, from_records(N), - from_records_list(Es), - [{from_records(K), from_records(V)} - || #c_def{name = K, val = V} <- Ds], - [{from_records(V), from_records(F)} - || #c_def{name = V, val = F} <- Fs]). - -from_records_list([T | Ts]) -> - [from_records(T) | from_records_list(Ts)]; -from_records_list([]) -> - []. - - -%% --------------------------------------------------------------------- - -%% @spec is_data(Node::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if <code>Node</code> represents a -%% data constructor, otherwise <code>false</code>. Data constructors -%% are cons cells, tuples, and atomic literals. -%% -%% @see data_type/1 -%% @see data_es/1 -%% @see data_arity/1 - -is_data(#literal{}) -> - true; -is_data(#cons{}) -> - true; -is_data(#tuple{}) -> - true; -is_data(_) -> - false. - - -%% @spec data_type(Node::cerl()) -> dtype() -%% -%% dtype() = cons | tuple | {'atomic', Value} -%% Value = integer() | float() | atom() | [] -%% -%% @doc Returns a type descriptor for a data constructor -%% node. (Cf. <code>is_data/1</code>.) This is mainly useful for -%% comparing types and for constructing new nodes of the same type -%% (cf. <code>make_data/2</code>). If <code>Node</code> represents an -%% integer, floating-point number, atom or empty list, the result is -%% <code>{'atomic', Value}</code>, where <code>Value</code> is the value -%% of <code>concrete(Node)</code>, otherwise the result is either -%% <code>cons</code> or <code>tuple</code>. -%% -%% <p>Type descriptors can be compared for equality or order (in the -%% Erlang term order), but remember that floating-point values should -%% in general never be tested for equality.</p> -%% -%% @see is_data/1 -%% @see make_data/2 -%% @see type/1 -%% @see concrete/1 - -data_type(#literal{val = V}) -> - case V of - [_ | _] -> - cons; - _ when tuple(V) -> - tuple; - _ -> - {'atomic', V} - end; -data_type(#cons{}) -> - cons; -data_type(#tuple{}) -> - tuple. - - -%% @spec data_es(Node::cerl()) -> [cerl()] -%% -%% @doc Returns the list of subtrees of a data constructor node. If -%% the arity of the constructor is zero, the result is the empty list. -%% -%% <p>Note: if <code>data_type(Node)</code> is <code>cons</code>, the -%% number of subtrees is exactly two. If <code>data_type(Node)</code> -%% is <code>{'atomic', Value}</code>, the number of subtrees is -%% zero.</p> -%% -%% @see is_data/1 -%% @see data_type/1 -%% @see data_arity/1 -%% @see make_data/2 - -data_es(#literal{val = V}) -> - case V of - [Head | Tail] -> - [#literal{val = Head}, #literal{val = Tail}]; - _ when tuple(V) -> - make_lit_list(tuple_to_list(V)); - _ -> - [] - end; -data_es(#cons{hd = H, tl = T}) -> - [H, T]; -data_es(#tuple{es = Es}) -> - Es. - - -%% @spec data_arity(Node::cerl()) -> integer() -%% -%% @doc Returns the number of subtrees of a data constructor -%% node. This is equivalent to <code>length(data_es(Node))</code>, but -%% potentially more efficient. -%% -%% @see is_data/1 -%% @see data_es/1 - -data_arity(#literal{val = V}) -> - case V of - [_ | _] -> - 2; - _ when tuple(V) -> - size(V); - _ -> - 0 - end; -data_arity(#cons{}) -> - 2; -data_arity(#tuple{es = Es}) -> - length(Es). - - -%% @spec make_data(Type::dtype(), Elements::[cerl()]) -> cerl() -%% -%% @doc Creates a data constructor node with the specified type and -%% subtrees. (Cf. <code>data_type/1</code>.) An exception is thrown -%% if the length of <code>Elements</code> is invalid for the given -%% <code>Type</code>; see <code>data_es/1</code> for arity constraints -%% on constructor types. -%% -%% @see data_type/1 -%% @see data_es/1 -%% @see ann_make_data/3 -%% @see update_data/3 -%% @see make_data_skel/2 - -make_data(CType, Es) -> - ann_make_data([], CType, Es). - - -%% @spec ann_make_data(As::[term()], Type::dtype(), -%% Elements::[cerl()]) -> cerl() -%% @see make_data/2 - -ann_make_data(As, {'atomic', V}, []) -> #literal{val = V, ann = As}; -ann_make_data(As, cons, [H, T]) -> ann_c_cons(As, H, T); -ann_make_data(As, tuple, Es) -> ann_c_tuple(As, Es). - - -%% @spec update_data(Old::cerl(), Type::dtype(), -%% Elements::[cerl()]) -> cerl() -%% @see make_data/2 - -update_data(Node, CType, Es) -> - ann_make_data(get_ann(Node), CType, Es). - - -%% @spec make_data_skel(Type::dtype(), Elements::[cerl()]) -> cerl() -%% -%% @doc Like <code>make_data/2</code>, but analogous to -%% <code>c_tuple_skel/1</code> and <code>c_cons_skel/2</code>. -%% -%% @see ann_make_data_skel/3 -%% @see update_data_skel/3 -%% @see make_data/2 -%% @see c_tuple_skel/1 -%% @see c_cons_skel/2 - -make_data_skel(CType, Es) -> - ann_make_data_skel([], CType, Es). - - -%% @spec ann_make_data_skel(As::[term()], Type::dtype(), -%% Elements::[cerl()]) -> cerl() -%% @see make_data_skel/2 - -ann_make_data_skel(As, {'atomic', V}, []) -> #literal{val = V, ann = As}; -ann_make_data_skel(As, cons, [H, T]) -> ann_c_cons_skel(As, H, T); -ann_make_data_skel(As, tuple, Es) -> ann_c_tuple_skel(As, Es). - - -%% @spec update_data_skel(Old::cerl(), Type::dtype(), -%% Elements::[cerl()]) -> cerl() -%% @see make_data_skel/2 - -update_data_skel(Node, CType, Es) -> - ann_make_data_skel(get_ann(Node), CType, Es). - - -%% --------------------------------------------------------------------- - -%% @spec subtrees(Node::cerl()) -> [[cerl()]] -%% -%% @doc Returns the grouped list of all subtrees of a node. If -%% <code>Node</code> is a leaf node (cf. <code>is_leaf/1</code>), this -%% is the empty list, otherwise the result is always a nonempty list, -%% containing the lists of subtrees of <code>Node</code>, in -%% left-to-right order as they occur in the printed program text, and -%% grouped by category. Often, each group contains only a single -%% subtree. -%% -%% <p>Depending on the type of <code>Node</code>, the size of some -%% groups may be variable (e.g., the group consisting of all the -%% elements of a tuple), while others always contain the same number -%% of elements - usually exactly one (e.g., the group containing the -%% argument expression of a case-expression). Note, however, that the -%% exact structure of the returned list (for a given node type) should -%% in general not be depended upon, since it might be subject to -%% change without notice.</p> -%% -%% <p>The function <code>subtrees/1</code> and the constructor functions -%% <code>make_tree/2</code> and <code>update_tree/2</code> can be a -%% great help if one wants to traverse a syntax tree, visiting all its -%% subtrees, but treat nodes of the tree in a uniform way in most or all -%% cases. Using these functions makes this simple, and also assures that -%% your code is not overly sensitive to extensions of the syntax tree -%% data type, because any node types not explicitly handled by your code -%% can be left to a default case.</p> -%% -%% <p>For example: -%% <pre> -%% postorder(F, Tree) -> -%% F(case subtrees(Tree) of -%% [] -> Tree; -%% List -> update_tree(Tree, -%% [[postorder(F, Subtree) -%% || Subtree <- Group] -%% || Group <- List]) -%% end). -%% </pre> -%% maps the function <code>F</code> on <code>Tree</code> and all its -%% subtrees, doing a post-order traversal of the syntax tree. (Note -%% the use of <code>update_tree/2</code> to preserve annotations.) For -%% a simple function like: -%% <pre> -%% f(Node) -> -%% case type(Node) of -%% atom -> atom("a_" ++ atom_name(Node)); -%% _ -> Node -%% end. -%% </pre> -%% the call <code>postorder(fun f/1, Tree)</code> will yield a new -%% representation of <code>Tree</code> in which all atom names have -%% been extended with the prefix "a_", but nothing else (including -%% annotations) has been changed.</p> -%% -%% @see is_leaf/1 -%% @see make_tree/2 -%% @see update_tree/2 - -subtrees(T) -> - case is_leaf(T) of - true -> - []; - false -> - case type(T) of - values -> - [values_es(T)]; - binary -> - [binary_segments(T)]; - bitstr -> - [[bitstr_val(T)], [bitstr_size(T)], - [bitstr_unit(T)], [bitstr_type(T)], - [bitstr_flags(T)]]; - cons -> - [[cons_hd(T)], [cons_tl(T)]]; - tuple -> - [tuple_es(T)]; - 'let' -> - [let_vars(T), [let_arg(T)], [let_body(T)]]; - seq -> - [[seq_arg(T)], [seq_body(T)]]; - apply -> - [[apply_op(T)], apply_args(T)]; - call -> - [[call_module(T)], [call_name(T)], - call_args(T)]; - primop -> - [[primop_name(T)], primop_args(T)]; - 'case' -> - [[case_arg(T)], case_clauses(T)]; - clause -> - [clause_pats(T), [clause_guard(T)], - [clause_body(T)]]; - alias -> - [[alias_var(T)], [alias_pat(T)]]; - 'fun' -> - [fun_vars(T), [fun_body(T)]]; - 'receive' -> - [receive_clauses(T), [receive_timeout(T)], - [receive_action(T)]]; - 'try' -> - [[try_arg(T)], try_vars(T), [try_body(T)], - try_evars(T), [try_handler(T)]]; - 'catch' -> - [[catch_body(T)]]; - letrec -> - Es = unfold_tuples(letrec_defs(T)), - [Es, [letrec_body(T)]]; - module -> - As = unfold_tuples(module_attrs(T)), - Es = unfold_tuples(module_defs(T)), - [[module_name(T)], module_exports(T), As, Es] - end - end. - - -%% @spec update_tree(Old::cerl(), Groups::[[cerl()]]) -> cerl() -%% -%% @doc Creates a syntax tree with the given subtrees, and the same -%% type and annotations as the <code>Old</code> node. This is -%% equivalent to <code>ann_make_tree(get_ann(Node), type(Node), -%% Groups)</code>, but potentially more efficient. -%% -%% @see update_tree/3 -%% @see ann_make_tree/3 -%% @see get_ann/1 -%% @see type/1 - -update_tree(Node, Gs) -> - ann_make_tree(get_ann(Node), type(Node), Gs). - - -%% @spec update_tree(Old::cerl(), Type::atom(), Groups::[[cerl()]]) -> -%% cerl() -%% -%% @doc Creates a syntax tree with the given type and subtrees, and -%% the same annotations as the <code>Old</code> node. This is -%% equivalent to <code>ann_make_tree(get_ann(Node), Type, -%% Groups)</code>, but potentially more efficient. -%% -%% @see update_tree/2 -%% @see ann_make_tree/3 -%% @see get_ann/1 - -update_tree(Node, Type, Gs) -> - ann_make_tree(get_ann(Node), Type, Gs). - - -%% @spec make_tree(Type::atom(), Groups::[[cerl()]]) -> cerl() -%% -%% @doc Creates a syntax tree with the given type and subtrees. -%% <code>Type</code> must be a node type name -%% (cf. <code>type/1</code>) that does not denote a leaf node type -%% (cf. <code>is_leaf/1</code>). <code>Groups</code> must be a -%% <em>nonempty</em> list of groups of syntax trees, representing the -%% subtrees of a node of the given type, in left-to-right order as -%% they would occur in the printed program text, grouped by category -%% as done by <code>subtrees/1</code>. -%% -%% <p>The result of <code>ann_make_tree(get_ann(Node), type(Node), -%% subtrees(Node))</code> (cf. <code>update_tree/2</code>) represents -%% the same source code text as the original <code>Node</code>, -%% assuming that <code>subtrees(Node)</code> yields a nonempty -%% list. However, it does not necessarily have the exact same data -%% representation as <code>Node</code>.</p> -%% -%% @see ann_make_tree/3 -%% @see type/1 -%% @see is_leaf/1 -%% @see subtrees/1 -%% @see update_tree/2 - -make_tree(Type, Gs) -> - ann_make_tree([], Type, Gs). - - -%% @spec ann_make_tree(As::[term()], Type::atom(), -%% Groups::[[cerl()]]) -> cerl() -%% -%% @doc Creates a syntax tree with the given annotations, type and -%% subtrees. See <code>make_tree/2</code> for details. -%% -%% @see make_tree/2 - -ann_make_tree(As, values, [Es]) -> ann_c_values(As, Es); -ann_make_tree(As, binary, [Ss]) -> ann_c_binary(As, Ss); -ann_make_tree(As, bitstr, [[V],[S],[U],[T],[Fs]]) -> - ann_c_bitstr(As, V, S, U, T, Fs); -ann_make_tree(As, cons, [[H], [T]]) -> ann_c_cons(As, H, T); -ann_make_tree(As, tuple, [Es]) -> ann_c_tuple(As, Es); -ann_make_tree(As, 'let', [Vs, [A], [B]]) -> ann_c_let(As, Vs, A, B); -ann_make_tree(As, seq, [[A], [B]]) -> ann_c_seq(As, A, B); -ann_make_tree(As, apply, [[Op], Es]) -> ann_c_apply(As, Op, Es); -ann_make_tree(As, call, [[M], [N], Es]) -> ann_c_call(As, M, N, Es); -ann_make_tree(As, primop, [[N], Es]) -> ann_c_primop(As, N, Es); -ann_make_tree(As, 'case', [[A], Cs]) -> ann_c_case(As, A, Cs); -ann_make_tree(As, clause, [Ps, [G], [B]]) -> ann_c_clause(As, Ps, G, B); -ann_make_tree(As, alias, [[V], [P]]) -> ann_c_alias(As, V, P); -ann_make_tree(As, 'fun', [Vs, [B]]) -> ann_c_fun(As, Vs, B); -ann_make_tree(As, 'receive', [Cs, [T], [A]]) -> - ann_c_receive(As, Cs, T, A); -ann_make_tree(As, 'try', [[E], Vs, [B], Evs, [H]]) -> - ann_c_try(As, E, Vs, B, Evs, H); -ann_make_tree(As, 'catch', [[B]]) -> ann_c_catch(As, B); -ann_make_tree(As, letrec, [Es, [B]]) -> - ann_c_letrec(As, fold_tuples(Es), B); -ann_make_tree(As, module, [[N], Xs, Es, Ds]) -> - ann_c_module(As, N, Xs, fold_tuples(Es), fold_tuples(Ds)). - - -%% --------------------------------------------------------------------- - -%% @spec meta(Tree::cerl()) -> cerl() -%% -%% @doc Creates a meta-representation of a syntax tree. The result -%% represents an Erlang expression "<code><em>MetaTree</em></code>" -%% which, if evaluated, will yield a new syntax tree representing the -%% same source code text as <code>Tree</code> (although the actual -%% data representation may be different). The expression represented -%% by <code>MetaTree</code> is <em>implementation independent</em> -%% with regard to the data structures used by the abstract syntax tree -%% implementation. -%% -%% <p>Any node in <code>Tree</code> whose node type is -%% <code>var</code> (cf. <code>type/1</code>), and whose list of -%% annotations (cf. <code>get_ann/1</code>) contains the atom -%% <code>meta_var</code>, will remain unchanged in the resulting tree, -%% except that exactly one occurrence of <code>meta_var</code> is -%% removed from its annotation list.</p> -%% -%% <p>The main use of the function <code>meta/1</code> is to transform -%% a data structure <code>Tree</code>, which represents a piece of -%% program code, into a form that is <em>representation independent -%% when printed</em>. E.g., suppose <code>Tree</code> represents a -%% variable named "V". Then (assuming a function <code>print/1</code> -%% for printing syntax trees), evaluating -%% <code>print(abstract(Tree))</code> - simply using -%% <code>abstract/1</code> to map the actual data structure onto a -%% syntax tree representation - would output a string that might look -%% something like "<code>{var, ..., 'V'}</code>", which is obviously -%% dependent on the implementation of the abstract syntax trees. This -%% could e.g. be useful for caching a syntax tree in a file. However, -%% in some situations like in a program generator generator (with two -%% "generator"), it may be unacceptable. Using -%% <code>print(meta(Tree))</code> instead would output a -%% <em>representation independent</em> syntax tree generating -%% expression; in the above case, something like -%% "<code>cerl:c_var('V')</code>".</p> -%% -%% <p>The implementation tries to generate compact code with respect -%% to literals and lists.</p> -%% -%% @see abstract/1 -%% @see type/1 -%% @see get_ann/1 - -meta(Node) -> - %% First of all we check for metavariables: - case type(Node) of - var -> - case lists:member(meta_var, get_ann(Node)) of - false -> - meta_0(var, Node); - true -> - %% A meta-variable: remove the first found - %% 'meta_var' annotation, but otherwise leave - %% the node unchanged. - set_ann(Node, lists:delete(meta_var, get_ann(Node))) - end; - Type -> - meta_0(Type, Node) - end. - -meta_0(Type, Node) -> - case get_ann(Node) of - [] -> - meta_1(Type, Node); - As -> - meta_call(set_ann, [meta_1(Type, Node), abstract(As)]) - end. - -meta_1(literal, Node) -> - %% We handle atomic literals separately, to get a bit - %% more compact code. For the rest, we use 'abstract'. - case concrete(Node) of - V when atom(V) -> - meta_call(c_atom, [Node]); - V when integer(V) -> - meta_call(c_int, [Node]); - V when float(V) -> - meta_call(c_float, [Node]); - [] -> - meta_call(c_nil, []); - _ -> - meta_call(abstract, [Node]) - end; -meta_1(var, Node) -> - %% A normal variable or function name. - meta_call(c_var, [abstract(var_name(Node))]); -meta_1(values, Node) -> - meta_call(c_values, - [make_list(meta_list(values_es(Node)))]); -meta_1(binary, Node) -> - meta_call(c_binary, - [make_list(meta_list(binary_segments(Node)))]); -meta_1(bitstr, Node) -> - meta_call(c_bitstr, - [meta(bitstr_val(Node)), - meta(bitstr_size(Node)), - meta(bitstr_unit(Node)), - meta(bitstr_type(Node)), - meta(bitstr_flags(Node))]); -meta_1(cons, Node) -> - %% The list is split up if some sublist has annotatations. If - %% we get exactly one element, we generate a 'c_cons' call - %% instead of 'make_list' to reconstruct the node. - case split_list(Node) of - {[H], none} -> - meta_call(c_cons, [meta(H), meta(c_nil())]); - {[H], Node1} -> - meta_call(c_cons, [meta(H), meta(Node1)]); - {L, none} -> - meta_call(make_list, [make_list(meta_list(L))]); - {L, Node1} -> - meta_call(make_list, - [make_list(meta_list(L)), meta(Node1)]) - end; -meta_1(tuple, Node) -> - meta_call(c_tuple, - [make_list(meta_list(tuple_es(Node)))]); -meta_1('let', Node) -> - meta_call(c_let, - [make_list(meta_list(let_vars(Node))), - meta(let_arg(Node)), meta(let_body(Node))]); -meta_1(seq, Node) -> - meta_call(c_seq, - [meta(seq_arg(Node)), meta(seq_body(Node))]); -meta_1(apply, Node) -> - meta_call(c_apply, - [meta(apply_op(Node)), - make_list(meta_list(apply_args(Node)))]); -meta_1(call, Node) -> - meta_call(c_call, - [meta(call_module(Node)), meta(call_name(Node)), - make_list(meta_list(call_args(Node)))]); -meta_1(primop, Node) -> - meta_call(c_primop, - [meta(primop_name(Node)), - make_list(meta_list(primop_args(Node)))]); -meta_1('case', Node) -> - meta_call(c_case, - [meta(case_arg(Node)), - make_list(meta_list(case_clauses(Node)))]); -meta_1(clause, Node) -> - meta_call(c_clause, - [make_list(meta_list(clause_pats(Node))), - meta(clause_guard(Node)), - meta(clause_body(Node))]); -meta_1(alias, Node) -> - meta_call(c_alias, - [meta(alias_var(Node)), meta(alias_pat(Node))]); -meta_1('fun', Node) -> - meta_call(c_fun, - [make_list(meta_list(fun_vars(Node))), - meta(fun_body(Node))]); -meta_1('receive', Node) -> - meta_call(c_receive, - [make_list(meta_list(receive_clauses(Node))), - meta(receive_timeout(Node)), - meta(receive_action(Node))]); -meta_1('try', Node) -> - meta_call(c_try, - [meta(try_arg(Node)), - make_list(meta_list(try_vars(Node))), - meta(try_body(Node)), - make_list(meta_list(try_evars(Node))), - meta(try_handler(Node))]); -meta_1('catch', Node) -> - meta_call(c_catch, [meta(catch_body(Node))]); -meta_1(letrec, Node) -> - meta_call(c_letrec, - [make_list([c_tuple([meta(N), meta(F)]) - || {N, F} <- letrec_defs(Node)]), - meta(letrec_body(Node))]); -meta_1(module, Node) -> - meta_call(c_module, - [meta(module_name(Node)), - make_list(meta_list(module_exports(Node))), - make_list([c_tuple([meta(A), meta(V)]) - || {A, V} <- module_attrs(Node)]), - make_list([c_tuple([meta(N), meta(F)]) - || {N, F} <- module_defs(Node)])]). - -meta_call(F, As) -> - c_call(c_atom(?MODULE), c_atom(F), As). - -meta_list([T | Ts]) -> - [meta(T) | meta_list(Ts)]; -meta_list([]) -> - []. - -split_list(Node) -> - split_list(set_ann(Node, []), []). - -split_list(Node, L) -> - A = get_ann(Node), - case type(Node) of - cons when A == [] -> - split_list(cons_tl(Node), [cons_hd(Node) | L]); - nil when A == [] -> - {lists:reverse(L), none}; - _ -> - {lists:reverse(L), Node} - end. - - -%% --------------------------------------------------------------------- - -%% General utilities - -is_lit_list([#literal{} | Es]) -> - is_lit_list(Es); -is_lit_list([_ | _]) -> - false; -is_lit_list([]) -> - true. - -lit_list_vals([#literal{val = V} | Es]) -> - [V | lit_list_vals(Es)]; -lit_list_vals([]) -> - []. - -make_lit_list([V | Vs]) -> - [#literal{val = V} | make_lit_list(Vs)]; -make_lit_list([]) -> - []. - -%% The following tests are the same as done by 'io_lib:char_list' and -%% 'io_lib:printable_list', respectively, but for a single character. - -is_char_value(V) when V >= $\000, V =< $\377 -> true; -is_char_value(_) -> false. - -is_print_char_value(V) when V >= $\040, V =< $\176 -> true; -is_print_char_value(V) when V >= $\240, V =< $\377 -> true; -is_print_char_value(V) when V =:= $\b -> true; -is_print_char_value(V) when V =:= $\d -> true; -is_print_char_value(V) when V =:= $\e -> true; -is_print_char_value(V) when V =:= $\f -> true; -is_print_char_value(V) when V =:= $\n -> true; -is_print_char_value(V) when V =:= $\r -> true; -is_print_char_value(V) when V =:= $\s -> true; -is_print_char_value(V) when V =:= $\t -> true; -is_print_char_value(V) when V =:= $\v -> true; -is_print_char_value(V) when V =:= $\" -> true; -is_print_char_value(V) when V =:= $\' -> true; -is_print_char_value(V) when V =:= $\\ -> true; -is_print_char_value(_) -> false. - -is_char_list([V | Vs]) when integer(V) -> - case is_char_value(V) of - true -> - is_char_list(Vs); - false -> - false - end; -is_char_list([]) -> - true; -is_char_list(_) -> - false. - -is_print_char_list([V | Vs]) when integer(V) -> - case is_print_char_value(V) of - true -> - is_print_char_list(Vs); - false -> - false - end; -is_print_char_list([]) -> - true; -is_print_char_list(_) -> - false. - -unfold_tuples([{X, Y} | Ps]) -> - [X, Y | unfold_tuples(Ps)]; -unfold_tuples([]) -> - []. - -fold_tuples([X, Y | Es]) -> - [{X, Y} | fold_tuples(Es)]; -fold_tuples([]) -> - []. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_clauses.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_clauses.erl deleted file mode 100644 index f207178f13..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_clauses.erl +++ /dev/null @@ -1,409 +0,0 @@ -%% ``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 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. -%% -%% The Initial Developer of the Original Code is Richard Carlsson. -%% Copyright (C) 1999-2002 Richard Carlsson. -%% Portions created by Ericsson are Copyright 2001, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id: cerl_clauses.erl,v 1.2 2009/09/17 09:46:19 kostis Exp $ - -%% @doc Utility functions for Core Erlang case/receive clauses. -%% -%% <p>Syntax trees are defined in the module <a -%% href=""><code>cerl</code></a>.</p> -%% -%% @type cerl() = cerl:cerl() - --module(cerl_clauses). - --export([any_catchall/1, eval_guard/1, is_catchall/1, match/2, - match_list/2, reduce/1, reduce/2]). - --import(cerl, [alias_pat/1, alias_var/1, data_arity/1, data_es/1, - data_type/1, clause_guard/1, clause_pats/1, concrete/1, - is_data/1, is_c_var/1, let_body/1, letrec_body/1, - seq_body/1, try_arg/1, type/1, values_es/1]). - --import(lists, [reverse/1]). - - -%% --------------------------------------------------------------------- - -%% @spec is_catchall(Clause::cerl()) -> boolean() -%% -%% @doc Returns <code>true</code> if an abstract clause is a -%% catch-all, otherwise <code>false</code>. A clause is a catch-all if -%% all its patterns are variables, and its guard expression always -%% evaluates to <code>true</code>; cf. <code>eval_guard/1</code>. -%% -%% <p>Note: <code>Clause</code> must have type -%% <code>clause</code>.</p> -%% -%% @see eval_guard/1 -%% @see any_catchall/1 - -is_catchall(C) -> - case all_vars(clause_pats(C)) of - true -> - case eval_guard(clause_guard(C)) of - {value, true} -> - true; - _ -> - false - end; - false -> - false - end. - -all_vars([C | Cs]) -> - case is_c_var(C) of - true -> - all_vars(Cs); - false -> - false - end; -all_vars([]) -> - true. - - -%% @spec any_catchall(Clauses::[cerl()]) -> boolean() -%% -%% @doc Returns <code>true</code> if any of the abstract clauses in -%% the list is a catch-all, otherwise <code>false</code>. See -%% <code>is_catchall/1</code> for details. -%% -%% <p>Note: each node in <code>Clauses</code> must have type -%% <code>clause</code>.</p> -%% -%% @see is_catchall/1 - -any_catchall([C | Cs]) -> - case is_catchall(C) of - true -> - true; - false -> - any_catchall(Cs) - end; -any_catchall([]) -> - false. - - -%% @spec eval_guard(Expr::cerl()) -> none | {value, term()} -%% -%% @doc Tries to reduce a guard expression to a single constant value, -%% if possible. The returned value is <code>{value, Term}</code> if the -%% guard expression <code>Expr</code> always yields the constant value -%% <code>Term</code>, and is otherwise <code>none</code>. -%% -%% <p>Note that although guard expressions should only yield boolean -%% values, this function does not guarantee that <code>Term</code> is -%% either <code>true</code> or <code>false</code>. Also note that only -%% simple constructs like let-expressions are examined recursively; -%% general constant folding is not performed.</p> -%% -%% @see is_catchall/1 - -%% This function could possibly be improved further, but constant -%% folding should in general be performed elsewhere. - -eval_guard(E) -> - case type(E) of - literal -> - {value, concrete(E)}; - values -> - case values_es(E) of - [E1] -> - eval_guard(E1); - _ -> - none - end; - 'try' -> - eval_guard(try_arg(E)); - seq -> - eval_guard(seq_body(E)); - 'let' -> - eval_guard(let_body(E)); - 'letrec' -> - eval_guard(letrec_body(E)); - _ -> - none - end. - - -%% --------------------------------------------------------------------- - -%% @spec reduce(Clauses) -> {true, {Clauses, Bindings}} -%% | {false, Clauses} -%% -%% @equiv reduce(Cs, []) - -reduce(Cs) -> - reduce(Cs, []). - -%% @spec reduce(Clauses::[Clause], Exprs::[Expr]) -> -%% {true, {Clause, Bindings}} -%% | {false, [Clause]} -%% -%% Clause = cerl() -%% Expr = any | cerl() -%% Bindings = [{cerl(), cerl()}] -%% -%% @doc Selects a single clause, if possible, or otherwise reduces the -%% list of selectable clauses. The input is a list <code>Clauses</code> -%% of abstract clauses (i.e., syntax trees of type <code>clause</code>), -%% and a list of switch expressions <code>Exprs</code>. The function -%% tries to uniquely select a single clause or discard unselectable -%% clauses, with respect to the switch expressions. All abstract clauses -%% in the list must have the same number of patterns. If -%% <code>Exprs</code> is not the empty list, it must have the same -%% length as the number of patterns in each clause; see -%% <code>match_list/2</code> for details. -%% -%% <p>A clause can only be selected if its guard expression always -%% yields the atom <code>true</code>, and a clause whose guard -%% expression always yields the atom <code>false</code> can never be -%% selected. Other guard expressions are considered to have unknown -%% value; cf. <code>eval_guard/1</code>.</p> -%% -%% <p>If a particular clause can be selected, the function returns -%% <code>{true, {Clause, Bindings}}</code>, where <code>Clause</code> is -%% the selected clause and <code>Bindings</code> is a list of pairs -%% <code>{Var, SubExpr}</code> associating the variables occurring in -%% the patterns of <code>Clause</code> with the corresponding -%% subexpressions in <code>Exprs</code>. The list of bindings is given -%% in innermost-first order; see the <code>match/2</code> function for -%% details.</p> -%% -%% <p>If no clause could be definitely selected, the function returns -%% <code>{false, NewClauses}</code>, where <code>NewClauses</code> is -%% the list of entries in <code>Clauses</code> that remain after -%% eliminating unselectable clauses, preserving the relative order.</p> -%% -%% @see eval_guard/1 -%% @see match/2 -%% @see match_list/2 - -reduce(Cs, Es) -> - reduce(Cs, Es, []). - -reduce([C | Cs], Es, Cs1) -> - Ps = clause_pats(C), - case match_list(Ps, Es) of - none -> - %% Here, we know that the current clause cannot possibly be - %% selected, so we drop it and visit the rest. - reduce(Cs, Es, Cs1); - {false, _} -> - %% We are not sure if this clause might be selected, so we - %% save it and visit the rest. - reduce(Cs, Es, [C | Cs1]); - {true, Bs} -> - case eval_guard(clause_guard(C)) of - {value, true} when Cs1 == [] -> - %% We have a definite match - we return the residual - %% expression and signal that a selection has been - %% made. All other clauses are dropped. - {true, {C, Bs}}; - {value, true} -> - %% Unless one of the previous clauses is selected, - %% this clause will definitely be, so we can drop - %% the rest. - {false, reverse([C | Cs1])}; - {value, false} -> - %% This clause can never be selected, since its - %% guard is never 'true', so we drop it. - reduce(Cs, Es, Cs1); - _ -> - %% We are not sure if this clause might be selected - %% (or might even cause a crash), so we save it and - %% visit the rest. - reduce(Cs, Es, [C | Cs1]) - end - end; -reduce([], _, Cs) -> - %% All clauses visited, without a complete match. Signal "not - %% reduced" and return the saved clauses, in the correct order. - {false, reverse(Cs)}. - - -%% --------------------------------------------------------------------- - -%% @spec match(Pattern::cerl(), Expr) -> -%% none | {true, Bindings} | {false, Bindings} -%% -%% Expr = any | cerl() -%% Bindings = [{cerl(), Expr}] -%% -%% @doc Matches a pattern against an expression. The returned value is -%% <code>none</code> if a match is impossible, <code>{true, -%% Bindings}</code> if <code>Pattern</code> definitely matches -%% <code>Expr</code>, and <code>{false, Bindings}</code> if a match is -%% not definite, but cannot be excluded. <code>Bindings</code> is then -%% a list of pairs <code>{Var, SubExpr}</code>, associating each -%% variable in the pattern with either the corresponding subexpression -%% of <code>Expr</code>, or with the atom <code>any</code> if no -%% matching subexpression exists. (Recall that variables may not be -%% repeated in a Core Erlang pattern.) The list of bindings is given -%% in innermost-first order; this should only be of interest if -%% <code>Pattern</code> contains one or more alias patterns. If the -%% returned value is <code>{true, []}</code>, it implies that the -%% pattern and the expression are syntactically identical. -%% -%% <p>Instead of a syntax tree, the atom <code>any</code> can be -%% passed for <code>Expr</code> (or, more generally, be used for any -%% subtree of <code>Expr</code>, in as much the abstract syntax tree -%% implementation allows it); this means that it cannot be decided -%% whether the pattern will match or not, and the corresponding -%% variable bindings will all map to <code>any</code>. The typical use -%% is for producing bindings for <code>receive</code> clauses.</p> -%% -%% <p>Note: Binary-syntax patterns are never structurally matched -%% against binary-syntax expressions by this function.</p> -%% -%% <p>Examples: -%% <ul> -%% <li>Matching a pattern "<code>{X, Y}</code>" against the -%% expression "<code>{foo, f(Z)}</code>" yields <code>{true, -%% Bindings}</code> where <code>Bindings</code> associates -%% "<code>X</code>" with the subtree "<code>foo</code>" and -%% "<code>Y</code>" with the subtree "<code>f(Z)</code>".</li> -%% -%% <li>Matching pattern "<code>{X, {bar, Y}}</code>" against -%% expression "<code>{foo, f(Z)}</code>" yields <code>{false, -%% Bindings}</code> where <code>Bindings</code> associates -%% "<code>X</code>" with the subtree "<code>foo</code>" and -%% "<code>Y</code>" with <code>any</code> (because it is not known -%% if "<code>{foo, Y}</code>" might match the run-time value of -%% "<code>f(Z)</code>" or not).</li> -%% -%% <li>Matching pattern "<code>{foo, bar}</code>" against expression -%% "<code>{foo, f()}</code>" yields <code>{false, []}</code>, -%% telling us that there might be a match, but we cannot deduce any -%% bindings.</li> -%% -%% <li>Matching <code>{foo, X = {bar, Y}}</code> against expression -%% "<code>{foo, {bar, baz}}</code>" yields <code>{true, -%% Bindings}</code> where <code>Bindings</code> associates -%% "<code>Y</code>" with "<code>baz</code>", and "<code>X</code>" -%% with "<code>{bar, baz}</code>".</li> -%% -%% <li>Matching a pattern "<code>{X, Y}</code>" against -%% <code>any</code> yields <code>{false, Bindings}</code> where -%% <code>Bindings</code> associates both "<code>X</code>" and -%% "<code>Y</code>" with <code>any</code>.</li> -%% </ul></p> - -match(P, E) -> - match(P, E, []). - -match(P, E, Bs) -> - case type(P) of - var -> - %% Variables always match, since they cannot have repeated - %% occurrences in a pattern. - {true, [{P, E} | Bs]}; - alias -> - %% All variables in P1 will be listed before the alias - %% variable in the result. - match(alias_pat(P), E, [{alias_var(P), E} | Bs]); - binary -> - %% The most we can do is to say "definitely no match" if a - %% binary pattern is matched against non-binary data. - if E == any -> - {false, Bs}; - true -> - case is_data(E) of - true -> - none; - false -> - {false, Bs} - end - end; - _ -> - match_1(P, E, Bs) - end. - -match_1(P, E, Bs) -> - case is_data(P) of - true when E == any -> - %% If we don't know the structure of the value of E at this - %% point, we just match the subpatterns against 'any', and - %% make sure the result is a "maybe". - Ps = data_es(P), - Es = lists:duplicate(length(Ps), any), - case match_list(Ps, Es, Bs) of - {_, Bs1} -> - {false, Bs1}; - none -> - none - end; - true -> - %% Test if the expression represents a constructor - case is_data(E) of - true -> - T1 = {data_type(E), data_arity(E)}, - T2 = {data_type(P), data_arity(P)}, - %% Note that we must test for exact equality. - if T1 =:= T2 -> - match_list(data_es(P), data_es(E), Bs); - true -> - none - end; - false -> - %% We don't know the run-time structure of E, and P - %% is not a variable or an alias pattern, so we - %% match against 'any' instead. - match_1(P, any, Bs) - end; - false -> - %% Strange pattern - give up, but don't say "no match". - {false, Bs} - end. - - -%% @spec match_list(Patterns::[cerl()], Exprs::[Expr]) -> -%% none | {true, Bindings} | {false, Bindings} -%% -%% Expr = any | cerl() -%% Bindings = [{cerl(), cerl()}] -%% -%% @doc Like <code>match/2</code>, but matching a sequence of patterns -%% against a sequence of expressions. Passing an empty list for -%% <code>Exprs</code> is equivalent to passing a list of -%% <code>any</code> atoms of the same length as <code>Patterns</code>. -%% -%% @see match/2 - -match_list([], []) -> - {true, []}; % no patterns always match -match_list(Ps, []) -> - match_list(Ps, lists:duplicate(length(Ps), any), []); -match_list(Ps, Es) -> - match_list(Ps, Es, []). - -match_list([P | Ps], [E | Es], Bs) -> - case match(P, E, Bs) of - {true, Bs1} -> - match_list(Ps, Es, Bs1); - {false, Bs1} -> - %% Make sure "maybe" is preserved - case match_list(Ps, Es, Bs1) of - {_, Bs2} -> - {false, Bs2}; - none -> - none - end; - none -> - none - end; -match_list([], [], Bs) -> - {true, Bs}. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_inline.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_inline.erl deleted file mode 100644 index e040904a19..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_inline.erl +++ /dev/null @@ -1,2762 +0,0 @@ -%% ``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 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. -%% -%% The Initial Developer of the Original Code is Richard Carlsson. -%% Copyright (C) 1999-2002 Richard Carlsson. -%% Portions created by Ericsson are Copyright 2001, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id: cerl_inline.erl,v 1.1 2008/12/17 09:53:41 mikpe Exp $ -%% -%% Core Erlang inliner. - -%% ===================================================================== -%% -%% This is an implementation of the algorithm by Waddell and Dybvig -%% ("Fast and Effective Procedure Inlining", International Static -%% Analysis Symposium 1997), adapted to the Core Erlang language. -%% -%% Instead of always renaming variables and function variables, this -%% implementation uses the "no-shadowing strategy" of Peyton Jones and -%% Marlow ("Secrets of the Glasgow Haskell Compiler Inliner", 1999). -%% -%% ===================================================================== - -%% TODO: inline single-source-reference operands without size limit. - --module(cerl_inline). - --export([core_transform/2, transform/1, transform/2]). - --import(cerl, [abstract/1, alias_pat/1, alias_var/1, apply_args/1, - apply_op/1, atom_name/1, atom_val/1, bitstr_val/1, - bitstr_size/1, bitstr_unit/1, bitstr_type/1, - bitstr_flags/1, binary_segments/1, update_c_alias/3, - update_c_apply/3, update_c_binary/2, update_c_bitstr/6, - update_c_call/4, update_c_case/3, update_c_catch/2, - update_c_clause/4, c_fun/2, c_int/1, c_let/3, - update_c_let/4, update_c_letrec/3, update_c_module/5, - update_c_primop/3, update_c_receive/4, update_c_seq/3, - c_seq/2, update_c_try/6, c_tuple/1, update_c_values/2, - c_values/1, c_var/1, call_args/1, call_module/1, - call_name/1, case_arity/1, case_arg/1, case_clauses/1, - catch_body/1, clause_body/1, clause_guard/1, - clause_pats/1, clause_vars/1, concrete/1, cons_hd/1, - cons_tl/1, data_arity/1, data_es/1, data_type/1, - fun_body/1, fun_vars/1, get_ann/1, int_val/1, - is_c_atom/1, is_c_cons/1, is_c_fun/1, is_c_int/1, - is_c_list/1, is_c_seq/1, is_c_tuple/1, is_c_var/1, - is_data/1, is_literal/1, is_literal_term/1, let_arg/1, - let_body/1, let_vars/1, letrec_body/1, letrec_defs/1, - list_length/1, list_elements/1, update_data/3, - make_list/1, make_data_skel/2, module_attrs/1, - module_defs/1, module_exports/1, module_name/1, - primop_args/1, primop_name/1, receive_action/1, - receive_clauses/1, receive_timeout/1, seq_arg/1, - seq_body/1, set_ann/2, try_arg/1, try_body/1, try_vars/1, - try_evars/1, try_handler/1, tuple_es/1, tuple_arity/1, - type/1, values_es/1, var_name/1]). - --import(lists, [foldl/3, foldr/3, mapfoldl/3, reverse/1]). - -%% -%% Constants -%% - -debug_runtime() -> false. -debug_counters() -> false. - -%% Normal execution times for inlining are between 0.1 and 0.3 seconds -%% (on the author's current equipment). The default effort limit of 150 -%% is high enough that most normal programs never hit the limit even -%% once, and for difficult programs, it generally keeps the execution -%% times below 2-5 seconds. Using an effort counter of 1000 will thus -%% have no further effect on most programs, but some programs may take -%% as much as 10 seconds or more. Effort counts larger than 2500 have -%% never been observed even on very ill-conditioned programs. -%% -%% Size limits between 6 and 18 tend to actually shrink the code, -%% because of the simplifications made possible by inlining. A limit of -%% 16 seems to be optimal for this purpose, often shrinking the -%% executable code by up to 10%. Size limits between 18 and 30 generally -%% give the same code size as if no inlining was done (i.e., code -%% duplication balances out the simplifications at these levels). A size -%% limit between 1 and 5 tends to inline small functions and propagate -%% constants, but does not cause much simplifications do be done, so the -%% net effect will be a slight increase in code size. For size limits -%% above 30, the executable code size tends to increase with about 10% -%% per 100 units, with some variations depending on the sizes of -%% functions in the source code. -%% -%% Typically, about 90% of the maximum speedup achievable is already -%% reached using a size limit of 30, and 98% is reached at limits around -%% 100-150; there is rarely any point in letting the code size increase -%% by more than 10-15%. If too large functions are inlined, cache -%% effects will slow the program down. - -default_effort() -> 150. -default_size() -> 24. - -%% Base costs/weights for different kinds of expressions. If these are -%% modified, the size limits above may have to be adjusted. - -weight(var) -> 0; % We count no cost for variable accesses. -weight(values) -> 0; % Value aggregates have no cost in themselves. -weight(literal) -> 1; % We assume efficient handling of constants. -weight(data) -> 1; % Base cost; add 1 per element. -weight(element) -> 1; % Cost of storing/fetching an element. -weight(argument) -> 1; % Cost of passing a function argument. -weight('fun') -> 6; % Base cost + average number of free vars. -weight('let') -> 0; % Count no cost for let-bindings. -weight(letrec) -> 0; % Like a let-binding. -weight('case') -> 0; % Case switches have no base cost. -weight(clause) -> 1; % Count one jump at the end of each clause body. -weight('receive') -> 9; % Initialization/cleanup cost. -weight('try') -> 1; % Assume efficient implementation. -weight('catch') -> 1; % See `try'. -weight(apply) -> 3; % Average base cost: call/return. -weight(call) -> 3; % Assume remote-calls as efficient as `apply'. -weight(primop) -> 2; % Assume more efficient than `apply'. -weight(binary) -> 4; % Initialisation base cost. -weight(bitstr) -> 3; % Coding/decoding a value; like a primop. -weight(module) -> 1. % Like a letrec with a constant body - -%% These "reference" structures are used for variables and function -%% variables. They keep track of the variable name, any bound operand, -%% and the associated store location. - --record(ref, {name, opnd, loc}). - -%% Operand structures contain the operand expression, the renaming and -%% environment, the state location, and the effort counter at the call -%% site (cf. `visit'). - --record(opnd, {expr, ren, env, loc, effort}). - -%% Since expressions are only visited in `effect' context when they are -%% not bound to a referenced variable, only expressions visited in -%% 'value' context are cached. - --record(cache, {expr, size}). - -%% The context flags for an application structure are kept separate from -%% the structure itself. Note that the original algorithm had exactly -%% one operand in each application context structure, while we can have -%% several, or none. - --record(app, {opnds, ctxt, loc}). - - -%% -%% Interface functions -%% - -%% Use compile option `{core_transform, inline}' to insert this as a -%% compilation pass. - -core_transform(Code, Opts) -> - cerl:to_records(transform(cerl:from_records(Code), Opts)). - -transform(Tree) -> - transform(Tree, []). - -transform(Tree, Opts) -> - main(Tree, value, Opts). - -main(Tree, Ctxt, Opts) -> - %% We spawn a new process to do the work, so we don't have to worry - %% about cluttering the process dictionary with debugging info, or - %% proper deallocation of ets-tables. - Opts1 = Opts ++ [{inline_size, default_size()}, - {inline_effort, default_effort()}], - Reply = self(), - Pid = spawn_link(fun () -> start(Reply, Tree, Ctxt, Opts1) end), - receive - {Pid1, Tree1} when Pid1 == Pid -> - Tree1 - end. - -start(Reply, Tree, Ctxt, Opts) -> - init_debug(), - case debug_runtime() of - true -> - put(inline_start_time, - element(1, erlang:statistics(runtime))); - _ -> - ok - end, - Size = max(1, proplists:get_value(inline_size, Opts)), - Effort = max(1, proplists:get_value(inline_effort, Opts)), - case proplists:get_bool(verbose, Opts) of - true -> - io:fwrite("Inlining: inline_size=~w inline_effort=~w\n", - [Size, Effort]); - false -> - ok - end, - - %% Note that the counters of the new state are passive. - S = st__new(Effort, Size), - -%%% Initialization is not needed at present. Note that the code in -%%% `inline_init' is not up-to-date with this module. -%%% {Tree1, S1} = inline_init:init(Tree, S), -%%% {Tree2, _S2} = i(Tree1, Ctxt, S1), - {Tree2, _S2} = i(Tree, Ctxt, S), - report_debug(), - Reply ! {self(), Tree2}. - -init_debug() -> - case debug_counters() of - true -> - put(counter_effort_triggers, 0), - put(counter_effort_max, 0), - put(counter_size_triggers, 0), - put(counter_size_max, 0); - _ -> - ok - end. - -report_debug() -> - case debug_runtime() of - true -> - {Time, _} = erlang:statistics(runtime), - report("Total run time for inlining: ~.2.0f s.\n", - [(Time - get(inline_start_time))/1000]); - _ -> - ok - end, - case debug_counters() of - true -> - counter_stats(); - _ -> - ok - end. - -counter_stats() -> - T1 = get(counter_effort_triggers), - T2 = get(counter_size_triggers), - E = get(counter_effort_max), - S = get(counter_size_max), - M1 = io_lib:fwrite("\tNumber of triggered " - "effort counters: ~p.\n", [T1]), - M2 = io_lib:fwrite("\tNumber of triggered " - "size counters: ~p.\n", [T2]), - M3 = io_lib:fwrite("\tLargest active effort counter: ~p.\n", - [E]), - M4 = io_lib:fwrite("\tLargest active size counter: ~p.\n", - [S]), - report("Counter statistics:\n~s", [[M1, M2, M3, M4]]). - - -%% ===================================================================== -%% The main inlining function -%% -%% i(E :: coreErlang(), -%% Ctxt :: value | effect | #app{} -%% Ren :: renaming(), -%% Env :: environment(), -%% S :: state()) -%% -> {E', S'} -%% -%% Note: It is expected that the input source code ('E') does not -%% contain free variables. If it does, there is a risk of accidental -%% name capture, in case a generated "new" variable name happens to be -%% the same as the name of a variable that is free further below in the -%% tree; the algorithm only consults the current environment to check if -%% a name already exists. -%% -%% The renaming maps names of source-code variable and function -%% variables to new names as necessary to avoid clashes, according to -%% the "no-shadowing" strategy. The environment maps *residual-code* -%% variables and function variables to operands and global information. -%% Separating the renaming from the environment, and using the -%% residual-code variables instead of the source-code variables as its -%% domain, improves the behaviour of the algorithm when code needs to be -%% traversed more than once. -%% -%% Note that there is no such thing as a `test' context for expressions -%% in (Core) Erlang (see `i_case' below for details). - -i(E, Ctxt, S) -> - i(E, Ctxt, ren__identity(), env__empty(), S). - -i(E, Ctxt, Ren, Env, S0) -> - %% Count one unit of effort on each pass. - S = count_effort(1, S0), - case is_data(E) of - true -> - i_data(E, Ctxt, Ren, Env, S); - false -> - case type(E) of - var -> - i_var(E, Ctxt, Ren, Env, S); - values -> - i_values(E, Ctxt, Ren, Env, S); - 'fun' -> - i_fun(E, Ctxt, Ren, Env, S); - seq -> - i_seq(E, Ctxt, Ren, Env, S); - 'let' -> - i_let(E, Ctxt, Ren, Env, S); - letrec -> - i_letrec(E, Ctxt, Ren, Env, S); - 'case' -> - i_case(E, Ctxt, Ren, Env, S); - 'receive' -> - i_receive(E, Ctxt, Ren, Env, S); - apply -> - i_apply(E, Ctxt, Ren, Env, S); - call -> - i_call(E, Ctxt, Ren, Env, S); - primop -> - i_primop(E, Ren, Env, S); - 'try' -> - i_try(E, Ctxt, Ren, Env, S); - 'catch' -> - i_catch(E, Ctxt, Ren, Env, S); - binary -> - i_binary(E, Ren, Env, S); - module -> - i_module(E, Ctxt, Ren, Env, S) - end - end. - -i_data(E, Ctxt, Ren, Env, S) -> - case is_literal(E) of - true -> - %% This is the `(const c)' case of the original algorithm: - %% literal terms which (regardless of size) do not need to - %% be constructed dynamically at runtime - boldly assuming - %% that the compiler/runtime system can handle this. - case Ctxt of - effect -> - %% Reduce useless constants to a simple value. - {void(), count_size(weight(literal), S)}; - _ -> - %% (In Erlang, we cannot set all non-`false' - %% constants to `true' in a `test' context, like we - %% could do in Lisp or C, so the above is the only - %% special case to be handled here.) - {E, count_size(weight(literal), S)} - end; - false -> - %% Data constructors are like to calls to safe built-in - %% functions, for which we can "decide to inline" - %% immediately; there is no need to create operand - %% structures. In `effect' context, we can simply make a - %% sequence of the argument expressions, also visited in - %% `effect' context. In all other cases, the arguments are - %% visited for value. - case Ctxt of - effect -> - %% Note that this will count the sizes of the - %% subexpressions, even though some or all of them - %% might be discarded by the sequencing afterwards. - {Es1, S1} = mapfoldl(fun (E, S) -> - i(E, effect, Ren, Env, - S) - end, - S, data_es(E)), - E1 = foldl(fun (E1, E2) -> make_seq(E1, E2) end, - void(), Es1), - {E1, S1}; - _ -> - {Es1, S1} = mapfoldl(fun (E, S) -> - i(E, value, Ren, Env, - S) - end, - S, data_es(E)), - %% The total size/cost is the base cost for a data - %% constructor plus the cost for storing each - %% element. - N = weight(data) + length(Es1) * weight(element), - S2 = count_size(N, S1), - {update_data(E, data_type(E), Es1), S2} - end - end. - -%% This is the `(ref x)' (variable use) case of the original algorithm. -%% Note that binding occurrences are always handled in the respective -%% cases of the binding constructs. - -i_var(E, Ctxt, Ren, Env, S) -> - case Ctxt of - effect -> - %% Reduce useless variable references to a simple constant. - %% This also avoids useless visiting of bound operands. - {void(), count_size(weight(literal), S)}; - _ -> - Name = var_name(E), - case env__lookup(ren__map(Name, Ren), Env) of - {ok, R} -> - case R#ref.opnd of - undefined -> - %% The variable is not associated with an - %% argument expression; just residualize it. - residualize_var(R, S); - Opnd -> - i_var_1(R, Opnd, Ctxt, Env, S) - end; - error -> - %% The variable is unbound. (It has not been - %% accidentally captured, however, or it would have - %% been in the environment.) We leave it as it is, - %% without any warning. - {E, count_size(weight(var), S)} - end - end. - -%% This first visits the bound operand and then does copy propagation. -%% Note that we must first set the "inner-pending" flag, and clear the -%% flag afterwards. - -i_var_1(R, Opnd, Ctxt, Env, S) -> - %% If the operand is already "inner-pending", it is residualised. - %% (In Lisp/C, if the variable might be assigned to, it should also - %% be residualised.) - L = Opnd#opnd.loc, - case st__test_inner_pending(L, S) of - true -> - residualize_var(R, S); - false -> - S1 = st__mark_inner_pending(L, S), - case catch {ok, visit(Opnd, S1)} of - {ok, {E, S2}} -> - %% Note that we pass the current environment and - %% context to `copy', but not the current renaming. - S3 = st__clear_inner_pending(L, S2), - copy(R, Opnd, E, Ctxt, Env, S3); - {'EXIT', X} -> - exit(X); - X -> - %% If we use destructive update for the - %% `inner-pending' flag, we must make sure to clear - %% it also if we make a nonlocal return. - st__clear_inner_pending(Opnd#opnd.loc, S1), - throw(X) - end - end. - -%% A multiple-value aggregate `<e1, ..., en>'. This is very much like a -%% tuple data constructor `{e1, ..., en}'; cf. `i_data' for details. - -i_values(E, Ctxt, Ren, Env, S) -> - case values_es(E) of - [E1] -> - %% Single-value aggregates can be dropped; they are simply - %% notation. - i(E1, Ctxt, Ren, Env, S); - Es -> - %% In `effect' context, we can simply make a sequence of the - %% argument expressions, also visited in `effect' context. - %% In all other cases, the arguments are visited for value. - case Ctxt of - effect -> - {Es1, S1} = - mapfoldl(fun (E, S) -> - i(E, effect, Ren, Env, S) - end, - S, Es), - E1 = foldl(fun (E1, E2) -> - make_seq(E1, E2) - end, - void(), Es1), - {E1, S1}; % drop annotations on E - _ -> - {Es1, S1} = mapfoldl(fun (E, S) -> - i(E, value, Ren, Env, - S) - end, - S, Es), - %% Aggregating values does not write them to memory, - %% so we count no extra cost per element. - S2 = count_size(weight(values), S1), - {update_c_values(E, Es1), S2} - end - end. - -%% A let-expression `let <v1,...,vn> = e0 in e1' is semantically -%% equivalent to a case-expression `case e0 of <v1,...,vn> when 'true' -%% -> e1 end'. As a special case, `let <v> = e0 in e1' is also -%% equivalent to `apply fun (v) -> e0 (e1)'. However, for efficiency, -%% and in order to allow the handling of `case' clauses to introduce new -%% let-expressions without entering an infinite rewrite loop, we handle -%% these directly. - -%%% %% Rewriting a `let' to an equivalent expression. -%%% i_let(E, Ctxt, Ren, Env, S) -> -%%% case let_vars(E) of -%%% [V] -> -%%% E1 = update_c_apply(E, c_fun([V], let_body(E)), [let_arg(E)]), -%%% i(E1, Ctxt, Ren, Env, S); -%%% Vs -> -%%% C = c_clause(Vs, abstract(true), let_body(E)), -%%% E1 = update_c_case(E, let_arg(E), [C]), -%%% i(E1, Ctxt, Ren, Env, S) -%%% end. - -i_let(E, Ctxt, Ren, Env, S) -> - case let_vars(E) of - [V] -> - i_let_1(V, E, Ctxt, Ren, Env, S); - Vs -> - %% Visit the argument expression in `value' context, to - %% simplify it as far as possible. - {A, S1} = i(let_arg(E), value, Ren, Env, S), - case get_components(length(Vs), result(A)) of - {true, As} -> - %% Note that only the components of the result of - %% `A' are passed on; any effects are hoisted. - {E1, S2} = i_let_2(Vs, As, E, Ctxt, Ren, Env, S1), - {hoist_effects(A, E1), S2}; - false -> - %% We cannot do anything with this `let', since the - %% variables cannot be matched against the argument - %% components. Just visit the variables for renaming - %% and visit the body for value (cf. `i_fun'). - {_, Ren1, Env1, S2} = bind_locals(Vs, Ren, Env, S1), - Vs1 = i_params(Vs, Ren1, Env1), - %% The body is always visited for value here. - {B, S3} = i(let_body(E), value, Ren1, Env1, S2), - S4 = count_size(weight('let'), S3), - {update_c_let(E, Vs1, A, B), S4} - end - end. - -%% Single-variable `let' binding. - -i_let_1(V, E, Ctxt, Ren, Env, S) -> - %% Make an operand structure for the argument expression, create a - %% local binding from the parameter to the operand structure, and - %% visit the body. Finally create necessary bindings and/or set - %% flags. - {Opnd, S1} = make_opnd(let_arg(E), Ren, Env, S), - {[R], Ren1, Env1, S2} = bind_locals([V], [Opnd], Ren, Env, S1), - {E1, S3} = i(let_body(E), Ctxt, Ren1, Env1, S2), - i_let_3([R], [Opnd], E1, S3). - -%% Multi-variable `let' binding. - -i_let_2(Vs, As, E, Ctxt, Ren, Env, S) -> - %% Make operand structures for the argument components. Note that - %% since the argument has already been visited at this point, we use - %% the identity renaming for the operands. - {Opnds, S1} = mapfoldl(fun (E, S) -> - make_opnd(E, ren__identity(), Env, S) - end, - S, As), - %% Create local bindings from the parameters to their respective - %% operand structures, and visit the body. - {Rs, Ren1, Env1, S2} = bind_locals(Vs, Opnds, Ren, Env, S1), - {E1, S3} = i(let_body(E), Ctxt, Ren1, Env1, S2), - i_let_3(Rs, Opnds, E1, S3). - -i_let_3(Rs, Opnds, E, S) -> - %% Create necessary bindings and/or set flags. - {E1, S1} = make_let_bindings(Rs, E, S), - - %% We must also create evaluation for effect, for any unused - %% operands, as after an application expression. - residualize_operands(Opnds, E1, S1). - -%% A sequence `do e1 e2', written `(seq e1 e2)' in the original -%% algorithm, where `e1' is evaluated for effect only (since its value -%% is not used), and `e2' yields the final value. Note that we use -%% `make_seq' to recompose the sequence after visiting the parts. - -i_seq(E, Ctxt, Ren, Env, S) -> - {E1, S1} = i(seq_arg(E), effect, Ren, Env, S), - {E2, S2} = i(seq_body(E), Ctxt, Ren, Env, S1), - %% A sequence has no cost in itself. - {make_seq(E1, E2), S2}. - - -%% The `case' switch of Core Erlang is rather different from the boolean -%% `(if e1 e2 e3)' case of the original algorithm, but the central idea -%% is the same: if, given the simplified switch expression (which is -%% visited in `value' context - a boolean `test' context would not be -%% generally useful), there is a clause which could definitely be -%% selected, such that no clause before it can possibly be selected, -%% then we can eliminate all other clauses. (And even if this is not the -%% case, some clauses can often be eliminated.) Furthermore, if a clause -%% can be selected, we can replace the case-expression (including the -%% switch expression) with the body of the clause and a set of zero or -%% more let-bindings of subexpressions of the switch expression. (In the -%% simplest case, the switch expression is evaluated only for effect.) - -i_case(E, Ctxt, Ren, Env, S) -> - %% First visit the switch expression in `value' context, to simplify - %% it as far as possible. Note that only the result part is passed - %% on to the clause matching below; any effects are hoisted. - {A, S1} = i(case_arg(E), value, Ren, Env, S), - A1 = result(A), - - %% Propagating an application context into the branches could cause - %% the arguments of the application to be evaluated *after* the - %% switch expression, but *before* the body of the selected clause. - %% Such interleaving is not allowed in general, and it does not seem - %% worthwile to make a more powerful transformation here. Therefore, - %% the clause bodies are conservatively visited for value if the - %% context is `application'. - Ctxt1 = safe_context(Ctxt), - {E1, S2} = case get_components(case_arity(E), A1) of - {true, As} -> - i_case_1(As, E, Ctxt1, Ren, Env, S1); - false -> - i_case_1([], E, Ctxt1, Ren, Env, S1) - end, - {hoist_effects(A, E1), S2}. - -i_case_1(As, E, Ctxt, Ren, Env, S) -> - case i_clauses(As, case_clauses(E), Ctxt, Ren, Env, S) of - {false, {As1, Vs, Env1, Cs}, S1} -> - %% We still have a list of clauses. Sanity check: - if Cs == [] -> - report_warning("empty list of clauses " - "in residual program!.\n"); - true -> - ok - end, - {A, S2} = i(c_values(As1), value, ren__identity(), Env1, - S1), - {E1, S3} = i_case_2(Cs, A, E, S2), - i_case_3(Vs, Env1, E1, S3); - {true, {_, Vs, Env1, [C]}, S1} -> - %% A single clause was selected; we just take the body. - i_case_3(Vs, Env1, clause_body(C), S1) - end. - -%% Check if all clause bodies are actually equivalent expressions that -%% do not depent on pattern variables (this sometimes occurs as a -%% consequence of inlining, e.g., all branches might yield 'true'), and -%% if so, replace the `case' with a sequence, first evaluating the -%% clause selection for effect, then evaluating one of the clause bodies -%% for its value. (Unless the switch contains a catch-all clause, the -%% clause selection must be evaluated for effect, since there is no -%% guarantee that any of the clauses will actually match. Assuming that -%% some clause always matches could make an undefined program produce a -%% value.) This makes the final size less than what was accounted for -%% when visiting the clauses, but currently we don't try to adjust for -%% this. - -i_case_2(Cs, A, E, S) -> - case equivalent_clauses(Cs) of - false -> - %% Count the base sizes for the remaining clauses; pattern - %% and guard sizes are already counted. - N = weight('case') + weight(clause) * length(Cs), - S1 = count_size(N, S), - {update_c_case(E, A, Cs), S1}; - true -> - case cerl_clauses:any_catchall(Cs) of - true -> - %% We know that some clause must be selected, so we - %% can drop all the testing as well. - E1 = make_seq(A, clause_body(hd(Cs))), - {E1, S}; - false -> - %% The clause selection must be performed for - %% effect. - E1 = update_c_case(E, A, - set_clause_bodies(Cs, void())), - {make_seq(E1, clause_body(hd(Cs))), S} - end - end. - -i_case_3(Vs, Env, E, S) -> - %% For the variables bound to the switch expression subexpressions, - %% make let bindings or create evaluation for effect. - Rs = [env__get(var_name(V), Env) || V <- Vs], - {E1, S1} = make_let_bindings(Rs, E, S), - Opnds = [R#ref.opnd || R <- Rs], - residualize_operands(Opnds, E1, S1). - -%% This function takes a sequence of switch expressions `Es' (which can -%% be the empty list if these are unknown) and a list `Cs' of clauses, -%% and returns `{Match, {As, Vs, Env1, Cs1}, S1}' where `As' is a list -%% of residual switch expressions, `Vs' the list of variables used in -%% the templates, `Env1' the environment for the templates, and `Cs1' -%% the list of residual clauses. `Match' is `true' if some clause could -%% be shown to definitely match (in this case, `Cs1' contains exactly -%% one element), and `false' otherwise. `S1' is the new state. The given -%% `Ctxt' is the context to be used for visiting the body of clauses. -%% -%% Visiting a clause basically amounts to extending the environment for -%% all variables in the pattern, as for a `fun' (cf. `i_fun'), -%% propagating match information if possible, and visiting the guard and -%% body in the new environment. -%% -%% To make it cheaper to do handle a set of clauses, and to avoid -%% unnecessarily exceeding the size limit, we avoid visiting the bodies -%% of clauses which are subsequently removed, by dividing the visiting -%% of a clause into two stages: first construct the environment(s) and -%% visit the pattern (for renaming) and the guard (for value), then -%% reduce the switch as much as possible, and lastly visit the body. - -i_clauses(Cs, Ctxt, Ren, Env, S) -> - i_clauses([], Cs, Ctxt, Ren, Env, S). - -i_clauses(Es, Cs, Ctxt, Ren, Env, S) -> - %% Create templates for the switch expressions. - {Ts, {Vs, Env0}} = mapfoldl(fun (E, {Vs, Env}) -> - {T, Vs1, Env1} = - make_template(E, Env), - {T, {Vs1 ++ Vs, Env1}} - end, - {[], Env}, Es), - - %% Make operand structures for the switch subexpression templates - %% (found in `Env0') and add proper ref-structure bindings to the - %% environment. Since the subexpressions in general can be - %% interdependent (Vs is in reverse-dependency order), the - %% environment (and renaming) must be created incrementally. Note - %% that since the switch expressions have been visited already, the - %% identity renaming is used for the operands. - Vs1 = lists:reverse(Vs), - {Ren1, Env1, S1} = - foldl(fun (V, {Ren, Env, S}) -> - E = env__get(var_name(V), Env0), - {Opnd, S_1} = make_opnd(E, ren__identity(), Env, - S), - {_, Ren1, Env1, S_2} = bind_locals([V], [Opnd], - Ren, Env, S_1), - {Ren1, Env1, S_2} - end, - {Ren, Env, S}, Vs1), - - %% First we visit the head of each individual clause, renaming - %% pattern variables, inserting let-bindings in the guard and body, - %% and visiting the guard. The information used for visiting the - %% clause body will be prefixed to the clause annotations. - {Cs1, S2} = mapfoldl(fun (C, S) -> - i_clause_head(C, Ts, Ren1, Env1, S) - end, - S1, Cs), - - %% Now that the clause guards have been reduced as far as possible, - %% we can attempt to reduce the clauses. - As = [hd(get_ann(T)) || T <- Ts], - case cerl_clauses:reduce(Cs1, Ts) of - {false, Cs2} -> - %% We still have one or more clauses (with associated - %% extended environments). Their bodies have not yet been - %% visited, so we do that (in the respective safe - %% environments, adding the sizes of the visited heads to - %% the current size counter) and return the final list of - %% clauses. - {Cs3, S3} = mapfoldl( - fun (C, S) -> - i_clause_body(C, Ctxt, S) - end, - S2, Cs2), - {false, {As, Vs1, Env1, Cs3}, S3}; - {true, {C, _}} -> - %% A clause C could be selected (the bindings have already - %% been added to the guard/body). Note that since the clause - %% head will probably be discarded, its size is not counted. - {C1, Ren2, Env2, _} = get_clause_extras(C), - {B, S3} = i(clause_body(C), Ctxt, Ren2, Env2, S2), - C2 = update_c_clause(C1, clause_pats(C1), clause_guard(C1), B), - {true, {As, Vs1, Env1, [C2]}, S3} - end. - -%% This visits the head of a clause, renames pattern variables, inserts -%% let-bindings in the guard and body, and does inlining on the guard -%% expression. Returns a list of pairs `{NewClause, Data}', where `Data' -%% is `{Renaming, Environment, Size}' used for visiting the body of the -%% new clause. - -i_clause_head(C, Ts, Ren, Env, S) -> - %% Match the templates against the (non-renamed) patterns to get the - %% available information about matching subexpressions. We don't - %% care at this point whether an exact match/nomatch is detected. - Ps = clause_pats(C), - Bs = case cerl_clauses:match_list(Ps, Ts) of - {_, Bs1} -> Bs1; - none -> [] - end, - - %% The patterns must be visited for renaming; cf. `i_pattern'. We - %% use a passive size counter for visiting the patterns and the - %% guard (cf. `visit'), because we do not know at this stage whether - %% the clause will be kept or not; the final value of the counter is - %% included in the returned value below. - {_, Ren1, Env1, S1} = bind_locals(clause_vars(C), Ren, Env, S), - S2 = new_passive_size(get_size_limit(S1), S1), - {Ps1, S3} = mapfoldl(fun (P, S) -> - i_pattern(P, Ren1, Env1, Ren, Env, S) - end, - S2, Ps), - - %% Rewrite guard and body and visit the guard for value. Discard the - %% latter size count if the guard turns out to be a constant. - G = add_match_bindings(Bs, clause_guard(C)), - B = add_match_bindings(Bs, clause_body(C)), - {G1, S4} = i(G, value, Ren1, Env1, S3), - S5 = case is_literal(G1) of - true -> - revert_size(S3, S4); - false -> - S4 - end, - - %% Revert to the size counter we had on entry to this function. The - %% environment and renaming, together with the size of the clause - %% head, are prefixed to the annotations for later use. - Size = get_size_value(S5), - C1 = update_c_clause(C, Ps1, G1, B), - {set_clause_extras(C1, Ren1, Env1, Size), revert_size(S, S5)}. - -add_match_bindings(Bs, E) -> - %% Don't waste time if the variables definitely cannot be used. - %% (Most guards are simply `true'.) - case is_literal(E) of - true -> - E; - false -> - Vs = [V || {V, E} <- Bs, E /= any], - Es = [hd(get_ann(E)) || {_V, E} <- Bs, E /= any], - c_let(Vs, c_values(Es), E) - end. - -i_clause_body(C0, Ctxt, S) -> - {C, Ren, Env, Size} = get_clause_extras(C0), - S1 = count_size(Size, S), - {B, S2} = i(clause_body(C), Ctxt, Ren, Env, S1), - C1 = update_c_clause(C, clause_pats(C), clause_guard(C), B), - {C1, S2}. - -get_clause_extras(C) -> - [{Ren, Env, Size} | As] = get_ann(C), - {set_ann(C, As), Ren, Env, Size}. - -set_clause_extras(C, Ren, Env, Size) -> - As = [{Ren, Env, Size} | get_ann(C)], - set_ann(C, As). - -%% This is the `(lambda x e)' case of the original algorithm. A -%% `fun' is like a lambda expression, but with a varying number of -%% parameters; possibly zero. - -i_fun(E, Ctxt, Ren, Env, S) -> - case Ctxt of - effect -> - %% Reduce useless `fun' expressions to a simple constant; - %% visiting the body would be a waste of time, and could - %% needlessly mark variables as referenced. - {void(), count_size(weight(literal), S)}; - value -> - %% Note that the variables are visited as patterns. - Vs = fun_vars(E), - {_, Ren1, Env1, S1} = bind_locals(Vs, Ren, Env, S), - Vs1 = i_params(Vs, Ren1, Env1), - - %% The body is always visited for value. - {B, S2} = i(fun_body(E), value, Ren1, Env1, S1), - - %% We don't bother to include the exact number of free - %% variables in the cost for creating a fun-value. - S3 = count_size(weight('fun'), S2), - - %% Inlining might have duplicated code, so we must remove - %% any 'id'-annotations from the original fun-expression. - %% (This forces a later stage to invent new id:s.) This is - %% necessary as long as fun:s may still need to be - %% identified the old way. Function variables that are not - %% in application context also have such annotations, but - %% the inlining will currently lose all annotations on - %% variable references (I think), so that's not a problem. - {set_ann(c_fun(Vs1, B), kill_id_anns(get_ann(E))), S3}; - #app{} -> - %% An application of a fun-expression (in the source code) - %% is handled by going directly to `inline'; this is never - %% residualised, and we don't set up new counters here. Note - %% that inlining of copy-propagated fun-expressions is done - %% in `copy'; not here. - inline(E, Ctxt, Ren, Env, S) - end. - -%% A `letrec' requires a circular environment, but is otherwise like a -%% `let', i.e. like a direct lambda application. Note that only -%% fun-expressions (lambda abstractions) may occur in the right-hand -%% side of each definition. - -i_letrec(E, Ctxt, Ren, Env, S) -> - %% Note that we pass an empty list for the auto-referenced - %% (exported) functions here. - {Es, B, _, S1} = i_letrec(letrec_defs(E), letrec_body(E), [], Ctxt, - Ren, Env, S), - - %% If no bindings remain, only the body is returned. - case Es of - [] -> - {B, S1}; % drop annotations on E - _ -> - S2 = count_size(weight(letrec), S1), - {update_c_letrec(E, Es, B), S2} - end. - -%% The major part of this is shared by letrec-expressions and module -%% definitions alike. - -i_letrec(Es, B, Xs, Ctxt, Ren, Env, S) -> - %% First, we create operands with dummy renamings and environments, - %% and with fresh store locations for cached expressions and operand - %% info. - {Opnds, S1} = mapfoldl(fun ({_, E}, S) -> - make_opnd(E, undefined, undefined, S) - end, - S, Es), - - %% Then we make recursive bindings for the definitions. - {Rs, Ren1, Env1, S2} = bind_recursive([F || {F, _} <- Es], - Opnds, Ren, Env, S1), - - %% For the function variables listed in Xs (none for a - %% letrec-expression), we must make sure that the corresponding - %% operand expressions are visited and that the definitions are - %% marked as referenced; we also need to return the possibly renamed - %% function variables. - {Xs1, S3} = - mapfoldl( - fun (X, S) -> - Name = ren__map(var_name(X), Ren1), - case env__lookup(Name, Env1) of - {ok, R} -> - S_1 = i_letrec_export(R, S), - {ref_to_var(R), S_1}; - error -> - %% We just skip any exports that are not - %% actually defined here, and generate a - %% warning message. - {N, A} = var_name(X), - report_warning("export `~w'/~w " - "not defined.\n", [N, A]), - {X, S} - end - end, - S2, Xs), - - %% At last, we can then visit the body. - {B1, S4} = i(B, Ctxt, Ren1, Env1, S3), - - %% Finally, we create new letrec-bindings for any and all - %% residualised definitions. All referenced functions should have - %% been visited; the call to `visit' below is expected to retreive a - %% cached expression. - Rs1 = keep_referenced(Rs, S4), - {Es1, S5} = mapfoldl(fun (R, S) -> - {E_1, S_1} = visit(R#ref.opnd, S), - {{ref_to_var(R), E_1}, S_1} - end, - S4, Rs1), - {Es1, B1, Xs1, S5}. - -%% This visits the operand for a function definition exported by a -%% `letrec' (which is really a `module' module definition, since normal -%% letrecs have no export declarations). Only the updated state is -%% returned. We must handle the "inner-pending" flag when doing this; -%% cf. `i_var'. - -i_letrec_export(R, S) -> - Opnd = R#ref.opnd, - S1 = st__mark_inner_pending(Opnd#opnd.loc, S), - {_, S2} = visit(Opnd, S1), - {_, S3} = residualize_var(R, st__clear_inner_pending(Opnd#opnd.loc, - S2)), - S3. - -%% This is the `(call e1 e2)' case of the original algorithm. The only -%% difference is that we must handle multiple (or no) operand -%% expressions. - -i_apply(E, Ctxt, Ren, Env, S) -> - {Opnds, S1} = mapfoldl(fun (E, S) -> - make_opnd(E, Ren, Env, S) - end, - S, apply_args(E)), - - %% Allocate a new app-context location and set up an application - %% context structure containing the surrounding context. - {L, S2} = st__new_app_loc(S1), - Ctxt1 = #app{opnds = Opnds, ctxt = Ctxt, loc = L}, - - %% Visit the operator expression in the new call context. - {E1, S3} = i(apply_op(E), Ctxt1, Ren, Env, S2), - - %% Check the "inlined" flag to find out what to do next. (The store - %% location could be recycled after the flag has been tested, but - %% there is no real advantage to that, because in practice, only - %% 4-5% of all created store locations will ever be reused, while - %% there will be a noticable overhead for managing the free list.) - case st__get_app_inlined(L, S3) of - true -> - %% The application was inlined, so we have the final - %% expression in `E1'. We just have to handle any operands - %% that need to be residualized for effect only (i.e., those - %% the values of which are not used). - residualize_operands(Opnds, E1, S3); - false -> - %% Otherwise, `E1' is the residual operator expression. We - %% make sure all operands are visited, and rebuild the - %% application. - {Es, S4} = mapfoldl(fun (Opnd, S) -> - visit_and_count_size(Opnd, S) - end, - S3, Opnds), - N = apply_size(length(Es)), - {update_c_apply(E, E1, Es), count_size(N, S4)} - end. - -apply_size(A) -> - weight(apply) + weight(argument) * A. - -%% Since it is not the task of this transformation to handle -%% cross-module inlining, all inter-module calls are handled by visiting -%% the components (the module and function name, and the arguments of -%% the call) for value. In `effect' context, if the function itself is -%% known to be completely effect free, the call can be discarded and the -%% arguments evaluated for effect. Otherwise, if all the visited -%% arguments are to constants, and the function is known to be safe to -%% execute at compile time, then we try to evaluate the call. If -%% evaluation completes normally, the call is replaced by the result; -%% otherwise the call is residualised. - -i_call(E, Ctxt, Ren, Env, S) -> - {M, S1} = i(call_module(E), value, Ren, Env, S), - {F, S2} = i(call_name(E), value, Ren, Env, S1), - As = call_args(E), - Arity = length(As), - - %% Check if the name of the called function is static. If so, - %% discard the size counts performed above, since the values will - %% not cause any runtime cost. - Static = is_c_atom(M) and is_c_atom(F), - S3 = case Static of - true -> - revert_size(S, S2); - false -> - S2 - end, - case Ctxt of - effect when Static == true -> - case is_safe_call(atom_val(M), atom_val(F), Arity) of - true -> - %% The result will not be used, and the call is - %% effect free, so we create a multiple-value - %% aggregate containing the (not yet visited) - %% arguments and process that instead. - i(c_values(As), effect, Ren, Env, S3); - false -> - %% We are not allowed to simply discard the call, - %% but we can try to evaluate it. - i_call_1(Static, M, F, Arity, As, E, Ctxt, Ren, Env, - S3) - end; - _ -> - i_call_1(Static, M, F, Arity, As, E, Ctxt, Ren, Env, S3) - end. - -i_call_1(Static, M, F, Arity, As, E, Ctxt, Ren, Env, S) -> - %% Visit the arguments for value. - {As1, S1} = mapfoldl(fun (X, A) -> i(X, value, Ren, Env, A) end, - S, As), - case Static of - true -> - case erl_bifs:is_pure(atom_val(M), atom_val(F), Arity) of - true -> - %% It is allowed to evaluate this at compile time. - case all_static(As1) of - true -> - i_call_3(M, F, As1, E, Ctxt, Env, S1); - false -> - %% See if the call can be rewritten instead. - i_call_4(M, F, As1, E, Ctxt, Env, S1) - end; - false -> - i_call_2(M, F, As1, E, S1) - end; - false -> - i_call_2(M, F, As1, E, S1) - end. - -%% Residualise the call. - -i_call_2(M, F, As, E, S) -> - N = weight(call) + weight(argument) * length(As), - {update_c_call(E, M, F, As), count_size(N, S)}. - -%% Attempt to evaluate the call to yield a literal; if that fails, try -%% to rewrite the expression. - -i_call_3(M, F, As, E, Ctxt, Env, S) -> - %% Note that we extract the results of argument expessions here; the - %% expressions could still be sequences with side effects. - Vs = [concrete(result(A)) || A <- As], - case catch {ok, apply(atom_val(M), atom_val(F), Vs)} of - {ok, V} -> - %% Evaluation completed normally - try to turn the result - %% back into a syntax tree (representing a literal). - case is_literal_term(V) of - true -> - %% Make a sequence of the arguments (as a - %% multiple-value aggregate) and the final value. - S1 = count_size(weight(values), S), - S2 = count_size(weight(literal), S1), - {make_seq(c_values(As), abstract(V)), S2}; - false -> - %% The result could not be represented as a literal. - i_call_4(M, F, As, E, Ctxt, Env, S) - end; - _ -> - %% The evaluation attempt did not complete normally. - i_call_4(M, F, As, E, Ctxt, Env, S) - end. - -%% Rewrite the expression, if possible, otherwise residualise it. - -i_call_4(M, F, As, E, Ctxt, Env, S) -> - case reduce_bif_call(atom_val(M), atom_val(F), As, Env) of - false -> - %% Nothing more to be done - residualise the call. - i_call_2(M, F, As, E, S); - {true, E1} -> - %% We revisit the result, because the rewriting might have - %% opened possibilities for further inlining. Since the - %% parts have already been visited once, we use the identity - %% renaming here. - i(E1, Ctxt, ren__identity(), Env, S) - end. - -%% For now, we assume that primops cannot be evaluated at compile time, -%% probably being too special. Also, we have no knowledge about their -%% side effects. - -i_primop(E, Ren, Env, S) -> - %% Visit the arguments for value. - {As, S1} = mapfoldl(fun (E, S) -> - i(E, value, Ren, Env, S) - end, - S, primop_args(E)), - N = weight(primop) + weight(argument) * length(As), - {update_c_primop(E, primop_name(E), As), count_size(N, S1)}. - -%% This is like having an expression with an extra fun-expression -%% attached for "exceptional cases"; actually, there are exactly two -%% parameter variables for the body, but they are easiest handled as if -%% their number might vary, just as for a `fun'. - -i_try(E, Ctxt, Ren, Env, S) -> - %% The argument expression is evaluated in `value' context, and the - %% surrounding context is propagated into both branches. We do not - %% try to recognize cases when the protected expression will - %% actually raise an exception. Note that the variables are visited - %% as patterns. - {A, S1} = i(try_arg(E), value, Ren, Env, S), - Vs = try_vars(E), - {_, Ren1, Env1, S2} = bind_locals(Vs, Ren, Env, S1), - Vs1 = i_params(Vs, Ren1, Env1), - {B, S3} = i(try_body(E), Ctxt, Ren1, Env1, S2), - case is_safe(A) of - true -> - %% The `try' wrapper can be dropped in this case. Since the - %% expressions have been visited already, the identity - %% renaming is used when we revisit the new let-expression. - i(c_let(Vs1, A, B), Ctxt, ren__identity(), Env, S3); - false -> - Evs = try_evars(E), - {_, Ren2, Env2, S4} = bind_locals(Evs, Ren, Env, S3), - Evs1 = i_params(Evs, Ren2, Env2), - {H, S5} = i(try_handler(E), Ctxt, Ren2, Env2, S4), - S6 = count_size(weight('try'), S5), - {update_c_try(E, A, Vs1, B, Evs1, H), S6} - end. - -%% A special case of try-expressions: - -i_catch(E, Ctxt, Ren, Env, S) -> - %% We cannot propagate application contexts into the catch. - {E1, S1} = i(catch_body(E), safe_context(Ctxt), Ren, Env, S), - case is_safe(E1) of - true -> - %% The `catch' wrapper can be dropped in this case. - {E1, S1}; - false -> - S2 = count_size(weight('catch'), S1), - {update_c_catch(E, E1), S2} - end. - -%% A receive-expression is very much like a case-expression, with the -%% difference that we do not have access to a switch expression, since -%% the value being switched on is taken from the mailbox. The fact that -%% the receive-expression may iterate over an arbitrary number of -%% messages is not of interest to us. All we can do here is to visit its -%% subexpressions, and possibly eliminate definitely unselectable -%% clauses. - -i_receive(E, Ctxt, Ren, Env, S) -> - %% We first visit the expiry expression (for value) and the expiry - %% body (in the surrounding context). - {T, S1} = i(receive_timeout(E), value, Ren, Env, S), - {B, S2} = i(receive_action(E), Ctxt, Ren, Env, S1), - - %% Then we visit the clauses. Note that application contexts may not - %% in general be propagated into the branches (and the expiry body), - %% because the execution of the `receive' may remove a message from - %% the mailbox as a side effect; the situation is thus analogous to - %% that in a `case' expression. - Ctxt1 = safe_context(Ctxt), - case i_clauses(receive_clauses(E), Ctxt1, Ren, Env, S2) of - {false, {[], _, _, Cs}, S3} -> - %% We still have a list of clauses. If the list is empty, - %% and the expiry expression is the integer zero, the - %% expression reduces to the expiry body. - if Cs == [] -> - case is_c_int(T) andalso (int_val(T) == 0) of - true -> - {B, S3}; - false -> - i_receive_1(E, Cs, T, B, S3) - end; - true -> - i_receive_1(E, Cs, T, B, S3) - end; - {true, {_, _, _, Cs}, S3} -> - %% Cs is a single clause that will always be matched (if a - %% message exists), but we must keep the `receive' statement - %% in order to fetch the message from the mailbox. - i_receive_1(E, Cs, T, B, S3) - end. - -i_receive_1(E, Cs, T, B, S) -> - %% Here, we just add the base sizes for the receive-expression - %% itself and for each remaining clause; cf. `case'. - N = weight('receive') + weight(clause) * length(Cs), - {update_c_receive(E, Cs, T, B), count_size(N, S)}. - -%% A module definition is like a `letrec', with some add-ons (export and -%% attribute declarations) but without an explicit body. Actually, the -%% exporting of function names has the same effect as if there was a -%% body consisting of the list of references to the exported functions. -%% Thus, the exported functions are exactly those which can be -%% referenced from outside the module. - -i_module(E, Ctxt, Ren, Env, S) -> - %% Cf. `i_letrec'. Note that we pass a dummy constant value for the - %% "body" parameter. - {Es, _, Xs1, S1} = i_letrec(module_defs(E), void(), - module_exports(E), Ctxt, Ren, Env, S), - %% Sanity check: - case Es of - [] -> - report_warning("no function definitions remaining " - "in module `~s'.\n", - [atom_name(module_name(E))]); - _ -> - ok - end, - E1 = update_c_module(E, module_name(E), Xs1, module_attrs(E), Es), - {E1, count_size(weight(module), S1)}. - -%% Binary-syntax expressions are too complicated to do anything -%% interesting with here - that is beyond the scope of this program; -%% also, their construction could have side effects, so even in effect -%% context we can't remove them. (We don't bother to identify cases of -%% "safe" unused binaries which could be removed.) - -i_binary(E, Ren, Env, S) -> - %% Visit the segments for value. - {Es, S1} = mapfoldl(fun (E, S) -> - i_bitstr(E, Ren, Env, S) - end, - S, binary_segments(E)), - S2 = count_size(weight(binary), S1), - {update_c_binary(E, Es), S2}. - -i_bitstr(E, Ren, Env, S) -> - %% It is not necessary to visit the Unit, Type and Flags fields, - %% since these are always literals. - {Val, S1} = i(bitstr_val(E), value, Ren, Env, S), - {Size, S2} = i(bitstr_size(E), value, Ren, Env, S1), - Unit = bitstr_unit(E), - Type = bitstr_type(E), - Flags = bitstr_flags(E), - S3 = count_size(weight(bitstr), S2), - {update_c_bitstr(E, Val, Size, Unit, Type, Flags), S3}. - -%% This is a simplified version of `i_pattern', for lists of parameter -%% variables only. It does not modify the state. - -i_params([V | Vs], Ren, Env) -> - Name = ren__map(var_name(V), Ren), - case env__lookup(Name, Env) of - {ok, R} -> - [ref_to_var(R) | i_params(Vs, Ren, Env)]; - error -> - report_internal_error("variable `~w' not bound " - "in pattern.\n", [Name]), - exit(error) - end; -i_params([], _, _) -> - []. - -%% For ordinary patterns, we just visit to rename variables and count -%% the size/cost. All occurring binding instances of variables should -%% already have been added to the renaming and environment; however, to -%% handle the size expressions of binary-syntax patterns, we must pass -%% the renaming and environment of the containing expression - -i_pattern(E, Ren, Env, Ren0, Env0, S) -> - case type(E) of - var -> - %% Count no size. - Name = ren__map(var_name(E), Ren), - case env__lookup(Name, Env) of - {ok, R} -> - {ref_to_var(R), S}; - error -> - report_internal_error("variable `~w' not bound " - "in pattern.\n", [Name]), - exit(error) - end; - alias -> - %% Count no size. - V = alias_var(E), - Name = ren__map(var_name(V), Ren), - case env__lookup(Name, Env) of - {ok, R} -> - %% Visit the subpattern and recompose. - V1 = ref_to_var(R), - {P, S1} = i_pattern(alias_pat(E), Ren, Env, Ren0, - Env0, S), - {update_c_alias(E, V1, P), S1}; - error -> - report_internal_error("variable `~w' not bound " - "in pattern.\n", [Name]), - exit(error) - end; - binary -> - {Es, S1} = mapfoldl(fun (E, S) -> - i_bitstr_pattern(E, Ren, Env, - Ren0, Env0, S) - end, - S, binary_segments(E)), - S2 = count_size(weight(binary), S1), - {update_c_binary(E, Es), S2}; - _ -> - case is_literal(E) of - true -> - {E, count_size(weight(literal), S)}; - false -> - {Es1, S1} = mapfoldl(fun (E, S) -> - i_pattern(E, Ren, Env, - Ren0, Env0, - S) - end, - S, data_es(E)), - %% We assume that in general, the elements of the - %% constructor will all be fetched. - N = weight(data) + length(Es1) * weight(element), - S2 = count_size(N, S1), - {update_data(E, data_type(E), Es1), S2} - end - end. - -i_bitstr_pattern(E, Ren, Env, Ren0, Env0, S) -> - %% It is not necessary to visit the Unit, Type and Flags fields, - %% since these are always literals. The Value field is a limited - %% pattern - either a literal or an unbound variable. The Size field - %% is a limited expression - either a literal or a variable bound in - %% the environment of the containing expression. - {Val, S1} = i_pattern(bitstr_val(E), Ren, Env, Ren0, Env0, S), - {Size, S2} = i(bitstr_size(E), value, Ren0, Env0, S1), - Unit = bitstr_unit(E), - Type = bitstr_type(E), - Flags = bitstr_flags(E), - S3 = count_size(weight(bitstr), S2), - {update_c_bitstr(E, Val, Size, Unit, Type, Flags), S3}. - - -%% --------------------------------------------------------------------- -%% Other central inlining functions - -%% It is assumed here that `E' is a fun-expression and the context is an -%% app-structure. If the inlining might be aborted for some reason, a -%% corresponding catch should have been set up before entering `inline'. -%% -%% Note: if the inlined body is a lambda abstraction, and the -%% surrounding context of the app-context is also an app-context, the -%% `inlined' flag of the outermost context will be set before that of -%% the inner context is set. E.g.: `let F = fun (X) -> fun (Y) -> E in -%% apply apply F(A)(B)' will propagate the body of F, which is a lambda -%% abstraction, into the outer application context, which will be -%% inlined to produce expression `E', and the flag of the outer context -%% will be set. Upon return, the flag of the inner context will also be -%% set. However, the flags are then tested in innermost-first order. -%% Thus, if some inlining attempt is aborted, the `inlined' flags of any -%% nested app-contexts must be cleared. -%% -%% This implementation does nothing to handle inlining of calls to -%% recursive functions in a smart way. This means that as long as the -%% size and effort counters do not prevent it, the function body will be -%% inlined (i.e., the first iteration will be unrolled), and the -%% recursive calls will be residualized. - -inline(E, #app{opnds = Opnds, ctxt = Ctxt, loc = L}, Ren, Env, S) -> - %% Check that the arities match: - Vs = fun_vars(E), - if length(Opnds) /= length(Vs) -> - report_error("function called with wrong number " - "of arguments!\n"), - %% TODO: should really just residualise the call... - exit(error); - true -> - ok - end, - %% Create local bindings for the parameters to their respective - %% operand structures from the app-structure, and visit the body in - %% the context saved in the structure. - {Rs, Ren1, Env1, S1} = bind_locals(Vs, Opnds, Ren, Env, S), - {E1, S2} = i(fun_body(E), Ctxt, Ren1, Env1, S1), - - %% Create necessary bindings and/or set flags. - {E2, S3} = make_let_bindings(Rs, E1, S2), - - %% Lastly, flag the application as inlined, since the inlining - %% attempt was not aborted before we reached this point. - {E2, st__set_app_inlined(L, S3)}. - -%% For the (possibly renamed) argument variables to an inlined call, -%% either create `let' bindings for them, if they are still referenced -%% in the residual expression (in C/Lisp, also if they are assigned to), -%% or otherwise (if they are not referenced or assigned) mark them for -%% evaluation for side effects. - -make_let_bindings([R | Rs], E, S) -> - {E1, S1} = make_let_bindings(Rs, E, S), - make_let_binding(R, E1, S1); -make_let_bindings([], E, S) -> - {E, S}. - -make_let_binding(R, E, S) -> - %% The `referenced' flag is conservatively computed. We therefore - %% first check some simple cases where parameter R is definitely not - %% referenced in the resulting body E. - case is_literal(E) of - true -> - %% A constant contains no variable references. - make_let_binding_1(R, E, S); - false -> - case is_c_var(E) of - true -> - case var_name(E) =:= R#ref.name of - true -> - %% The body is simply the parameter variable - %% itself. Visit the operand for value and - %% substitute the result for the body. - visit_and_count_size(R#ref.opnd, S); - false -> - %% Not the same variable, so the parameter - %% is not referenced at all. - make_let_binding_1(R, E, S) - end; - false -> - %% Proceed to check the `referenced' flag. - case st__get_var_referenced(R#ref.loc, S) of - true -> - %% The parameter is probably referenced in - %% the residual code (although it might not - %% be). Visit the operand for value and - %% create a let-binding. - {E1, S1} = visit_and_count_size(R#ref.opnd, - S), - S2 = count_size(weight('let'), S1), - {c_let([ref_to_var(R)], E1, E), S2}; - false -> - %% The parameter is definitely not - %% referenced. - make_let_binding_1(R, E, S) - end - end - end. - -%% This marks the operand for evaluation for effect. - -make_let_binding_1(R, E, S) -> - Opnd = R#ref.opnd, - {E, st__set_opnd_effect(Opnd#opnd.loc, S)}. - -%% Here, `R' is the ref-structure which is the target of the copy -%% propagation, and `Opnd' is a visited operand structure, to be -%% propagated through `R' if possible - if not, `R' is residualised. -%% `Opnd' is normally the operand that `R' is bound to, and `E' is the -%% result of visiting `Opnd' for value; we pass this as an argument so -%% we don't have to fetch it multiple times (because we don't have -%% constant time access). -%% -%% We also pass the environment of the site of the variable reference, -%% for use when inlining a propagated fun-expression. In the original -%% algorithm by Waddell, the environment used for inlining such cases is -%% the identity mapping, because the fun-expression body has already -%% been visited for value, and their algorithm combines renaming of -%% source-code variables with the looking up of information about -%% residual-code variables. We, however, need to check the environment -%% of the call site when creating new non-shadowed variables, but we -%% must avoid repeated renaming. We therefore separate the renaming and -%% the environment (as in the renaming algorithm of Peyton-Jones and -%% Marlow). This also makes our implementation more general, compared to -%% the original algorithm, because we do not give up on propagating -%% variables that were free in the fun-body. -%% -%% Example: -%% -%% let F = fun (X) -> {'foo', X} in -%% let G = fun (H) -> apply H(F) % F is free in the fun G -%% in apply G(fun (F) -> apply F(42)) -%% => -%% let F = fun (X) -> {'foo', X} in -%% apply (fun (H) -> apply H(F))(fun (F) -> apply F(42)) -%% => -%% let F = fun (X) -> {'foo', X} in -%% apply (fun (F) -> apply F(42))(F) -%% => -%% let F = fun (X) -> {'foo', X} in -%% apply F(42) -%% => -%% apply (fun (X) -> {'foo', X})(2) -%% => -%% {'foo', 42} -%% -%% The original algorithm would give up at stage 4, because F was free -%% in the propagated fun-expression. Our version inlines this example -%% completely. - -copy(R, Opnd, E, Ctxt, Env, S) -> - case is_c_var(E) of - true -> - %% The operand reduces to another variable - get its - %% ref-structure and attempt to propagate further. - copy_var(env__get(var_name(E), Opnd#opnd.env), Ctxt, Env, - S); - false -> - %% Apart from variables and functional values (the latter - %% are handled by `copy_1' below), only constant literals - %% are copyable in general; other things, including e.g. - %% tuples `{foo, X}', could cause duplication of work, and - %% are not copy propagated. - case is_literal(E) of - true -> - {E, count_size(weight(literal), S)}; - false -> - copy_1(R, Opnd, E, Ctxt, Env, S) - end - end. - -copy_var(R, Ctxt, Env, S) -> - %% (In Lisp or C, if this other variable might be assigned to, we - %% should residualize the "parent" instead, so we don't bypass any - %% destructive updates.) - case R#ref.opnd of - undefined -> - %% This variable is not bound to an expression, so just - %% residualize it. - residualize_var(R, S); - Opnd -> - %% Note that because operands are always visited before - %% copied, all copyable operand expressions will be - %% propagated through any number of bindings. If `R' was - %% bound to a constant literal, we would never have reached - %% this point. - case st__lookup_opnd_cache(Opnd#opnd.loc, S) of - error -> - %% The result for this operand is not yet ready - %% (which should mean that it is a recursive - %% reference). Thus, we must residualise the - %% variable. - residualize_var(R, S); - {ok, #cache{expr = E1}} -> - %% The result for the operand is ready, so we can - %% proceed to propagate it. - copy_1(R, Opnd, E1, Ctxt, Env, S) - end - end. - -copy_1(R, Opnd, E, Ctxt, Env, S) -> - %% Fun-expression (lambdas) are a bit special; they are copyable, - %% but should preferably not be duplicated, so they should not be - %% copy propagated except into application contexts, where they can - %% be inlined. - case is_c_fun(E) of - true -> - case Ctxt of - #app{} -> - %% First test if the operand is "outer-pending"; if - %% so, don't inline. - case st__test_outer_pending(Opnd#opnd.loc, S) of - false -> - copy_inline(R, Opnd, E, Ctxt, Env, S); - true -> - %% Cyclic reference forced inlining to stop - %% (avoiding infinite unfolding). - residualize_var(R, S) - end; - _ -> - residualize_var(R, S) - end; - false -> - %% We have no other cases to handle here - residualize_var(R, S) - end. - -%% This inlines a function value that was propagated to an application -%% context. The inlining is done with an identity renaming (since the -%% expression is already visited) but in the environment of the call -%% site (which is OK because of the no-shadowing strategy for renaming, -%% and because the domain of our environments are the residual-program -%% variables instead of the source-program variables). Note that we must -%% first set the "outer-pending" flag, and clear it afterwards. - -copy_inline(R, Opnd, E, Ctxt, Env, S) -> - S1 = st__mark_outer_pending(Opnd#opnd.loc, S), - case catch {ok, copy_inline_1(R, E, Ctxt, Env, S1)} of - {ok, {E1, S2}} -> - {E1, st__clear_outer_pending(Opnd#opnd.loc, S2)}; - {'EXIT', X} -> - exit(X); - X -> - %% If we use destructive update for the `outer-pending' - %% flag, we must make sure to clear it upon a nonlocal - %% return. - st__clear_outer_pending(Opnd#opnd.loc, S1), - throw(X) - end. - -%% If the current effort counter was passive, we use a new active effort -%% counter with the inherited limit for this particular inlining. - -copy_inline_1(R, E, Ctxt, Env, S) -> - case effort_is_active(S) of - true -> - copy_inline_2(R, E, Ctxt, Env, S); - false -> - S1 = new_active_effort(get_effort_limit(S), S), - case catch {ok, copy_inline_2(R, E, Ctxt, Env, S1)} of - {ok, {E1, S2}} -> - %% Revert to the old effort counter. - {E1, revert_effort(S, S2)}; - {counter_exceeded, effort, _} -> - %% Aborted this inlining attempt because too much - %% effort was spent. Residualize the variable and - %% revert to the previous state. - residualize_var(R, S); - {'EXIT', X} -> - exit(X); - X -> - throw(X) - end - end. - -%% Regardless of whether the current size counter is active or not, we -%% use a new active size counter for each inlining. If the current -%% counter was passive, the new counter gets the inherited size limit; -%% if it was active, the size limit of the new counter will be equal to -%% the remaining budget of the current counter (which itself is not -%% affected by the inlining). This distributes the size budget more -%% evenly over "inlinings within inlinings", so that the whole size -%% budget is not spent on the first few call sites (in an inlined -%% function body) forcing the remaining call sites to be residualised. - -copy_inline_2(R, E, Ctxt, Env, S) -> - Limit = case size_is_active(S) of - true -> - get_size_limit(S) - get_size_value(S); - false -> - get_size_limit(S) - end, - %% Add the cost of the application to the new size limit, so we - %% always inline functions that are small enough, even if `Limit' is - %% close to zero at this point. (This is an extension to the - %% original algorithm.) - S1 = new_active_size(Limit + apply_size(length(Ctxt#app.opnds)), S), - case catch {ok, inline(E, Ctxt, ren__identity(), Env, S1)} of - {ok, {E1, S2}} -> - %% Revert to the old size counter. - {E1, revert_size(S, S2)}; - {counter_exceeded, size, S2} -> - %% Aborted this inlining attempt because it got too big. - %% Residualize the variable and revert to the old size - %% counter. (It is important that we do not also revert the - %% effort counter here. Because the effort and size counters - %% are always set up together, we know that the effort - %% counter returned in S2 is the same that was passed to - %% `inline'.) - S3 = revert_size(S, S2), - %% If we use destructive update for the `inlined' flag, we - %% must make sure to clear the flags of any nested - %% app-contexts upon aborting; see `inline' for details. - reset_nested_apps(Ctxt, S3), % for effect - residualize_var(R, S3); - {'EXIT', X} -> - exit(X); - X -> - throw(X) - end. - -reset_nested_apps(#app{ctxt = Ctxt, loc = L}, S) -> - reset_nested_apps(Ctxt, st__clear_app_inlined(L, S)); -reset_nested_apps(_, S) -> - S. - - -%% --------------------------------------------------------------------- -%% Support functions - -new_var(Env) -> - Name = env__new_vname(Env), - c_var(Name). - -residualize_var(R, S) -> - S1 = count_size(weight(var), S), - {ref_to_var(R), st__set_var_referenced(R#ref.loc, S1)}. - -%% This function returns the value-producing subexpression of any -%% expression. (Except for sequencing expressions, this is the -%% expression itself.) - -result(E) -> - case is_c_seq(E) of - true -> - %% Also see `make_seq', which is used in all places to build - %% sequences so that they are always nested in the first - %% position. - seq_body(E); - false -> - E - end. - -%% This function rewrites E to `do A1 E' if A is `do A1 A2', and -%% otherwise returns E unchanged. - -hoist_effects(A, E) -> - case type(A) of - seq -> make_seq(seq_arg(A), E); - _ -> E - end. - -%% This "build sequencing expression" operation assures that sequences -%% are always nested in the first position, which makes it easy to find -%% the actual value-producing expression of a sequence (cf. `result'). - -make_seq(E1, E2) -> - case is_safe(E1) of - true -> - %% The first expression can safely be dropped. - E2; - false -> - %% If `E1' is a sequence whose final expression has no side - %% effects, then we can lose *that* expression when we - %% compose the new sequence, since its value will not be - %% used. - E3 = case is_c_seq(E1) of - true -> - case is_safe(seq_body(E1)) of - true -> - %% Drop the final expression. - seq_arg(E1); - false -> - E1 - end; - false -> - E1 - end, - case is_c_seq(E2) of - true -> - %% `E2' is a sequence (E2' E2''), so we must - %% rearrange the nesting to ((E1, E2') E2''), to - %% preserve the invariant. Annotations on `E2' are - %% lost. - c_seq(c_seq(E3, seq_arg(E2)), seq_body(E2)); - false -> - c_seq(E3, E2) - end - end. - -%% Currently, safe expressions include variables, lambda expressions, -%% constructors with safe subexpressions (this includes atoms, integers, -%% empty lists, etc.), seq-, let- and letrec-expressions with safe -%% subexpressions, try- and catch-expressions with safe subexpressions -%% and calls to safe functions with safe argument subexpressions. -%% Binaries seem too tricky to be considered. - -is_safe(E) -> - case is_data(E) of - true -> - is_safe_list(data_es(E)); - false -> - case type(E) of - var -> - true; - 'fun' -> - true; - values -> - is_safe_list(values_es(E)); - 'seq' -> - case is_safe(seq_arg(E)) of - true -> - is_safe(seq_body(E)); - false -> - false - end; - 'let' -> - case is_safe(let_arg(E)) of - true -> - is_safe(let_body(E)); - false -> - false - end; - letrec -> - is_safe(letrec_body(E)); - 'try' -> - %% If the argument expression is not safe, it could - %% be modifying the state; thus, even if the body is - %% safe, the try-expression as a whole would not be. - %% If the argument is safe, the handler is not used. - case is_safe(try_arg(E)) of - true -> - is_safe(try_body(E)); - false -> - false - end; - 'catch' -> - is_safe(catch_body(E)); - call -> - M = call_module(E), - F = call_name(E), - case is_c_atom(M) and is_c_atom(F) of - true -> - As = call_args(E), - case is_safe_list(As) of - true -> - is_safe_call(atom_val(M), - atom_val(F), - length(As)); - false -> - false - end; - false -> - false - end; - _ -> - false - end - end. - -is_safe_list([E | Es]) -> - case is_safe(E) of - true -> - is_safe_list(Es); - false -> - false - end; -is_safe_list([]) -> - true. - -is_safe_call(M, F, A) -> - erl_bifs:is_safe(M, F, A). - -%% When setting up local variables, we only create new names if we have -%% to, according to the "no-shadowing" strategy. - -make_locals(Vs, Ren, Env) -> - make_locals(Vs, [], Ren, Env). - -make_locals([V | Vs], As, Ren, Env) -> - Name = var_name(V), - case env__is_defined(Name, Env) of - false -> - %% The variable need not be renamed. Just make sure that the - %% renaming will map it to itself. - Name1 = Name, - Ren1 = ren__add_identity(Name, Ren); - true -> - %% The variable must be renamed to maintain the no-shadowing - %% invariant. Do the right thing for function variables. - Name1 = case Name of - {A, N} -> - env__new_fname(A, N, Env); - _ -> - env__new_vname(Env) - end, - Ren1 = ren__add(Name, Name1, Ren) - end, - %% This temporary binding is added for correct new-key generation. - Env1 = env__bind(Name1, dummy, Env), - make_locals(Vs, [Name1 | As], Ren1, Env1); -make_locals([], As, Ren, Env) -> - {reverse(As), Ren, Env}. - -%% This adds let-bindings for the source code variables in `Es' to the -%% environment `Env'. -%% -%% Note that we always assign a new state location for the -%% residual-program variable, since we cannot know when a location for a -%% particular variable in the source code can be reused. - -bind_locals(Vs, Ren, Env, S) -> - Opnds = lists:duplicate(length(Vs), undefined), - bind_locals(Vs, Opnds, Ren, Env, S). - -bind_locals(Vs, Opnds, Ren, Env, S) -> - {Ns, Ren1, Env1} = make_locals(Vs, Ren, Env), - {Rs, Env2, S1} = bind_locals_1(Ns, Opnds, [], Env1, S), - {Rs, Ren1, Env2, S1}. - -%% Note that the `Vs' are currently not used for anything except the -%% number of variables. If we were maintaining "source-referenced" -%% flags, then the flag in the new variable should be initialized to the -%% current value of the (residual-) referenced-flag of the "parent". - -bind_locals_1([N | Ns], [Opnd | Opnds], Rs, Env, S) -> - {R, S1} = new_ref(N, Opnd, S), - Env1 = env__bind(N, R, Env), - bind_locals_1(Ns, Opnds, [R | Rs], Env1, S1); -bind_locals_1([], [], Rs, Env, S) -> - {lists:reverse(Rs), Env, S}. - -new_refs(Ns, Opnds, S) -> - new_refs(Ns, Opnds, [], S). - -new_refs([N | Ns], [Opnd | Opnds], Rs, S) -> - {R, S1} = new_ref(N, Opnd, S), - new_refs(Ns, Opnds, [R | Rs], S1); -new_refs([], [], Rs, S) -> - {lists:reverse(Rs), S}. - -new_ref(N, Opnd, S) -> - {L, S1} = st__new_ref_loc(S), - {#ref{name = N, opnd = Opnd, loc = L}, S1}. - -%% This adds recursive bindings for the source code variables in `Es' to -%% the environment `Env'. Note that recursive binding of a set of -%% variables is an atomic operation on the environment - they cannot be -%% added one at a time. - -bind_recursive(Vs, Opnds, Ren, Env, S) -> - {Ns, Ren1, Env1} = make_locals(Vs, Ren, Env), - {Rs, S1} = new_refs(Ns, Opnds, S), - - %% When this fun-expression is evaluated, it updates the operand - %% structure in the ref-structure to contain the recursively defined - %% environment and the correct renaming. - Fun = fun (R, Env) -> - Opnd = R#ref.opnd, - R#ref{opnd = Opnd#opnd{ren = Ren1, env = Env}} - end, - {Rs, Ren1, env__bind_recursive(Ns, Rs, Fun, Env1), S1}. - -safe_context(Ctxt) -> - case Ctxt of - #app{} -> - value; - _ -> - Ctxt - end. - -%% Note that the name of a variable encodes its type: a "plain" variable -%% or a function variable. The latter kind also contains an arity number -%% which should be preserved upon renaming. - -ref_to_var(#ref{name = Name}) -> - %% If we were maintaining "source-referenced" flags, the annotation - %% `add_ann([#source_ref{loc = L}], E)' should also be done here, to - %% make the algorithm reapplicable. This is however not necessary - %% since there are no destructive variable assignments in Erlang. - c_var(Name). - -%% Including the effort counter of the call site assures that the cost -%% of processing an operand via `visit' is charged to the correct -%% counter. In particular, if the effort counter of the call site was -%% passive, the operands will also be processed with a passive counter. - -make_opnd(E, Ren, Env, S) -> - {L, S1} = st__new_opnd_loc(S), - C = st__get_effort(S1), - Opnd = #opnd{expr = E, ren = Ren, env = Env, loc = L, effort = C}, - {Opnd, S1}. - -keep_referenced(Rs, S) -> - [R || R <- Rs, st__get_var_referenced(R#ref.loc, S)]. - -residualize_operands(Opnds, E, S) -> - foldr(fun (Opnd, {E, S}) -> residualize_operand(Opnd, E, S) end, - {E, S}, Opnds). - -%% This is the only case where an operand expression can be visited in -%% `effect' context instead of `value' context. - -residualize_operand(Opnd, E, S) -> - case st__get_opnd_effect(Opnd#opnd.loc, S) of - true -> - %% The operand has not been visited, so we do that now, but - %% in `effect' context. (Waddell's algoritm does some stuff - %% here to account specially for the operand size, which - %% appears unnecessary.) - {E1, S1} = i(Opnd#opnd.expr, effect, Opnd#opnd.ren, - Opnd#opnd.env, S), - {make_seq(E1, E), S1}; - false -> - {E, S} - end. - -%% The `visit' function always visits the operand expression in `value' -%% context (`residualize_operand' visits an unreferenced operand -%% expression in `effect' context when necessary). A new passive size -%% counter is used for visiting the operand, the final value of which is -%% then cached along with the resulting expression. -%% -%% Note that the effort counter of the call site, included in the -%% operand structure, is not a shared object. Thus, the effort budget is -%% actually reused over all occurrences of the operands of a single -%% application. This does not appear to be a problem; just a -%% modification of the algorithm. - -visit(Opnd, S) -> - {C, S1} = visit_1(Opnd, S), - {C#cache.expr, S1}. - -visit_and_count_size(Opnd, S) -> - {C, S1} = visit_1(Opnd, S), - {C#cache.expr, count_size(C#cache.size, S1)}. - -visit_1(Opnd, S) -> - case st__lookup_opnd_cache(Opnd#opnd.loc, S) of - error -> - %% Use a new, passive, size counter for visiting operands, - %% and use the effort counter of the context of the operand. - %% It turns out that if the latter is active, it must be the - %% same object as the one currently used, and if it is - %% passive, it does not matter if it is the same object as - %% any other counter. - Effort = Opnd#opnd.effort, - Active = counter__is_active(Effort), - S1 = case Active of - true -> - S; % don't change effort counter - false -> - st__set_effort(Effort, S) - end, - S2 = new_passive_size(get_size_limit(S1), S1), - - %% Visit the expression and cache the result, along with the - %% final value of the size counter. - {E, S3} = i(Opnd#opnd.expr, value, Opnd#opnd.ren, - Opnd#opnd.env, S2), - Size = get_size_value(S3), - C = #cache{expr = E, size = Size}, - S4 = revert_size(S, st__set_opnd_cache(Opnd#opnd.loc, C, - S3)), - case Active of - true -> - {C, S4}; % keep using the same effort counter - false -> - {C, revert_effort(S, S4)} - end; - {ok, C} -> - {C, S} - end. - -%% Create a pattern matching template for an expression. A template -%% contains only data constructors (including atomic ones) and -%% variables, and compound literals are not folded into a single node. -%% Each node in the template is annotated with the variable which holds -%% the corresponding subexpression; these are new, unique variables not -%% existing in the given `Env'. Returns `{Template, Variables, NewEnv}', -%% where `Variables' is the list of all variables corresponding to nodes -%% in the template *listed in reverse dependency order*, and `NewEnv' is -%% `Env' augmented with mappings from the variable names to -%% subexpressions of `E' (not #ref{} structures!) rewritten so that no -%% computations are duplicated. `Variables' is guaranteed to be nonempty -%% - at least the root node will always be bound to a new variable. - -make_template(E, Env) -> - make_template(E, [], Env). - -make_template(E, Vs0, Env0) -> - case is_data(E) of - true -> - {Ts, {Vs1, Env1}} = mapfoldl( - fun (E, {Vs0, Env0}) -> - {T, Vs1, Env1} = - make_template(E, Vs0, - Env0), - {T, {Vs1, Env1}} - end, - {Vs0, Env0}, data_es(E)), - T = make_data_skel(data_type(E), Ts), - E1 = update_data(E, data_type(E), - [hd(get_ann(T)) || T <- Ts]), - V = new_var(Env1), - Env2 = env__bind(var_name(V), E1, Env1), - {set_ann(T, [V]), [V | Vs1], Env2}; - false -> - case type(E) of - seq -> - %% For a sequencing, we can rebind the variable used - %% for the body, and pass on the template as it is. - {T, Vs1, Env1} = make_template(seq_body(E), Vs0, - Env0), - V = var_name(hd(get_ann(T))), - E1 = update_c_seq(E, seq_arg(E), env__get(V, Env1)), - Env2 = env__bind(V, E1, Env1), - {T, Vs1, Env2}; - _ -> - V = new_var(Env0), - Env1 = env__bind(var_name(V), E, Env0), - {set_ann(V, [V]), [V | Vs0], Env1} - end - end. - -%% Two clauses are equivalent if their bodies are equivalent expressions -%% given that the respective pattern variables are local. - -equivalent_clauses([]) -> - true; -equivalent_clauses([C | Cs]) -> - Env = cerl_trees:variables(c_values(clause_pats(C))), - equivalent_clauses_1(clause_body(C), Cs, Env). - -equivalent_clauses_1(E, [C | Cs], Env) -> - Env1 = cerl_trees:variables(c_values(clause_pats(C))), - case equivalent(E, clause_body(C), ordsets:union(Env, Env1)) of - true -> - equivalent_clauses_1(E, Cs, Env); - false -> - false - end; -equivalent_clauses_1(_, [], _Env) -> - true. - -%% Two expressions are equivalent if and only if they yield the same -%% value and has the same side effects in the same order. Currently, we -%% only accept equality between constructors (constants) and nonlocal -%% variables, since this should cover most cases of interest. If a -%% variable is locally bound in one expression, it cannot be equivalent -%% to one with the same name in the other expression, so we need not -%% keep track of two environments. - -equivalent(E1, E2, Env) -> - case is_data(E1) of - true -> - case is_data(E2) of - true -> - T1 = {data_type(E1), data_arity(E1)}, - T2 = {data_type(E2), data_arity(E2)}, - %% Note that we must test for exact equality. - if T1 =:= T2 -> - equivalent_lists(data_es(E1), data_es(E2), - Env); - true -> - false - end; - false -> - false - end; - false -> - case type(E1) of - var -> - case is_c_var(E2) of - true -> - N1 = var_name(E1), - N2 = var_name(E2), - if N1 =:= N2 -> - not ordsets:is_element(N1, Env); - true -> - false - end; - false -> - false - end; - _ -> - %% Other constructs are not being considered. - false - end - end. - -equivalent_lists([E1 | Es1], [E2 | Es2], Env) -> - equivalent(E1, E2, Env) and equivalent_lists(Es1, Es2, Env); -equivalent_lists([], [], _) -> - true; -equivalent_lists(_, _, _) -> - false. - -%% Return `false' or `{true, EffectExpr, ValueExpr}'. The environment is -%% passed for new-variable generation. - -reduce_bif_call(M, F, As, Env) -> - reduce_bif_call_1(M, F, length(As), As, Env). - -reduce_bif_call_1(erlang, element, 2, [X, Y], _Env) -> - case is_c_int(X) and is_c_tuple(Y) of - true -> - %% We are free to change the relative evaluation order of - %% the elements, so lifting out a particular element is OK. - T = list_to_tuple(tuple_es(Y)), - N = int_val(X), - if integer(N), N > 0, N =< size(T) -> - E = element(N, T), - Es = tuple_to_list(setelement(N, T, void())), - {true, make_seq(c_tuple(Es), E)}; - true -> - false - end; - false -> - false - end; -reduce_bif_call_1(erlang, hd, 1, [X], _Env) -> - case is_c_cons(X) of - true -> - %% Cf. `element/2' above. - {true, make_seq(cons_tl(X), cons_hd(X))}; - false -> - false - end; -reduce_bif_call_1(erlang, length, 1, [X], _Env) -> - case is_c_list(X) of - true -> - %% Cf. `erlang:size/1' below. - {true, make_seq(X, c_int(list_length(X)))}; - false -> - false - end; -reduce_bif_call_1(erlang, list_to_tuple, 1, [X], _Env) -> - case is_c_list(X) of - true -> - %% This does not actually preserve all the evaluation order - %% constraints of the list, but I don't imagine that it will - %% be a problem. - {true, c_tuple(list_elements(X))}; - false -> - false - end; -reduce_bif_call_1(erlang, setelement, 3, [X, Y, Z], Env) -> - case is_c_int(X) and is_c_tuple(Y) of - true -> - %% Here, unless `Z' is a simple expression, we must bind it - %% to a new variable, because in that case, `Z' must be - %% evaluated before any part of `Y'. - T = list_to_tuple(tuple_es(Y)), - N = int_val(X), - if integer(N), N > 0, N =< size(T) -> - E = element(N, T), - case is_simple(Z) of - true -> - Es = tuple_to_list(setelement(N, T, Z)), - {true, make_seq(E, c_tuple(Es))}; - false -> - V = new_var(Env), - Es = tuple_to_list(setelement(N, T, V)), - E1 = make_seq(E, c_tuple(Es)), - {true, c_let([V], Z, E1)} - end; - true -> - false - end; - false -> - false - end; -reduce_bif_call_1(erlang, size, 1, [X], _Env) -> - case is_c_tuple(X) of - true -> - %% Just evaluate the tuple for effect and use the size (the - %% arity) as the result. - {true, make_seq(X, c_int(tuple_arity(X)))}; - false -> - false - end; -reduce_bif_call_1(erlang, tl, 1, [X], _Env) -> - case is_c_cons(X) of - true -> - %% Cf. `element/2' above. - {true, make_seq(cons_hd(X), cons_tl(X))}; - false -> - false - end; -reduce_bif_call_1(erlang, tuple_to_list, 1, [X], _Env) -> - case is_c_tuple(X) of - true -> - %% This actually introduces slightly stronger constraints on - %% the evaluation order of the subexpressions. - {true, make_list(tuple_es(X))}; - false -> - false - end; -reduce_bif_call_1(_M, _F, _A, _As, _Env) -> - false. - -effort_is_active(S) -> - counter__is_active(st__get_effort(S)). - -size_is_active(S) -> - counter__is_active(st__get_size(S)). - -get_effort_limit(S) -> - counter__limit(st__get_effort(S)). - -new_active_effort(Limit, S) -> - st__set_effort(counter__new_active(Limit), S). - -revert_effort(S1, S2) -> - st__set_effort(st__get_effort(S1), S2). - -new_active_size(Limit, S) -> - st__set_size(counter__new_active(Limit), S). - -new_passive_size(Limit, S) -> - st__set_size(counter__new_passive(Limit), S). - -revert_size(S1, S2) -> - st__set_size(st__get_size(S1), S2). - -count_effort(N, S) -> - C = st__get_effort(S), - C1 = counter__add(N, C, effort, S), - case debug_counters() of - true -> - case counter__is_active(C1) of - true -> - V = counter__value(C1), - case V > get(counter_effort_max) of - true -> - put(counter_effort_max, V); - false -> - ok - end; - false -> - ok - end; - _ -> - ok - end, - st__set_effort(C1, S). - -count_size(N, S) -> - C = st__get_size(S), - C1 = counter__add(N, C, size, S), - case debug_counters() of - true -> - case counter__is_active(C1) of - true -> - V = counter__value(C1), - case V > get(counter_size_max) of - true -> - put(counter_size_max, V); - false -> - ok - end; - false -> - ok - end; - _ -> - ok - end, - st__set_size(C1, S). - -get_size_value(S) -> - counter__value(st__get_size(S)). - -get_size_limit(S) -> - counter__limit(st__get_size(S)). - -kill_id_anns([{'id',_} | As]) -> - kill_id_anns(As); -kill_id_anns([A | As]) -> - [A | kill_id_anns(As)]; -kill_id_anns([]) -> - []. - - -%% ===================================================================== -%% General utilities - -max(X, Y) when X > Y -> X; -max(_, Y) -> Y. - -%% The atom `ok', is widely used in Erlang for "void" values. - -void() -> abstract(ok). - -is_simple(E) -> - case type(E) of - literal -> true; - var -> true; - 'fun' -> true; - _ -> false - end. - -get_components(N, E) -> - case type(E) of - values -> - Es = values_es(E), - if length(Es) == N -> - {true, Es}; - true -> - false - end; - _ when N == 1 -> - {true, [E]}; - _ -> - false - end. - -all_static([E | Es]) -> - case is_literal(result(E)) of - true -> - all_static(Es); - false -> - false - end; -all_static([]) -> - true. - -set_clause_bodies([C | Cs], B) -> - [update_c_clause(C, clause_pats(C), clause_guard(C), B) - | set_clause_bodies(Cs, B)]; -set_clause_bodies([], _) -> - []. - -filename([C | T]) when integer(C), C > 0, C =< 255 -> - [C | filename(T)]; -filename([H|T]) -> - filename(H) ++ filename(T); -filename([]) -> - []; -filename(N) when atom(N) -> - atom_to_list(N); -filename(N) -> - report_error("bad filename: `~P'.", [N, 25]), - exit(error). - - -%% ===================================================================== -%% Abstract datatype: renaming() - -ren__identity() -> - dict:new(). - -ren__add(X, Y, Ren) -> - dict:store(X, Y, Ren). - -ren__map(X, Ren) -> - case dict:find(X, Ren) of - {ok, Y} -> - Y; - error -> - X - end. - -ren__add_identity(X, Ren) -> - dict:erase(X, Ren). - - -%% ===================================================================== -%% Abstract datatype: environment() - -env__empty() -> - rec_env:empty(). - -env__bind(Key, Val, Env) -> - rec_env:bind(Key, Val, Env). - -%% `Es' should have type `[{Key, Val}]', and `Fun' should have type -%% `(Val, Env) -> T', mapping a value together with the recursive -%% environment itself to some term `T' to be returned when the entry is -%% looked up. - -env__bind_recursive(Ks, Vs, F, Env) -> - rec_env:bind_recursive(Ks, Vs, F, Env). - -env__lookup(Key, Env) -> - rec_env:lookup(Key, Env). - -env__get(Key, Env) -> - rec_env:get(Key, Env). - -env__is_defined(Key, Env) -> - rec_env:is_defined(Key, Env). - -env__new_vname(Env) -> - rec_env:new_key(Env). - -env__new_fname(A, N, Env) -> - rec_env:new_key(fun (X) -> - S = integer_to_list(X), - {list_to_atom(atom_to_list(A) ++ "_" ++ S), - N} - end, Env). - - -%% ===================================================================== -%% Abstract datatype: state() - --record(state, {free, % next free location - size, % size counter - effort, % effort counter - cache, % operand expression cache - var_flags, % flags for variables (#ref-structures) - opnd_flags, % flags for operands - app_flags}). % flags for #app-structures - -%% Note that we do not have a `var_assigned' flag, since there is no -%% destructive assignment in Erlang. In the original algorithm, the -%% "residual-referenced"-flags of the previous inlining pass (or -%% initialization pass) are used as the "source-referenced"-flags for -%% the subsequent pass. The latter may then be used as a safe -%% approximation whenever we need to base a decision on whether or not a -%% particular variable or function variable could be referenced in the -%% program being generated, and computation of the new -%% "residual-referenced" flag for that variable is not yet finished. In -%% the present algorithm, this can only happen in the presence of -%% variable assignments, which do not exist in Erlang. Therefore, we do -%% not keep "source-referenced" flags for residual-code references in -%% our implementation. -%% -%% The "inner-pending" flag tells us whether we are already in the -%% process of visiting a particular operand, and the "outer-pending" -%% flag whether we are in the process of inlining a propagated -%% functional value. The "pending flags" are really counters limiting -%% the number of times an operand may be inlined recursively, causing -%% loop unrolling; however, unrolling more than one iteration does not -%% work offhand in the present implementation. (TODO: find out why.) -%% Note that the initial value must be greater than zero in order for -%% any inlining at all to be done. - -%% Flags are stored in ETS-tables, one table for each class. The second -%% element in each stored tuple is the key (the "label"). - --record(var_flags, {lab, referenced = false}). --record(opnd_flags, {lab, inner_pending = 1, outer_pending = 1, - effect = false}). --record(app_flags, {lab, inlined = false}). - -st__new(Effort, Size) -> - #state{free = 0, - size = counter__new_passive(Size), - effort = counter__new_passive(Effort), - cache = dict:new(), - var_flags = ets:new(var, [set, private, {keypos, 2}]), - opnd_flags = ets:new(opnd, [set, private, {keypos, 2}]), - app_flags = ets:new(app, [set, private, {keypos, 2}])}. - -st__new_loc(S) -> - N = S#state.free, - {N, S#state{free = N + 1}}. - -st__get_effort(S) -> - S#state.effort. - -st__set_effort(C, S) -> - S#state{effort = C}. - -st__get_size(S) -> - S#state.size. - -st__set_size(C, S) -> - S#state{size = C}. - -st__set_var_referenced(L, S) -> - T = S#state.var_flags, - [F] = ets:lookup(T, L), - ets:insert(T, F#var_flags{referenced = true}), - S. - -st__get_var_referenced(L, S) -> - ets:lookup_element(S#state.var_flags, L, #var_flags.referenced). - -st__lookup_opnd_cache(L, S) -> - dict:find(L, S#state.cache). - -%% Note that setting the cache should only be done once. - -st__set_opnd_cache(L, C, S) -> - S#state{cache = dict:store(L, C, S#state.cache)}. - -st__set_opnd_effect(L, S) -> - T = S#state.opnd_flags, - [F] = ets:lookup(T, L), - ets:insert(T, F#opnd_flags{effect = true}), - S. - -st__get_opnd_effect(L, S) -> - ets:lookup_element(S#state.opnd_flags, L, #opnd_flags.effect). - -st__set_app_inlined(L, S) -> - T = S#state.app_flags, - [F] = ets:lookup(T, L), - ets:insert(T, F#app_flags{inlined = true}), - S. - -st__clear_app_inlined(L, S) -> - T = S#state.app_flags, - [F] = ets:lookup(T, L), - ets:insert(T, F#app_flags{inlined = false}), - S. - -st__get_app_inlined(L, S) -> - ets:lookup_element(S#state.app_flags, L, #app_flags.inlined). - -%% The pending-flags are initialized by `st__new_opnd_loc' below. - -st__test_inner_pending(L, S) -> - T = S#state.opnd_flags, - P = ets:lookup_element(T, L, #opnd_flags.inner_pending), - P =< 0. - -st__mark_inner_pending(L, S) -> - ets:update_counter(S#state.opnd_flags, L, - {#opnd_flags.inner_pending, -1}), - S. - -st__clear_inner_pending(L, S) -> - ets:update_counter(S#state.opnd_flags, L, - {#opnd_flags.inner_pending, 1}), - S. - -st__test_outer_pending(L, S) -> - T = S#state.opnd_flags, - P = ets:lookup_element(T, L, #opnd_flags.outer_pending), - P =< 0. - -st__mark_outer_pending(L, S) -> - ets:update_counter(S#state.opnd_flags, L, - {#opnd_flags.outer_pending, -1}), - S. - -st__clear_outer_pending(L, S) -> - ets:update_counter(S#state.opnd_flags, L, - {#opnd_flags.outer_pending, 1}), - S. - -st__new_app_loc(S) -> - V = {L, _S1} = st__new_loc(S), - ets:insert(S#state.app_flags, #app_flags{lab = L}), - V. - -st__new_ref_loc(S) -> - V = {L, _S1} = st__new_loc(S), - ets:insert(S#state.var_flags, #var_flags{lab = L}), - V. - -st__new_opnd_loc(S) -> - V = {L, _S1} = st__new_loc(S), - ets:insert(S#state.opnd_flags, #opnd_flags{lab = L}), - V. - - -%% ===================================================================== -%% Abstract datatype: counter() -%% -%% `counter__add' throws `{counter_exceeded, Type, Data}' if the -%% resulting counter value would exceed the limit for the counter in -%% question (`Type' and `Data' are given by the user). - --record(counter, {active, value, limit}). - -counter__new_passive(Limit) when Limit > 0 -> - {0, Limit}. - -counter__new_active(Limit) when Limit > 0 -> - {Limit, Limit}. - -%% Active counters have values > 0 internally; passive counters start at -%% zero. The 'limit' field is only accessed by the 'counter__limit' -%% function. - -counter__is_active({C, _}) -> - C > 0. - -counter__limit({_, L}) -> - L. - -counter__value({N, L}) -> - if N > 0 -> - L - N; - true -> - -N - end. - -counter__add(N, {V, L}, Type, Data) -> - N1 = V - N, - if V > 0, N1 =< 0 -> - case debug_counters() of - true -> - case Type of - effort -> - put(counter_effort_triggers, - get(counter_effort_triggers) + 1); - size -> - put(counter_size_triggers, - get(counter_size_triggers) + 1) - end; - _ -> - ok - end, - throw({counter_exceeded, Type, Data}); - true -> - {N1, L} - end. - - -%% ===================================================================== -%% Reporting - -% report_internal_error(S) -> -% report_internal_error(S, []). - -report_internal_error(S, Vs) -> - report_error("internal error: " ++ S, Vs). - -report_error(D) -> - report_error(D, []). - -report_error({F, L, D}, Vs) -> - report({F, L, {error, D}}, Vs); -report_error(D, Vs) -> - report({error, D}, Vs). - -report_warning(D) -> - report_warning(D, []). - -report_warning({F, L, D}, Vs) -> - report({F, L, {warning, D}}, Vs); -report_warning(D, Vs) -> - report({warning, D}, Vs). - -report(D, Vs) -> - io:put_chars(format(D, Vs)). - -format({error, D}, Vs) -> - ["error: ", format(D, Vs)]; -format({warning, D}, Vs) -> - ["warning: ", format(D, Vs)]; -format({"", L, D}, Vs) when integer(L), L > 0 -> - [io_lib:fwrite("~w: ", [L]), format(D, Vs)]; -format({"", _L, D}, Vs) -> - format(D, Vs); -format({F, L, D}, Vs) when integer(L), L > 0 -> - [io_lib:fwrite("~s:~w: ", [filename(F), L]), format(D, Vs)]; -format({F, _L, D}, Vs) -> - [io_lib:fwrite("~s: ", [filename(F)]), format(D, Vs)]; -format(S, Vs) when list(S) -> - [io_lib:fwrite(S, Vs), $\n]. - - -%% ===================================================================== diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_trees.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_trees.erl deleted file mode 100644 index 50384a6ff8..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_trees.erl +++ /dev/null @@ -1,801 +0,0 @@ -%% ``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 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. -%% -%% The Initial Developer of the Original Code is Richard Carlsson. -%% Copyright (C) 1999-2002 Richard Carlsson. -%% Portions created by Ericsson are Copyright 2001, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id: cerl_trees.erl,v 1.2 2010/06/07 06:32:39 kostis Exp $ - -%% @doc Basic functions on Core Erlang abstract syntax trees. -%% -%% <p>Syntax trees are defined in the module <a -%% href=""><code>cerl</code></a>.</p> -%% -%% @type cerl() = cerl:cerl() - --module(cerl_trees). - --export([depth/1, fold/3, free_variables/1, label/1, label/2, map/2, - mapfold/3, size/1, variables/1]). - --import(cerl, [alias_pat/1, alias_var/1, ann_c_alias/3, ann_c_apply/3, - ann_c_binary/2, ann_c_bitstr/6, ann_c_call/4, - ann_c_case/3, ann_c_catch/2, ann_c_clause/4, - ann_c_cons_skel/3, ann_c_fun/3, ann_c_let/4, - ann_c_letrec/3, ann_c_module/5, ann_c_primop/3, - ann_c_receive/4, ann_c_seq/3, ann_c_try/6, - ann_c_tuple_skel/2, ann_c_values/2, apply_args/1, - apply_op/1, binary_segments/1, bitstr_val/1, - bitstr_size/1, bitstr_unit/1, bitstr_type/1, - bitstr_flags/1, call_args/1, call_module/1, call_name/1, - case_arg/1, case_clauses/1, catch_body/1, clause_body/1, - clause_guard/1, clause_pats/1, clause_vars/1, concrete/1, - cons_hd/1, cons_tl/1, fun_body/1, fun_vars/1, get_ann/1, - let_arg/1, let_body/1, let_vars/1, letrec_body/1, - letrec_defs/1, letrec_vars/1, module_attrs/1, - module_defs/1, module_exports/1, module_name/1, - module_vars/1, primop_args/1, primop_name/1, - receive_action/1, receive_clauses/1, receive_timeout/1, - seq_arg/1, seq_body/1, set_ann/2, subtrees/1, try_arg/1, - try_body/1, try_vars/1, try_evars/1, try_handler/1, - tuple_es/1, type/1, update_c_alias/3, update_c_apply/3, - update_c_binary/2, update_c_bitstr/6, update_c_call/4, - update_c_case/3, update_c_catch/2, update_c_clause/4, - update_c_cons/3, update_c_cons_skel/3, update_c_fun/3, - update_c_let/4, update_c_letrec/3, update_c_module/5, - update_c_primop/3, update_c_receive/4, update_c_seq/3, - update_c_try/6, update_c_tuple/2, update_c_tuple_skel/2, - update_c_values/2, values_es/1, var_name/1]). - - -%% --------------------------------------------------------------------- - -%% @spec depth(Tree::cerl) -> integer() -%% -%% @doc Returns the length of the longest path in the tree. A leaf -%% node has depth zero, the tree representing "<code>{foo, -%% bar}</code>" has depth one, etc. - -depth(T) -> - case subtrees(T) of - [] -> - 0; - Gs -> - 1 + lists:foldl(fun (G, A) -> erlang:max(depth_1(G), A) end, 0, Gs) - end. - -depth_1(Ts) -> - lists:foldl(fun (T, A) -> erlang:max(depth(T), A) end, 0, Ts). - -%% max(X, Y) when X > Y -> X; -%% max(_, Y) -> Y. - - -%% @spec size(Tree::cerl()) -> integer() -%% -%% @doc Returns the number of nodes in <code>Tree</code>. - -size(T) -> - fold(fun (_, S) -> S + 1 end, 0, T). - - -%% --------------------------------------------------------------------- - -%% @spec map(Function, Tree::cerl()) -> cerl() -%% -%% Function = (cerl()) -> cerl() -%% -%% @doc Maps a function onto the nodes of a tree. This replaces each -%% node in the tree by the result of applying the given function on -%% the original node, bottom-up. -%% -%% @see mapfold/3 - -map(F, T) -> - F(map_1(F, T)). - -map_1(F, T) -> - case type(T) of - literal -> - case concrete(T) of - [_ | _] -> - update_c_cons(T, map(F, cons_hd(T)), - map(F, cons_tl(T))); - V when tuple_size(V) > 0 -> - update_c_tuple(T, map_list(F, tuple_es(T))); - _ -> - T - end; - var -> - T; - values -> - update_c_values(T, map_list(F, values_es(T))); - cons -> - update_c_cons_skel(T, map(F, cons_hd(T)), - map(F, cons_tl(T))); - tuple -> - update_c_tuple_skel(T, map_list(F, tuple_es(T))); - 'let' -> - update_c_let(T, map_list(F, let_vars(T)), - map(F, let_arg(T)), - map(F, let_body(T))); - seq -> - update_c_seq(T, map(F, seq_arg(T)), - map(F, seq_body(T))); - apply -> - update_c_apply(T, map(F, apply_op(T)), - map_list(F, apply_args(T))); - call -> - update_c_call(T, map(F, call_module(T)), - map(F, call_name(T)), - map_list(F, call_args(T))); - primop -> - update_c_primop(T, map(F, primop_name(T)), - map_list(F, primop_args(T))); - 'case' -> - update_c_case(T, map(F, case_arg(T)), - map_list(F, case_clauses(T))); - clause -> - update_c_clause(T, map_list(F, clause_pats(T)), - map(F, clause_guard(T)), - map(F, clause_body(T))); - alias -> - update_c_alias(T, map(F, alias_var(T)), - map(F, alias_pat(T))); - 'fun' -> - update_c_fun(T, map_list(F, fun_vars(T)), - map(F, fun_body(T))); - 'receive' -> - update_c_receive(T, map_list(F, receive_clauses(T)), - map(F, receive_timeout(T)), - map(F, receive_action(T))); - 'try' -> - update_c_try(T, map(F, try_arg(T)), - map_list(F, try_vars(T)), - map(F, try_body(T)), - map_list(F, try_evars(T)), - map(F, try_handler(T))); - 'catch' -> - update_c_catch(T, map(F, catch_body(T))); - binary -> - update_c_binary(T, map_list(F, binary_segments(T))); - bitstr -> - update_c_bitstr(T, map(F, bitstr_val(T)), - map(F, bitstr_size(T)), - map(F, bitstr_unit(T)), - map(F, bitstr_type(T)), - map(F, bitstr_flags(T))); - letrec -> - update_c_letrec(T, map_pairs(F, letrec_defs(T)), - map(F, letrec_body(T))); - module -> - update_c_module(T, map(F, module_name(T)), - map_list(F, module_exports(T)), - map_pairs(F, module_attrs(T)), - map_pairs(F, module_defs(T))) - end. - -map_list(F, [T | Ts]) -> - [map(F, T) | map_list(F, Ts)]; -map_list(_, []) -> - []. - -map_pairs(F, [{T1, T2} | Ps]) -> - [{map(F, T1), map(F, T2)} | map_pairs(F, Ps)]; -map_pairs(_, []) -> - []. - - -%% @spec fold(Function, Unit::term(), Tree::cerl()) -> term() -%% -%% Function = (cerl(), term()) -> term() -%% -%% @doc Does a fold operation over the nodes of the tree. The result -%% is the value of <code>Function(X1, Function(X2, ... Function(Xn, -%% Unit) ... ))</code>, where <code>X1, ..., Xn</code> are the nodes -%% of <code>Tree</code> in a post-order traversal. -%% -%% @see mapfold/3 - -fold(F, S, T) -> - F(T, fold_1(F, S, T)). - -fold_1(F, S, T) -> - case type(T) of - literal -> - case concrete(T) of - [_ | _] -> - fold(F, fold(F, S, cons_hd(T)), cons_tl(T)); - V when tuple_size(V) > 0 -> - fold_list(F, S, tuple_es(T)); - _ -> - S - end; - var -> - S; - values -> - fold_list(F, S, values_es(T)); - cons -> - fold(F, fold(F, S, cons_hd(T)), cons_tl(T)); - tuple -> - fold_list(F, S, tuple_es(T)); - 'let' -> - fold(F, fold(F, fold_list(F, S, let_vars(T)), - let_arg(T)), - let_body(T)); - seq -> - fold(F, fold(F, S, seq_arg(T)), seq_body(T)); - apply -> - fold_list(F, fold(F, S, apply_op(T)), apply_args(T)); - call -> - fold_list(F, fold(F, fold(F, S, call_module(T)), - call_name(T)), - call_args(T)); - primop -> - fold_list(F, fold(F, S, primop_name(T)), primop_args(T)); - 'case' -> - fold_list(F, fold(F, S, case_arg(T)), case_clauses(T)); - clause -> - fold(F, fold(F, fold_list(F, S, clause_pats(T)), - clause_guard(T)), - clause_body(T)); - alias -> - fold(F, fold(F, S, alias_var(T)), alias_pat(T)); - 'fun' -> - fold(F, fold_list(F, S, fun_vars(T)), fun_body(T)); - 'receive' -> - fold(F, fold(F, fold_list(F, S, receive_clauses(T)), - receive_timeout(T)), - receive_action(T)); - 'try' -> - fold(F, fold_list(F, fold(F, fold_list(F, fold(F, S, try_arg(T)), - try_vars(T)), - try_body(T)), - try_evars(T)), - try_handler(T)); - 'catch' -> - fold(F, S, catch_body(T)); - binary -> - fold_list(F, S, binary_segments(T)); - bitstr -> - fold(F, - fold(F, - fold(F, - fold(F, - fold(F, S, bitstr_val(T)), - bitstr_size(T)), - bitstr_unit(T)), - bitstr_type(T)), - bitstr_flags(T)); - letrec -> - fold(F, fold_pairs(F, S, letrec_defs(T)), letrec_body(T)); - module -> - fold_pairs(F, - fold_pairs(F, - fold_list(F, - fold(F, S, module_name(T)), - module_exports(T)), - module_attrs(T)), - module_defs(T)) - end. - -fold_list(F, S, [T | Ts]) -> - fold_list(F, fold(F, S, T), Ts); -fold_list(_, S, []) -> - S. - -fold_pairs(F, S, [{T1, T2} | Ps]) -> - fold_pairs(F, fold(F, fold(F, S, T1), T2), Ps); -fold_pairs(_, S, []) -> - S. - - -%% @spec mapfold(Function, Initial::term(), Tree::cerl()) -> -%% {cerl(), term()} -%% -%% Function = (cerl(), term()) -> {cerl(), term()} -%% -%% @doc Does a combined map/fold operation on the nodes of the -%% tree. This is similar to <code>map/2</code>, but also propagates a -%% value from each application of <code>Function</code> to the next, -%% starting with the given value <code>Initial</code>, while doing a -%% post-order traversal of the tree, much like <code>fold/3</code>. -%% -%% @see map/2 -%% @see fold/3 - -mapfold(F, S0, T) -> - case type(T) of - literal -> - case concrete(T) of - [_ | _] -> - {T1, S1} = mapfold(F, S0, cons_hd(T)), - {T2, S2} = mapfold(F, S1, cons_tl(T)), - F(update_c_cons(T, T1, T2), S2); - V when tuple_size(V) > 0 -> - {Ts, S1} = mapfold_list(F, S0, tuple_es(T)), - F(update_c_tuple(T, Ts), S1); - _ -> - F(T, S0) - end; - var -> - F(T, S0); - values -> - {Ts, S1} = mapfold_list(F, S0, values_es(T)), - F(update_c_values(T, Ts), S1); - cons -> - {T1, S1} = mapfold(F, S0, cons_hd(T)), - {T2, S2} = mapfold(F, S1, cons_tl(T)), - F(update_c_cons_skel(T, T1, T2), S2); - tuple -> - {Ts, S1} = mapfold_list(F, S0, tuple_es(T)), - F(update_c_tuple_skel(T, Ts), S1); - 'let' -> - {Vs, S1} = mapfold_list(F, S0, let_vars(T)), - {A, S2} = mapfold(F, S1, let_arg(T)), - {B, S3} = mapfold(F, S2, let_body(T)), - F(update_c_let(T, Vs, A, B), S3); - seq -> - {A, S1} = mapfold(F, S0, seq_arg(T)), - {B, S2} = mapfold(F, S1, seq_body(T)), - F(update_c_seq(T, A, B), S2); - apply -> - {E, S1} = mapfold(F, S0, apply_op(T)), - {As, S2} = mapfold_list(F, S1, apply_args(T)), - F(update_c_apply(T, E, As), S2); - call -> - {M, S1} = mapfold(F, S0, call_module(T)), - {N, S2} = mapfold(F, S1, call_name(T)), - {As, S3} = mapfold_list(F, S2, call_args(T)), - F(update_c_call(T, M, N, As), S3); - primop -> - {N, S1} = mapfold(F, S0, primop_name(T)), - {As, S2} = mapfold_list(F, S1, primop_args(T)), - F(update_c_primop(T, N, As), S2); - 'case' -> - {A, S1} = mapfold(F, S0, case_arg(T)), - {Cs, S2} = mapfold_list(F, S1, case_clauses(T)), - F(update_c_case(T, A, Cs), S2); - clause -> - {Ps, S1} = mapfold_list(F, S0, clause_pats(T)), - {G, S2} = mapfold(F, S1, clause_guard(T)), - {B, S3} = mapfold(F, S2, clause_body(T)), - F(update_c_clause(T, Ps, G, B), S3); - alias -> - {V, S1} = mapfold(F, S0, alias_var(T)), - {P, S2} = mapfold(F, S1, alias_pat(T)), - F(update_c_alias(T, V, P), S2); - 'fun' -> - {Vs, S1} = mapfold_list(F, S0, fun_vars(T)), - {B, S2} = mapfold(F, S1, fun_body(T)), - F(update_c_fun(T, Vs, B), S2); - 'receive' -> - {Cs, S1} = mapfold_list(F, S0, receive_clauses(T)), - {E, S2} = mapfold(F, S1, receive_timeout(T)), - {A, S3} = mapfold(F, S2, receive_action(T)), - F(update_c_receive(T, Cs, E, A), S3); - 'try' -> - {E, S1} = mapfold(F, S0, try_arg(T)), - {Vs, S2} = mapfold_list(F, S1, try_vars(T)), - {B, S3} = mapfold(F, S2, try_body(T)), - {Evs, S4} = mapfold_list(F, S3, try_evars(T)), - {H, S5} = mapfold(F, S4, try_handler(T)), - F(update_c_try(T, E, Vs, B, Evs, H), S5); - 'catch' -> - {B, S1} = mapfold(F, S0, catch_body(T)), - F(update_c_catch(T, B), S1); - binary -> - {Ds, S1} = mapfold_list(F, S0, binary_segments(T)), - F(update_c_binary(T, Ds), S1); - bitstr -> - {Val, S1} = mapfold(F, S0, bitstr_val(T)), - {Size, S2} = mapfold(F, S1, bitstr_size(T)), - {Unit, S3} = mapfold(F, S2, bitstr_unit(T)), - {Type, S4} = mapfold(F, S3, bitstr_type(T)), - {Flags, S5} = mapfold(F, S4, bitstr_flags(T)), - F(update_c_bitstr(T, Val, Size, Unit, Type, Flags), S5); - letrec -> - {Ds, S1} = mapfold_pairs(F, S0, letrec_defs(T)), - {B, S2} = mapfold(F, S1, letrec_body(T)), - F(update_c_letrec(T, Ds, B), S2); - module -> - {N, S1} = mapfold(F, S0, module_name(T)), - {Es, S2} = mapfold_list(F, S1, module_exports(T)), - {As, S3} = mapfold_pairs(F, S2, module_attrs(T)), - {Ds, S4} = mapfold_pairs(F, S3, module_defs(T)), - F(update_c_module(T, N, Es, As, Ds), S4) - end. - -mapfold_list(F, S0, [T | Ts]) -> - {T1, S1} = mapfold(F, S0, T), - {Ts1, S2} = mapfold_list(F, S1, Ts), - {[T1 | Ts1], S2}; -mapfold_list(_, S, []) -> - {[], S}. - -mapfold_pairs(F, S0, [{T1, T2} | Ps]) -> - {T3, S1} = mapfold(F, S0, T1), - {T4, S2} = mapfold(F, S1, T2), - {Ps1, S3} = mapfold_pairs(F, S2, Ps), - {[{T3, T4} | Ps1], S3}; -mapfold_pairs(_, S, []) -> - {[], S}. - - -%% --------------------------------------------------------------------- - -%% @spec variables(Tree::cerl()) -> [var_name()] -%% -%% var_name() = integer() | atom() | {atom(), integer()} -%% -%% @doc Returns an ordered-set list of the names of all variables in -%% the syntax tree. (This includes function name variables.) An -%% exception is thrown if <code>Tree</code> does not represent a -%% well-formed Core Erlang syntax tree. -%% -%% @see free_variables/1 - -variables(T) -> - variables(T, false). - - -%% @spec free_variables(Tree::cerl()) -> [var_name()] -%% -%% @doc Like <code>variables/1</code>, but only includes variables -%% that are free in the tree. -%% -%% @see variables/1 - -free_variables(T) -> - variables(T, true). - - -%% This is not exported - -variables(T, S) -> - case type(T) of - literal -> - []; - var -> - [var_name(T)]; - values -> - vars_in_list(values_es(T), S); - cons -> - ordsets:union(variables(cons_hd(T), S), - variables(cons_tl(T), S)); - tuple -> - vars_in_list(tuple_es(T), S); - 'let' -> - Vs = variables(let_body(T), S), - Vs1 = var_list_names(let_vars(T)), - Vs2 = case S of - true -> - ordsets:subtract(Vs, Vs1); - false -> - ordsets:union(Vs, Vs1) - end, - ordsets:union(variables(let_arg(T), S), Vs2); - seq -> - ordsets:union(variables(seq_arg(T), S), - variables(seq_body(T), S)); - apply -> - ordsets:union( - variables(apply_op(T), S), - vars_in_list(apply_args(T), S)); - call -> - ordsets:union(variables(call_module(T), S), - ordsets:union( - variables(call_name(T), S), - vars_in_list(call_args(T), S))); - primop -> - vars_in_list(primop_args(T), S); - 'case' -> - ordsets:union(variables(case_arg(T), S), - vars_in_list(case_clauses(T), S)); - clause -> - Vs = ordsets:union(variables(clause_guard(T), S), - variables(clause_body(T), S)), - Vs1 = vars_in_list(clause_pats(T), S), - case S of - true -> - ordsets:subtract(Vs, Vs1); - false -> - ordsets:union(Vs, Vs1) - end; - alias -> - ordsets:add_element(var_name(alias_var(T)), - variables(alias_pat(T))); - 'fun' -> - Vs = variables(fun_body(T), S), - Vs1 = var_list_names(fun_vars(T)), - case S of - true -> - ordsets:subtract(Vs, Vs1); - false -> - ordsets:union(Vs, Vs1) - end; - 'receive' -> - ordsets:union( - vars_in_list(receive_clauses(T), S), - ordsets:union(variables(receive_timeout(T), S), - variables(receive_action(T), S))); - 'try' -> - Vs = variables(try_body(T), S), - Vs1 = var_list_names(try_vars(T)), - Vs2 = case S of - true -> - ordsets:subtract(Vs, Vs1); - false -> - ordsets:union(Vs, Vs1) - end, - Vs3 = variables(try_handler(T), S), - Vs4 = var_list_names(try_evars(T)), - Vs5 = case S of - true -> - ordsets:subtract(Vs3, Vs4); - false -> - ordsets:union(Vs3, Vs4) - end, - ordsets:union(variables(try_arg(T), S), - ordsets:union(Vs2, Vs5)); - 'catch' -> - variables(catch_body(T), S); - binary -> - vars_in_list(binary_segments(T), S); - bitstr -> - ordsets:union(variables(bitstr_val(T), S), - variables(bitstr_size(T), S)); - letrec -> - Vs = vars_in_defs(letrec_defs(T), S), - Vs1 = ordsets:union(variables(letrec_body(T), S), Vs), - Vs2 = var_list_names(letrec_vars(T)), - case S of - true -> - ordsets:subtract(Vs1, Vs2); - false -> - ordsets:union(Vs1, Vs2) - end; - module -> - Vs = vars_in_defs(module_defs(T), S), - Vs1 = ordsets:union(vars_in_list(module_exports(T), S), Vs), - Vs2 = var_list_names(module_vars(T)), - case S of - true -> - ordsets:subtract(Vs1, Vs2); - false -> - ordsets:union(Vs1, Vs2) - end - end. - -vars_in_list(Ts, S) -> - vars_in_list(Ts, S, []). - -vars_in_list([T | Ts], S, A) -> - vars_in_list(Ts, S, ordsets:union(variables(T, S), A)); -vars_in_list([], _, A) -> - A. - -%% Note that this function only visits the right-hand side of function -%% definitions. - -vars_in_defs(Ds, S) -> - vars_in_defs(Ds, S, []). - -vars_in_defs([{_, F} | Ds], S, A) -> - vars_in_defs(Ds, S, ordsets:union(variables(F, S), A)); -vars_in_defs([], _, A) -> - A. - -%% This amounts to insertion sort. Since the lists are generally short, -%% it is hardly worthwhile to use an asymptotically better sort. - -var_list_names(Vs) -> - var_list_names(Vs, []). - -var_list_names([V | Vs], A) -> - var_list_names(Vs, ordsets:add_element(var_name(V), A)); -var_list_names([], A) -> - A. - - -%% --------------------------------------------------------------------- - -%% label(Tree::cerl()) -> {cerl(), integer()} -%% -%% @equiv label(Tree, 0) - -label(T) -> - label(T, 0). - -%% @spec label(Tree::cerl(), N::integer()) -> {cerl(), integer()} -%% -%% @doc Labels each expression in the tree. A term <code>{label, -%% L}</code> is prefixed to the annotation list of each expression node, -%% where L is a unique number for every node, except for variables (and -%% function name variables) which get the same label if they represent -%% the same variable. Constant literal nodes are not labeled. -%% -%% <p>The returned value is a tuple <code>{NewTree, Max}</code>, where -%% <code>NewTree</code> is the labeled tree and <code>Max</code> is 1 -%% plus the largest label value used. All previous annotation terms on -%% the form <code>{label, X}</code> are deleted.</p> -%% -%% <p>The values of L used in the tree is a dense range from -%% <code>N</code> to <code>Max - 1</code>, where <code>N =< Max -%% =< N + size(Tree)</code>. Note that it is possible that no -%% labels are used at all, i.e., <code>N = Max</code>.</p> -%% -%% <p>Note: All instances of free variables will be given distinct -%% labels.</p> -%% -%% @see label/1 -%% @see size/1 - -label(T, N) -> - label(T, N, dict:new()). - -label(T, N, Env) -> - case type(T) of - literal -> - %% Constant literals are not labeled. - {T, N}; - var -> - case dict:find(var_name(T), Env) of - {ok, L} -> - {As, _} = label_ann(T, L), - N1 = N; - error -> - {As, N1} = label_ann(T, N) - end, - {set_ann(T, As), N1}; - values -> - {Ts, N1} = label_list(values_es(T), N, Env), - {As, N2} = label_ann(T, N1), - {ann_c_values(As, Ts), N2}; - cons -> - {T1, N1} = label(cons_hd(T), N, Env), - {T2, N2} = label(cons_tl(T), N1, Env), - {As, N3} = label_ann(T, N2), - {ann_c_cons_skel(As, T1, T2), N3}; - tuple -> - {Ts, N1} = label_list(tuple_es(T), N, Env), - {As, N2} = label_ann(T, N1), - {ann_c_tuple_skel(As, Ts), N2}; - 'let' -> - {A, N1} = label(let_arg(T), N, Env), - {Vs, N2, Env1} = label_vars(let_vars(T), N1, Env), - {B, N3} = label(let_body(T), N2, Env1), - {As, N4} = label_ann(T, N3), - {ann_c_let(As, Vs, A, B), N4}; - seq -> - {A, N1} = label(seq_arg(T), N, Env), - {B, N2} = label(seq_body(T), N1, Env), - {As, N3} = label_ann(T, N2), - {ann_c_seq(As, A, B), N3}; - apply -> - {E, N1} = label(apply_op(T), N, Env), - {Es, N2} = label_list(apply_args(T), N1, Env), - {As, N3} = label_ann(T, N2), - {ann_c_apply(As, E, Es), N3}; - call -> - {M, N1} = label(call_module(T), N, Env), - {F, N2} = label(call_name(T), N1, Env), - {Es, N3} = label_list(call_args(T), N2, Env), - {As, N4} = label_ann(T, N3), - {ann_c_call(As, M, F, Es), N4}; - primop -> - {F, N1} = label(primop_name(T), N, Env), - {Es, N2} = label_list(primop_args(T), N1, Env), - {As, N3} = label_ann(T, N2), - {ann_c_primop(As, F, Es), N3}; - 'case' -> - {A, N1} = label(case_arg(T), N, Env), - {Cs, N2} = label_list(case_clauses(T), N1, Env), - {As, N3} = label_ann(T, N2), - {ann_c_case(As, A, Cs), N3}; - clause -> - {_, N1, Env1} = label_vars(clause_vars(T), N, Env), - {Ps, N2} = label_list(clause_pats(T), N1, Env1), - {G, N3} = label(clause_guard(T), N2, Env1), - {B, N4} = label(clause_body(T), N3, Env1), - {As, N5} = label_ann(T, N4), - {ann_c_clause(As, Ps, G, B), N5}; - alias -> - {V, N1} = label(alias_var(T), N, Env), - {P, N2} = label(alias_pat(T), N1, Env), - {As, N3} = label_ann(T, N2), - {ann_c_alias(As, V, P), N3}; - 'fun' -> - {Vs, N1, Env1} = label_vars(fun_vars(T), N, Env), - {B, N2} = label(fun_body(T), N1, Env1), - {As, N3} = label_ann(T, N2), - {ann_c_fun(As, Vs, B), N3}; - 'receive' -> - {Cs, N1} = label_list(receive_clauses(T), N, Env), - {E, N2} = label(receive_timeout(T), N1, Env), - {A, N3} = label(receive_action(T), N2, Env), - {As, N4} = label_ann(T, N3), - {ann_c_receive(As, Cs, E, A), N4}; - 'try' -> - {E, N1} = label(try_arg(T), N, Env), - {Vs, N2, Env1} = label_vars(try_vars(T), N1, Env), - {B, N3} = label(try_body(T), N2, Env1), - {Evs, N4, Env2} = label_vars(try_evars(T), N3, Env), - {H, N5} = label(try_handler(T), N4, Env2), - {As, N6} = label_ann(T, N5), - {ann_c_try(As, E, Vs, B, Evs, H), N6}; - 'catch' -> - {B, N1} = label(catch_body(T), N, Env), - {As, N2} = label_ann(T, N1), - {ann_c_catch(As, B), N2}; - binary -> - {Ds, N1} = label_list(binary_segments(T), N, Env), - {As, N2} = label_ann(T, N1), - {ann_c_binary(As, Ds), N2}; - bitstr -> - {Val, N1} = label(bitstr_val(T), N, Env), - {Size, N2} = label(bitstr_size(T), N1, Env), - {Unit, N3} = label(bitstr_unit(T), N2, Env), - {Type, N4} = label(bitstr_type(T), N3, Env), - {Flags, N5} = label(bitstr_flags(T), N4, Env), - {As, N6} = label_ann(T, N5), - {ann_c_bitstr(As, Val, Size, Unit, Type, Flags), N6}; - letrec -> - {_, N1, Env1} = label_vars(letrec_vars(T), N, Env), - {Ds, N2} = label_defs(letrec_defs(T), N1, Env1), - {B, N3} = label(letrec_body(T), N2, Env1), - {As, N4} = label_ann(T, N3), - {ann_c_letrec(As, Ds, B), N4}; - module -> - %% The module name is not labeled. - {_, N1, Env1} = label_vars(module_vars(T), N, Env), - {Ts, N2} = label_defs(module_attrs(T), N1, Env1), - {Ds, N3} = label_defs(module_defs(T), N2, Env1), - {Es, N4} = label_list(module_exports(T), N3, Env1), - {As, N5} = label_ann(T, N4), - {ann_c_module(As, module_name(T), Es, Ts, Ds), N5} - end. - -label_list([T | Ts], N, Env) -> - {T1, N1} = label(T, N, Env), - {Ts1, N2} = label_list(Ts, N1, Env), - {[T1 | Ts1], N2}; -label_list([], N, _Env) -> - {[], N}. - -label_vars([T | Ts], N, Env) -> - Env1 = dict:store(var_name(T), N, Env), - {As, N1} = label_ann(T, N), - T1 = set_ann(T, As), - {Ts1, N2, Env2} = label_vars(Ts, N1, Env1), - {[T1 | Ts1], N2, Env2}; -label_vars([], N, Env) -> - {[], N, Env}. - -label_defs([{F, T} | Ds], N, Env) -> - {F1, N1} = label(F, N, Env), - {T1, N2} = label(T, N1, Env), - {Ds1, N3} = label_defs(Ds, N2, Env), - {[{F1, T1} | Ds1], N3}; -label_defs([], N, _Env) -> - {[], N}. - -label_ann(T, N) -> - {[{label, N} | filter_labels(get_ann(T))], N + 1}. - -filter_labels([{label, _} | As]) -> - filter_labels(As); -filter_labels([A | As]) -> - [A | filter_labels(As)]; -filter_labels([]) -> - []. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/compile.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/compile.erl deleted file mode 100644 index 4542bf9eb9..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/compile.erl +++ /dev/null @@ -1,1109 +0,0 @@ -%% ``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 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. -%% -%% 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: compile.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $ -%% -%% Purpose: Run the Erlang compiler. - --module(compile). --include("erl_compile.hrl"). --include("core_parse.hrl"). - -%% High-level interface. --export([file/1,file/2,format_error/1,iofile/1]). --export([forms/1,forms/2]). --export([output_generated/1]). --export([options/0]). - -%% Erlc interface. --export([compile/3,compile_beam/3,compile_asm/3,compile_core/3]). - - --import(lists, [member/2,reverse/1,keysearch/3,last/1, - map/2,flatmap/2,foreach/2,foldr/3,any/2,filter/2]). - -%% file(FileName) -%% file(FileName, Options) -%% Compile the module in file FileName. - --define(DEFAULT_OPTIONS, [verbose,report_errors,report_warnings]). - --define(pass(P), {P,fun P/1}). - -file(File) -> file(File, ?DEFAULT_OPTIONS). - -file(File, Opts) when list(Opts) -> - do_compile({file,File}, Opts++env_default_opts()); -file(File, Opt) -> - file(File, [Opt|?DEFAULT_OPTIONS]). - -forms(File) -> forms(File, ?DEFAULT_OPTIONS). - -forms(Forms, Opts) when list(Opts) -> - do_compile({forms,Forms}, [binary|Opts++env_default_opts()]); -forms(Forms, Opts) when atom(Opts) -> - forms(Forms, [Opts|?DEFAULT_OPTIONS]). - -env_default_opts() -> - Key = "ERL_COMPILER_OPTIONS", - case os:getenv(Key) of - false -> []; - Str when list(Str) -> - case erl_scan:string(Str) of - {ok,Tokens,_} -> - case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of - {ok,List} when list(List) -> List; - {ok,Term} -> [Term]; - {error,_Reason} -> - io:format("Ignoring bad term in ~s\n", [Key]), - [] - end; - {error, {_,_,_Reason}, _} -> - io:format("Ignoring bad term in ~s\n", [Key]), - [] - end - end. - -do_compile(Input, Opts0) -> - Opts = expand_opts(Opts0), - Self = self(), - Serv = spawn_link(fun() -> internal(Self, Input, Opts) end), - receive - {Serv,Rep} -> Rep - end. - -%% Given a list of compilation options, returns true if compile:file/2 -%% would have generated a Beam file, false otherwise (if only a binary or a -%% listing file would have been generated). - -output_generated(Opts) -> - any(fun ({save_binary,_F}) -> true; - (_Other) -> false - end, passes(file, expand_opts(Opts))). - -expand_opts(Opts) -> - foldr(fun expand_opt/2, [], Opts). - -expand_opt(basic_validation, Os) -> - [no_code_generation,to_pp,binary|Os]; -expand_opt(strong_validation, Os) -> - [no_code_generation,to_kernel,binary|Os]; -expand_opt(report, Os) -> - [report_errors,report_warnings|Os]; -expand_opt(return, Os) -> - [return_errors,return_warnings|Os]; -expand_opt(r7, Os) -> - [no_float_opt,no_new_funs,no_new_binaries,no_new_apply|Os]; -expand_opt(O, Os) -> [O|Os]. - -filter_opts(Opts0) -> - %% Native code generation is not supported if no_new_funs is given. - case member(no_new_funs, Opts0) of - false -> Opts0; - true -> Opts0 -- [native] - end. - -%% format_error(ErrorDescriptor) -> string() - -format_error(no_native_support) -> - "this system is not configured for native-code compilation."; -format_error({native, E}) -> - io_lib:fwrite("native-code compilation failed with reason: ~P.", - [E, 25]); -format_error({native_crash, E}) -> - io_lib:fwrite("native-code compilation crashed with reason: ~P.", - [E, 25]); -format_error({open,E}) -> - io_lib:format("open error '~s'", [file:format_error(E)]); -format_error({epp,E}) -> - epp:format_error(E); -format_error(write_error) -> - "error writing file"; -format_error({rename,S}) -> - io_lib:format("error renaming ~s", [S]); -format_error({parse_transform,M,R}) -> - io_lib:format("error in parse transform '~s': ~p", [M, R]); -format_error({core_transform,M,R}) -> - io_lib:format("error in core transform '~s': ~p", [M, R]); -format_error({crash,Pass,Reason}) -> - io_lib:format("internal error in ~p;\ncrash reason: ~p", [Pass,Reason]); -format_error({bad_return,Pass,Reason}) -> - io_lib:format("internal error in ~p;\nbad return value: ~p", [Pass,Reason]). - -%% The compile state record. --record(compile, {filename="", - dir="", - base="", - ifile="", - ofile="", - module=[], - code=[], - core_code=[], - abstract_code=[], %Abstract code for debugger. - options=[], - errors=[], - warnings=[]}). - -internal(Master, Input, Opts) -> - Master ! {self(), - case catch internal(Input, Opts) of - {'EXIT', Reason} -> - {error, Reason}; - Other -> - Other - end}. - -internal({forms,Forms}, Opts) -> - Ps = passes(forms, Opts), - internal_comp(Ps, "", "", #compile{code=Forms,options=Opts}); -internal({file,File}, Opts) -> - Ps = passes(file, Opts), - Compile = #compile{options=Opts}, - case member(from_core, Opts) of - true -> internal_comp(Ps, File, ".core", Compile); - false -> - case member(from_beam, Opts) of - true -> - internal_comp(Ps, File, ".beam", Compile); - false -> - case member(from_asm, Opts) orelse member(asm, Opts) of - true -> - internal_comp(Ps, File, ".S", Compile); - false -> - internal_comp(Ps, File, ".erl", Compile) - end - end - end. - -internal_comp(Passes, File, Suffix, St0) -> - Dir = filename:dirname(File), - Base = filename:basename(File, Suffix), - St1 = St0#compile{filename=File, dir=Dir, base=Base, - ifile=erlfile(Dir, Base, Suffix), - ofile=objfile(Base, St0)}, - Run = case member(time, St1#compile.options) of - true -> - io:format("Compiling ~p\n", [File]), - fun run_tc/2; - false -> fun({_Name,Fun}, St) -> catch Fun(St) end - end, - case fold_comp(Passes, Run, St1) of - {ok,St2} -> comp_ret_ok(St2); - {error,St2} -> comp_ret_err(St2) - end. - -fold_comp([{Name,Test,Pass}|Ps], Run, St) -> - case Test(St) of - false -> %Pass is not needed. - fold_comp(Ps, Run, St); - true -> %Run pass in the usual way. - fold_comp([{Name,Pass}|Ps], Run, St) - end; -fold_comp([{Name,Pass}|Ps], Run, St0) -> - case Run({Name,Pass}, St0) of - {ok,St1} -> fold_comp(Ps, Run, St1); - {error,St1} -> {error,St1}; - {'EXIT',Reason} -> - Es = [{St0#compile.ifile,[{none,?MODULE,{crash,Name,Reason}}]}], - {error,St0#compile{errors=St0#compile.errors ++ Es}}; - Other -> - Es = [{St0#compile.ifile,[{none,?MODULE,{bad_return,Name,Other}}]}], - {error,St0#compile{errors=St0#compile.errors ++ Es}} - end; -fold_comp([], _Run, St) -> {ok,St}. - -os_process_size() -> - case os:type() of - {unix, sunos} -> - Size = os:cmd("ps -o vsz -p " ++ os:getpid() ++ " | tail -1"), - list_to_integer(lib:nonl(Size)); - _ -> - 0 - end. - -run_tc({Name,Fun}, St) -> - Before0 = statistics(runtime), - Val = (catch Fun(St)), - After0 = statistics(runtime), - {Before_c, _} = Before0, - {After_c, _} = After0, - io:format(" ~-30s: ~10.3f s (~w k)\n", - [Name, (After_c-Before_c) / 1000, os_process_size()]), - Val. - -comp_ret_ok(#compile{code=Code,warnings=Warn,module=Mod,options=Opts}=St) -> - report_warnings(St), - Ret1 = case member(binary, Opts) andalso not member(no_code_generation, Opts) of - true -> [Code]; - false -> [] - end, - Ret2 = case member(return_warnings, Opts) of - true -> Ret1 ++ [Warn]; - false -> Ret1 - end, - list_to_tuple([ok,Mod|Ret2]). - -comp_ret_err(St) -> - report_errors(St), - report_warnings(St), - case member(return_errors, St#compile.options) of - true -> {error,St#compile.errors,St#compile.warnings}; - false -> error - end. - -%% passes(form|file, [Option]) -> [{Name,PassFun}] -%% Figure out which passes that need to be run. - -passes(forms, Opts) -> - select_passes(standard_passes(), Opts); -passes(file, Opts) -> - case member(from_beam, Opts) of - true -> - Ps = [?pass(read_beam_file)|binary_passes()], - select_passes(Ps, Opts); - false -> - Ps = case member(from_asm, Opts) orelse member(asm, Opts) of - true -> - [?pass(beam_consult_asm)|asm_passes()]; - false -> - case member(from_core, Opts) of - true -> - [?pass(parse_core)|core_passes()]; - false -> - [?pass(parse_module)|standard_passes()] - end - end, - Fs = select_passes(Ps, Opts), - - %% If the last pass saves the resulting binary to a file, - %% insert a first pass to remove the file. - case last(Fs) of - {save_binary,_Fun} -> [?pass(remove_file)|Fs]; - _Other -> Fs - end - end. - -%% select_passes([Command], Opts) -> [{Name,Function}] -%% Interpret the lists of commands to return a pure list of passes. -%% -%% Command can be one of: -%% -%% {pass,Mod} Will be expanded to a call to the external -%% function Mod:module(Code, Options). This -%% function must transform the code and return -%% {ok,NewCode} or {error,Term}. -%% Example: {pass,beam_codegen} -%% -%% {Name,Fun} Name is an atom giving the name of the pass. -%% Fun is an 'fun' taking one argument: a compile record. -%% The fun should return {ok,NewCompileRecord} or -%% {error,NewCompileRecord}. -%% Note: ?pass(Name) is equvivalent to {Name,fun Name/1}. -%% Example: ?pass(parse_module) -%% -%% {Name,Test,Fun} Like {Name,Fun} above, but the pass will be run -%% (and listed by the `time' option) only if Test(St) -%% returns true. -%% -%% {src_listing,Ext} Produces an Erlang source listing with the -%% the file extension Ext. (Ext should not contain -%% a period.) No more passes will be run. -%% -%% {listing,Ext} Produce an listing of the terms in the internal -%% representation. The extension of the listing -%% file will be Ext. (Ext should not contain -%% a period.) No more passes will be run. -%% -%% {done,Ext} End compilation at this point. Produce a listing -%% as with {listing,Ext}, unless 'binary' is -%% specified, in which case the current -%% representation of the code is returned without -%% creating an output file. -%% -%% {iff,Flag,Cmd} If the given Flag is given in the option list, -%% Cmd will be interpreted as a command. -%% Otherwise, Cmd will be ignored. -%% Example: {iff,dcg,{listing,"codegen}} -%% -%% {unless,Flag,Cmd} If the given Flag is NOT given in the option list, -%% Cmd will be interpreted as a command. -%% Otherwise, Cmd will be ignored. -%% Example: {unless,no_kernopt,{pass,sys_kernopt}} -%% - -select_passes([{pass,Mod}|Ps], Opts) -> - F = fun(St) -> - case catch Mod:module(St#compile.code, St#compile.options) of - {ok,Code} -> - {ok,St#compile{code=Code}}; - {error,Es} -> - {error,St#compile{errors=St#compile.errors ++ Es}} - end - end, - [{Mod,F}|select_passes(Ps, Opts)]; -select_passes([{src_listing,Ext}|_], _Opts) -> - [{listing,fun (St) -> src_listing(Ext, St) end}]; -select_passes([{listing,Ext}|_], _Opts) -> - [{listing,fun (St) -> listing(Ext, St) end}]; -select_passes([{done,Ext}|_], Opts) -> - select_passes([{unless,binary,{listing,Ext}}], Opts); -select_passes([{iff,Flag,Pass}|Ps], Opts) -> - select_cond(Flag, true, Pass, Ps, Opts); -select_passes([{unless,Flag,Pass}|Ps], Opts) -> - select_cond(Flag, false, Pass, Ps, Opts); -select_passes([{_,Fun}=P|Ps], Opts) when is_function(Fun) -> - [P|select_passes(Ps, Opts)]; -select_passes([{_,Test,Fun}=P|Ps], Opts) when is_function(Test), - is_function(Fun) -> - [P|select_passes(Ps, Opts)]; -select_passes([], _Opts) -> - []; -select_passes([List|Ps], Opts) when is_list(List) -> - case select_passes(List, Opts) of - [] -> select_passes(Ps, Opts); - Nested -> - case last(Nested) of - {listing,_Fun} -> Nested; - _Other -> Nested ++ select_passes(Ps, Opts) - end - end. - -select_cond(Flag, ShouldBe, Pass, Ps, Opts) -> - ShouldNotBe = not ShouldBe, - case member(Flag, Opts) of - ShouldBe -> select_passes([Pass|Ps], Opts); - ShouldNotBe -> select_passes(Ps, Opts) - end. - -%% The standard passes (almost) always run. - -standard_passes() -> - [?pass(transform_module), - {iff,'dpp',{listing,"pp"}}, - ?pass(lint_module), - {iff,'P',{src_listing,"P"}}, - {iff,'to_pp',{done,"P"}}, - - {iff,'dabstr',{listing,"abstr"}}, - {iff,debug_info,?pass(save_abstract_code)}, - - ?pass(expand_module), - {iff,'dexp',{listing,"expand"}}, - {iff,'E',{src_listing,"E"}}, - {iff,'to_exp',{done,"E"}}, - - %% Conversion to Core Erlang. - ?pass(core_module), - {iff,'dcore',{listing,"core"}}, - {iff,'to_core0',{done,"core"}} - | core_passes()]. - -core_passes() -> - %% Optimization and transforms of Core Erlang code. - [{unless,no_copt, - [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/1}, - ?pass(core_fold_module), - {core_inline_module,fun test_core_inliner/1,fun core_inline_module/1}, - {core_fold_after_inline,fun test_core_inliner/1,fun core_fold_module/1}, - ?pass(core_transforms)]}, - {iff,dcopt,{listing,"copt"}}, - {iff,'to_core',{done,"core"}} - | kernel_passes()]. - -kernel_passes() -> - %% Destructive setelement/3 optimization and core lint. - [?pass(core_dsetel_module), - {iff,clint,?pass(core_lint_module)}, - {iff,core,?pass(save_core_code)}, - - %% Kernel Erlang and code generation. - ?pass(kernel_module), - {iff,dkern,{listing,"kernel"}}, - {iff,'to_kernel',{done,"kernel"}}, - {pass,v3_life}, - {iff,dlife,{listing,"life"}}, - {pass,v3_codegen}, - {iff,dcg,{listing,"codegen"}} - | asm_passes()]. - -asm_passes() -> - %% Assembly level optimisations. - [{unless,no_postopt, - [{pass,beam_block}, - {iff,dblk,{listing,"block"}}, - {unless,no_bopt,{pass,beam_bool}}, - {iff,dbool,{listing,"bool"}}, - {unless,no_topt,{pass,beam_type}}, - {iff,dtype,{listing,"type"}}, - {pass,beam_dead}, %Must always run since it splits blocks. - {iff,ddead,{listing,"dead"}}, - {unless,no_jopt,{pass,beam_jump}}, - {iff,djmp,{listing,"jump"}}, - {pass,beam_clean}, - {iff,dclean,{listing,"clean"}}, - {pass,beam_flatten}]}, - - %% If post optimizations are turned off, we still coalesce - %% adjacent labels and remove unused labels to keep the - %% HiPE compiler happy. - {iff,no_postopt, - [?pass(beam_unused_labels), - {pass,beam_clean}]}, - - {iff,dopt,{listing,"optimize"}}, - {iff,'S',{listing,"S"}}, - {iff,'to_asm',{done,"S"}}, - - {pass,beam_validator}, - ?pass(beam_asm) - | binary_passes()]. - -binary_passes() -> - [{native_compile,fun test_native/1,fun native_compile/1}, - {unless,binary,?pass(save_binary)}]. - -%%% -%%% Compiler passes. -%%% - -%% Remove the target file so we don't have an old one if the compilation fail. -remove_file(St) -> - file:delete(St#compile.ofile), - {ok,St}. - --record(asm_module, {module, - exports, - labels, - functions=[], - cfun, - code, - attributes=[]}). - -preprocess_asm_forms(Forms) -> - R = #asm_module{}, - R1 = collect_asm(Forms, R), - {R1#asm_module.module, - {R1#asm_module.module, - R1#asm_module.exports, - R1#asm_module.attributes, - R1#asm_module.functions, - R1#asm_module.labels}}. - -collect_asm([], R) -> - case R#asm_module.cfun of - undefined -> - R; - {A,B,C} -> - R#asm_module{functions=R#asm_module.functions++ - [{function,A,B,C,R#asm_module.code}]} - end; -collect_asm([{module,M} | Rest], R) -> - collect_asm(Rest, R#asm_module{module=M}); -collect_asm([{exports,M} | Rest], R) -> - collect_asm(Rest, R#asm_module{exports=M}); -collect_asm([{labels,M} | Rest], R) -> - collect_asm(Rest, R#asm_module{labels=M}); -collect_asm([{function,A,B,C} | Rest], R) -> - R1 = case R#asm_module.cfun of - undefined -> - R; - {A0,B0,C0} -> - R#asm_module{functions=R#asm_module.functions++ - [{function,A0,B0,C0,R#asm_module.code}]} - end, - collect_asm(Rest, R1#asm_module{cfun={A,B,C}, code=[]}); -collect_asm([{attributes, Attr} | Rest], R) -> - collect_asm(Rest, R#asm_module{attributes=Attr}); -collect_asm([X | Rest], R) -> - collect_asm(Rest, R#asm_module{code=R#asm_module.code++[X]}). - -beam_consult_asm(St) -> - case file:consult(St#compile.ifile) of - {ok, Forms0} -> - {Module, Forms} = preprocess_asm_forms(Forms0), - {ok,St#compile{module=Module, code=Forms}}; - {error,E} -> - Es = [{St#compile.ifile,[{none,?MODULE,{open,E}}]}], - {error,St#compile{errors=St#compile.errors ++ Es}} - end. - -read_beam_file(St) -> - case file:read_file(St#compile.ifile) of - {ok,Beam} -> - Infile = St#compile.ifile, - case is_too_old(Infile) of - true -> - {ok,St#compile{module=none,code=none}}; - false -> - Mod0 = filename:rootname(filename:basename(Infile)), - Mod = list_to_atom(Mod0), - {ok,St#compile{module=Mod,code=Beam,ofile=Infile}} - end; - {error,E} -> - Es = [{St#compile.ifile,[{none,?MODULE,{open,E}}]}], - {error,St#compile{errors=St#compile.errors ++ Es}} - end. - -is_too_old(BeamFile) -> - case beam_lib:chunks(BeamFile, ["CInf"]) of - {ok,{_,[{"CInf",Term0}]}} -> - Term = binary_to_term(Term0), - Opts = proplists:get_value(options, Term, []), - lists:member(no_new_funs, Opts); - _ -> false - end. - -parse_module(St) -> - Opts = St#compile.options, - Cwd = ".", - IncludePath = [Cwd, St#compile.dir|inc_paths(Opts)], - Tab = ets:new(compiler__tab, [protected,named_table]), - ets:insert(Tab, {compiler_options,Opts}), - R = epp:parse_file(St#compile.ifile, IncludePath, pre_defs(Opts)), - ets:delete(Tab), - case R of - {ok,Forms} -> - {ok,St#compile{code=Forms}}; - {error,E} -> - Es = [{St#compile.ifile,[{none,?MODULE,{epp,E}}]}], - {error,St#compile{errors=St#compile.errors ++ Es}} - end. - -parse_core(St) -> - case file:read_file(St#compile.ifile) of - {ok,Bin} -> - case core_scan:string(binary_to_list(Bin)) of - {ok,Toks,_} -> - case core_parse:parse(Toks) of - {ok,Mod} -> - Name = (Mod#c_module.name)#c_atom.val, - {ok,St#compile{module=Name,code=Mod}}; - {error,E} -> - Es = [{St#compile.ifile,[E]}], - {error,St#compile{errors=St#compile.errors ++ Es}} - end; - {error,E,_} -> - Es = [{St#compile.ifile,[E]}], - {error,St#compile{errors=St#compile.errors ++ Es}} - end; - {error,E} -> - Es = [{St#compile.ifile,[{none,compile,{open,E}}]}], - {error,St#compile{errors=St#compile.errors ++ Es}} - end. - -compile_options([{attribute,_L,compile,C}|Fs]) when is_list(C) -> - C ++ compile_options(Fs); -compile_options([{attribute,_L,compile,C}|Fs]) -> - [C|compile_options(Fs)]; -compile_options([_F|Fs]) -> compile_options(Fs); -compile_options([]) -> []. - -transforms(Os) -> [ M || {parse_transform,M} <- Os ]. - -transform_module(St) -> - %% Extract compile options from code into options field. - Ts = transforms(St#compile.options ++ compile_options(St#compile.code)), - foldl_transform(St, Ts). - -foldl_transform(St, [T|Ts]) -> - Name = "transform " ++ atom_to_list(T), - Fun = fun(S) -> T:parse_transform(S#compile.code, S#compile.options) end, - Run = case member(time, St#compile.options) of - true -> fun run_tc/2; - false -> fun({_Name,F}, S) -> catch F(S) end - end, - case Run({Name, Fun}, St) of - {error,Es,Ws} -> - {error,St#compile{warnings=St#compile.warnings ++ Ws, - errors=St#compile.errors ++ Es}}; - {'EXIT',R} -> - Es = [{St#compile.ifile,[{none,compile,{parse_transform,T,R}}]}], - {error,St#compile{errors=St#compile.errors ++ Es}}; - Forms -> - foldl_transform(St#compile{code=Forms}, Ts) - end; -foldl_transform(St, []) -> {ok,St}. - -get_core_transforms(Opts) -> [M || {core_transform,M} <- Opts]. - -core_transforms(St) -> - %% The options field holds the complete list of options at this - - Ts = get_core_transforms(St#compile.options), - foldl_core_transforms(St, Ts). - -foldl_core_transforms(St, [T|Ts]) -> - Name = "core transform " ++ atom_to_list(T), - Fun = fun(S) -> T:core_transform(S#compile.code, S#compile.options) end, - Run = case member(time, St#compile.options) of - true -> fun run_tc/2; - false -> fun({_Name,F}, S) -> catch F(S) end - end, - case Run({Name, Fun}, St) of - {'EXIT',R} -> - Es = [{St#compile.ifile,[{none,compile,{core_transform,T,R}}]}], - {error,St#compile{errors=St#compile.errors ++ Es}}; - Forms -> - foldl_core_transforms(St#compile{code=Forms}, Ts) - end; -foldl_core_transforms(St, []) -> {ok,St}. - -%%% Fetches the module name from a list of forms. The module attribute must -%%% be present. -get_module([{attribute,_,module,{M,_As}} | _]) -> M; -get_module([{attribute,_,module,M} | _]) -> M; -get_module([_ | Rest]) -> - get_module(Rest). - -%%% A #compile state is returned, where St.base has been filled in -%%% with the module name from Forms, as a string, in case it wasn't -%%% set in St (i.e., it was ""). -add_default_base(St, Forms) -> - F = St#compile.filename, - case F of - "" -> - M = get_module(Forms), - St#compile{base = atom_to_list(M)}; - _ -> - St - end. - -lint_module(St) -> - case erl_lint:module(St#compile.code, - St#compile.ifile, St#compile.options) of - {ok,Ws} -> - %% Insert name of module as base name, if needed. This is - %% for compile:forms to work with listing files. - St1 = add_default_base(St, St#compile.code), - {ok,St1#compile{warnings=St1#compile.warnings ++ Ws}}; - {error,Es,Ws} -> - {error,St#compile{warnings=St#compile.warnings ++ Ws, - errors=St#compile.errors ++ Es}} - end. - -core_lint_module(St) -> - case core_lint:module(St#compile.code, St#compile.options) of - {ok,Ws} -> - {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; - {error,Es,Ws} -> - {error,St#compile{warnings=St#compile.warnings ++ Ws, - errors=St#compile.errors ++ Es}} - end. - -%% expand_module(State) -> State' -%% Do the common preprocessing of the input forms. - -expand_module(#compile{code=Code,options=Opts0}=St0) -> - {Mod,Exp,Forms,Opts1} = sys_pre_expand:module(Code, Opts0), - Opts2 = expand_opts(Opts1), - Opts = filter_opts(Opts2), - {ok,St0#compile{module=Mod,options=Opts,code={Mod,Exp,Forms}}}. - -core_module(#compile{code=Code0,options=Opts,ifile=File}=St) -> - {ok,Code,Ws} = v3_core:module(Code0, Opts), - {ok,St#compile{code=Code,warnings=St#compile.warnings ++ [{File,Ws}]}}. - -core_fold_module(#compile{code=Code0,options=Opts,ifile=File}=St) -> - {ok,Code,Ws} = sys_core_fold:module(Code0, Opts), - {ok,St#compile{code=Code,warnings=St#compile.warnings ++ [{File,Ws}]}}. - -test_old_inliner(#compile{options=Opts}) -> - %% The point of this test is to avoid loading the old inliner - %% if we know that it will not be used. - case any(fun(no_inline) -> true; - (_) -> false - end, Opts) of - true -> false; - false -> - any(fun({inline,_}) -> true; - (_) -> false - end, Opts) - end. - -test_core_inliner(#compile{options=Opts}) -> - case any(fun(no_inline) -> true; - (_) -> false - end, Opts) of - true -> false; - false -> - any(fun(inline) -> true; - (_) -> false - end, Opts) - end. - -core_old_inliner(#compile{code=Code0,options=Opts}=St) -> - case catch sys_core_inline:module(Code0, Opts) of - {ok,Code} -> - {ok,St#compile{code=Code}}; - {error,Es} -> - {error,St#compile{errors=St#compile.errors ++ Es}} - end. - -core_inline_module(#compile{code=Code0,options=Opts}=St) -> - Code = cerl_inline:core_transform(Code0, Opts), - {ok,St#compile{code=Code}}. - -core_dsetel_module(#compile{code=Code0,options=Opts}=St) -> - {ok,Code} = sys_core_dsetel:module(Code0, Opts), - {ok,St#compile{code=Code}}. - -kernel_module(#compile{code=Code0,options=Opts,ifile=File}=St) -> - {ok,Code,Ws} = v3_kernel:module(Code0, Opts), - {ok,St#compile{code=Code,warnings=St#compile.warnings ++ [{File,Ws}]}}. - -save_abstract_code(St) -> - {ok,St#compile{abstract_code=abstract_code(St)}}. - -abstract_code(#compile{code=Code}) -> - Abstr = {raw_abstract_v1,Code}, - case catch erlang:term_to_binary(Abstr, [compressed]) of - {'EXIT',_} -> term_to_binary(Abstr); - Other -> Other - end. - -save_core_code(St) -> - {ok,St#compile{core_code=cerl:from_records(St#compile.code)}}. - -beam_unused_labels(#compile{code=Code0}=St) -> - Code = beam_jump:module_labels(Code0), - {ok,St#compile{code=Code}}. - -beam_asm(#compile{ifile=File,code=Code0,abstract_code=Abst,options=Opts0}=St) -> - Source = filename:absname(File), - Opts = filter(fun is_informative_option/1, Opts0), - case beam_asm:module(Code0, Abst, Source, Opts) of - {ok,Code} -> {ok,St#compile{code=Code,abstract_code=[]}}; - {error,Es} -> {error,St#compile{errors=St#compile.errors ++ Es}} - end. - -test_native(#compile{options=Opts}) -> - %% This test must be made late, because the r7 or no_new_funs options - %% will turn off the native option. - member(native, Opts). - -native_compile(#compile{code=none}=St) -> {ok,St}; -native_compile(St) -> - case erlang:system_info(hipe_architecture) of - undefined -> - Ws = [{St#compile.ifile,[{none,compile,no_native_support}]}], - {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; - _ -> - native_compile_1(St) - end. - -native_compile_1(St) -> - Opts0 = [no_new_binaries|St#compile.options], - IgnoreErrors = member(ignore_native_errors, Opts0), - Opts = case keysearch(hipe, 1, Opts0) of - {value,{hipe,L}} when list(L) -> L; - {value,{hipe,X}} -> [X]; - _ -> [] - end, - case catch hipe:compile(St#compile.module, - St#compile.core_code, - St#compile.code, - Opts) of - {ok, {Type,Bin}} when binary(Bin) -> - {ok, embed_native_code(St, {Type,Bin})}; - {error, R} -> - case IgnoreErrors of - true -> - Ws = [{St#compile.ifile,[{none,?MODULE,{native,R}}]}], - {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; - false -> - Es = [{St#compile.ifile,[{none,?MODULE,{native,R}}]}], - {error,St#compile{errors=St#compile.errors ++ Es}} - end; - {'EXIT',R} -> - case IgnoreErrors of - true -> - Ws = [{St#compile.ifile,[{none,?MODULE,{native_crash,R}}]}], - {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; - false -> - exit(R) - end - end. - -embed_native_code(St, {Architecture,NativeCode}) -> - {ok, _, Chunks0} = beam_lib:all_chunks(St#compile.code), - ChunkName = hipe_unified_loader:chunk_name(Architecture), - Chunks1 = lists:keydelete(ChunkName, 1, Chunks0), - Chunks = Chunks1 ++ [{ChunkName,NativeCode}], - {ok, BeamPlusNative} = beam_lib:build_module(Chunks), - St#compile{code=BeamPlusNative}. - -%% Returns true if the option is informative and therefore should be included -%% in the option list of the compiled module. - -is_informative_option(beam) -> false; -is_informative_option(report_warnings) -> false; -is_informative_option(report_errors) -> false; -is_informative_option(binary) -> false; -is_informative_option(verbose) -> false; -is_informative_option(_) -> true. - -save_binary(#compile{code=none}=St) -> {ok,St}; -save_binary(St) -> - Tfile = tmpfile(St#compile.ofile), %Temp working file - case write_binary(Tfile, St#compile.code, St) of - ok -> - case file:rename(Tfile, St#compile.ofile) of - ok -> - {ok,St}; - {error,_Error} -> - file:delete(Tfile), - Es = [{St#compile.ofile,[{none,?MODULE,{rename,Tfile}}]}], - {error,St#compile{errors=St#compile.errors ++ Es}} - end; - {error,_Error} -> - Es = [{Tfile,[{compile,write_error}]}], - {error,St#compile{errors=St#compile.errors ++ Es}} - end. - -write_binary(Name, Bin, St) -> - Opts = case member(compressed, St#compile.options) of - true -> [compressed]; - false -> [] - end, - case file:write_file(Name, Bin, Opts) of - ok -> ok; - {error,_}=Error -> Error - end. - -%% report_errors(State) -> ok -%% report_warnings(State) -> ok - -report_errors(St) -> - case member(report_errors, St#compile.options) of - true -> - foreach(fun ({{F,_L},Eds}) -> list_errors(F, Eds); - ({F,Eds}) -> list_errors(F, Eds) end, - St#compile.errors); - false -> ok - end. - -report_warnings(#compile{options=Opts,warnings=Ws0}) -> - case member(report_warnings, Opts) of - true -> - Ws1 = flatmap(fun({{F,_L},Eds}) -> format_message(F, Eds); - ({F,Eds}) -> format_message(F, Eds) end, - Ws0), - Ws = ordsets:from_list(Ws1), - foreach(fun({_,Str}) -> io:put_chars(Str) end, Ws); - false -> ok - end. - -format_message(F, [{Line,Mod,E}|Es]) -> - M = {Line,io_lib:format("~s:~w: Warning: ~s\n", [F,Line,Mod:format_error(E)])}, - [M|format_message(F, Es)]; -format_message(F, [{Mod,E}|Es]) -> - M = {none,io_lib:format("~s: Warning: ~s\n", [F,Mod:format_error(E)])}, - [M|format_message(F, Es)]; -format_message(_, []) -> []. - -%% list_errors(File, ErrorDescriptors) -> ok - -list_errors(F, [{Line,Mod,E}|Es]) -> - io:fwrite("~s:~w: ~s\n", [F,Line,Mod:format_error(E)]), - list_errors(F, Es); -list_errors(F, [{Mod,E}|Es]) -> - io:fwrite("~s: ~s\n", [F,Mod:format_error(E)]), - list_errors(F, Es); -list_errors(_F, []) -> ok. - -%% erlfile(Dir, Base) -> ErlFile -%% outfile(Base, Extension, Options) -> OutputFile -%% objfile(Base, Target, Options) -> ObjFile -%% tmpfile(ObjFile) -> TmpFile -%% Work out the correct input and output file names. - -iofile(File) when atom(File) -> - iofile(atom_to_list(File)); -iofile(File) -> - {filename:dirname(File), filename:basename(File, ".erl")}. - -erlfile(Dir, Base, Suffix) -> - filename:join(Dir, Base++Suffix). - -outfile(Base, Ext, Opts) when atom(Ext) -> - outfile(Base, atom_to_list(Ext), Opts); -outfile(Base, Ext, Opts) -> - Obase = case keysearch(outdir, 1, Opts) of - {value, {outdir, Odir}} -> filename:join(Odir, Base); - _Other -> Base % Not found or bad format - end, - Obase++"."++Ext. - -objfile(Base, St) -> - outfile(Base, "beam", St#compile.options). - -tmpfile(Ofile) -> - reverse([$#|tl(reverse(Ofile))]). - -%% pre_defs(Options) -%% inc_paths(Options) -%% Extract the predefined macros and include paths from the option list. - -pre_defs([{d,M,V}|Opts]) -> - [{M,V}|pre_defs(Opts)]; -pre_defs([{d,M}|Opts]) -> - [M|pre_defs(Opts)]; -pre_defs([_|Opts]) -> - pre_defs(Opts); -pre_defs([]) -> []. - -inc_paths(Opts) -> - [ P || {i,P} <- Opts, list(P) ]. - -src_listing(Ext, St) -> - listing(fun (Lf, {_Mod,_Exp,Fs}) -> do_src_listing(Lf, Fs); - (Lf, Fs) -> do_src_listing(Lf, Fs) end, - Ext, St). - -do_src_listing(Lf, Fs) -> - foreach(fun (F) -> io:put_chars(Lf, [erl_pp:form(F),"\n"]) end, - Fs). - -listing(Ext, St) -> - listing(fun(Lf, Fs) -> beam_listing:module(Lf, Fs) end, Ext, St). - -listing(LFun, Ext, St) -> - Lfile = outfile(St#compile.base, Ext, St#compile.options), - case file:open(Lfile, [write,delayed_write]) of - {ok,Lf} -> - LFun(Lf, St#compile.code), - ok = file:close(Lf), - {ok,St}; - {error,_Error} -> - Es = [{Lfile,[{none,compile,write_error}]}], - {error,St#compile{errors=St#compile.errors ++ Es}} - end. - -options() -> - help(standard_passes()). - -help([{iff,Flag,{src_listing,Ext}}|T]) -> - io:fwrite("~p - Generate .~s source listing file\n", [Flag,Ext]), - help(T); -help([{iff,Flag,{listing,Ext}}|T]) -> - io:fwrite("~p - Generate .~s file\n", [Flag,Ext]), - help(T); -help([{iff,Flag,{Name,Fun}}|T]) when function(Fun) -> - io:fwrite("~p - Run ~s\n", [Flag,Name]), - help(T); -help([{iff,_Flag,Action}|T]) -> - help(Action), - help(T); -help([{unless,Flag,{pass,Pass}}|T]) -> - io:fwrite("~p - Skip the ~s pass\n", [Flag,Pass]), - help(T); -help([{unless,no_postopt=Flag,List}|T]) when list(List) -> - %% Hard-coded knowledgde here. - io:fwrite("~p - Skip all post optimisation\n", [Flag]), - help(List), - help(T); -help([{unless,_Flag,Action}|T]) -> - help(Action), - help(T); -help([_|T]) -> - help(T); -help(_) -> - ok. - - -%% compile(AbsFileName, Outfilename, Options) -%% Compile entry point for erl_compile. - -compile(File0, _OutFile, Options) -> - File = shorten_filename(File0), - case file(File, make_erl_options(Options)) of - {ok,_Mod} -> ok; - Other -> Other - end. - -compile_beam(File0, _OutFile, Opts) -> - File = shorten_filename(File0), - case file(File, [from_beam|make_erl_options(Opts)]) of - {ok,_Mod} -> ok; - Other -> Other - end. - -compile_asm(File0, _OutFile, Opts) -> - File = shorten_filename(File0), - case file(File, [asm|make_erl_options(Opts)]) of - {ok,_Mod} -> ok; - Other -> Other - end. - -compile_core(File0, _OutFile, Opts) -> - File = shorten_filename(File0), - case file(File, [from_core|make_erl_options(Opts)]) of - {ok,_Mod} -> ok; - Other -> Other - end. - -shorten_filename(Name0) -> - {ok,Cwd} = file:get_cwd(), - case lists:prefix(Cwd, Name0) of - false -> Name0; - true -> - Name = case lists:nthtail(length(Cwd), Name0) of - "/"++N -> N; - N -> N - end, - Name - end. - -%% Converts generic compiler options to specific options. - -make_erl_options(Opts) -> - - %% This way of extracting will work even if the record passed - %% has more fields than known during compilation. - - Includes = Opts#options.includes, - Defines = Opts#options.defines, - Outdir = Opts#options.outdir, - Warning = Opts#options.warning, - Verbose = Opts#options.verbose, - Specific = Opts#options.specific, - OutputType = Opts#options.output_type, - Cwd = Opts#options.cwd, - - Options = - case Verbose of - true -> [verbose]; - false -> [] - end ++ - case Warning of - 0 -> []; - _ -> [report_warnings] - end ++ - map( - fun ({Name, Value}) -> - {d, Name, Value}; - (Name) -> - {d, Name} - end, - Defines) ++ - case OutputType of - undefined -> []; - jam -> [jam]; - beam -> [beam]; - native -> [native] - end, - - Options++[report_errors, {cwd, Cwd}, {outdir, Outdir}| - map(fun(Dir) -> {i, Dir} end, Includes)]++Specific. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_lib.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_lib.erl deleted file mode 100644 index 3a6158286f..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_lib.erl +++ /dev/null @@ -1,509 +0,0 @@ -%% ``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 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. -%% -%% 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: core_lib.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $ -%% -%% Purpose: Core Erlang abstract syntax functions. - --module(core_lib). - --export([get_anno/1,set_anno/2]). --export([is_atomic/1,is_literal/1,is_literal_list/1, - is_simple/1,is_simple_list/1,is_simple_top/1]). --export([literal_value/1,make_literal/1]). --export([make_values/1]). --export([map/2, fold/3, mapfold/3]). --export([is_var_used/2]). - -%% -compile([export_all]). - --include("core_parse.hrl"). - -%% get_anno(Core) -> Anno. -%% set_anno(Core, Anno) -> Core. -%% Generic get/set annotation. - -get_anno(C) -> element(2, C). -set_anno(C, A) -> setelement(2, C, A). - -%% is_atomic(Expr) -> true | false. - -is_atomic(#c_char{}) -> true; -is_atomic(#c_int{}) -> true; -is_atomic(#c_float{}) -> true; -is_atomic(#c_atom{}) -> true; -is_atomic(#c_string{}) -> true; -is_atomic(#c_nil{}) -> true; -is_atomic(#c_fname{}) -> true; -is_atomic(_) -> false. - -%% is_literal(Expr) -> true | false. - -is_literal(#c_cons{hd=H,tl=T}) -> - case is_literal(H) of - true -> is_literal(T); - false -> false - end; -is_literal(#c_tuple{es=Es}) -> is_literal_list(Es); -is_literal(#c_binary{segments=Es}) -> is_lit_bin(Es); -is_literal(E) -> is_atomic(E). - -is_literal_list(Es) -> lists:all(fun is_literal/1, Es). - -is_lit_bin(Es) -> - lists:all(fun (#c_bitstr{val=E,size=S}) -> - is_literal(E) and is_literal(S) - end, Es). - -%% is_simple(Expr) -> true | false. - -is_simple(#c_var{}) -> true; -is_simple(#c_cons{hd=H,tl=T}) -> - case is_simple(H) of - true -> is_simple(T); - false -> false - end; -is_simple(#c_tuple{es=Es}) -> is_simple_list(Es); -is_simple(#c_binary{segments=Es}) -> is_simp_bin(Es); -is_simple(E) -> is_atomic(E). - -is_simple_list(Es) -> lists:all(fun is_simple/1, Es). - -is_simp_bin(Es) -> - lists:all(fun (#c_bitstr{val=E,size=S}) -> - is_simple(E) and is_simple(S) - end, Es). - -%% is_simple_top(Expr) -> true | false. -%% Only check if the top-level is a simple. - -is_simple_top(#c_var{}) -> true; -is_simple_top(#c_cons{}) -> true; -is_simple_top(#c_tuple{}) -> true; -is_simple_top(#c_binary{}) -> true; -is_simple_top(E) -> is_atomic(E). - -%% literal_value(LitExpr) -> Value. -%% Return the value of LitExpr. - -literal_value(#c_char{val=C}) -> C; -literal_value(#c_int{val=I}) -> I; -literal_value(#c_float{val=F}) -> F; -literal_value(#c_atom{val=A}) -> A; -literal_value(#c_string{val=S}) -> S; -literal_value(#c_nil{}) -> []; -literal_value(#c_cons{hd=H,tl=T}) -> - [literal_value(H)|literal_value(T)]; -literal_value(#c_tuple{es=Es}) -> - list_to_tuple(literal_value_list(Es)). - -literal_value_list(Vals) -> lists:map(fun literal_value/1, Vals). - -%% make_literal(Value) -> LitExpr. -%% Make a literal expression from an Erlang value. - -make_literal(I) when integer(I) -> #c_int{val=I}; -make_literal(F) when float(F) -> #c_float{val=F}; -make_literal(A) when atom(A) -> #c_atom{val=A}; -make_literal([]) -> #c_nil{}; -make_literal([H|T]) -> - #c_cons{hd=make_literal(H),tl=make_literal(T)}; -make_literal(T) when tuple(T) -> - #c_tuple{es=make_literal_list(tuple_to_list(T))}. - -make_literal_list(Vals) -> lists:map(fun make_literal/1, Vals). - -%% make_values([CoreExpr] | CoreExpr) -> #c_values{} | CoreExpr. -%% Make a suitable values structure, expr or values, depending on -%% Expr. - -make_values([E]) -> E; -make_values([H|_]=Es) -> #c_values{anno=get_anno(H),es=Es}; -make_values([]) -> #c_values{es=[]}; -make_values(E) -> E. - -%% map(MapFun, CoreExpr) -> CoreExpr. -%% This function traverses the core parse format, at each level -%% applying the submited argument function, assumed to do the real -%% work. -%% -%% The "eager" style, where each component of a construct are -%% descended to before the construct itself, admits that some -%% companion functions (the F:s) may be made simpler, since it may be -%% safely assumed that no lower illegal instanced will be -%% created/uncovered by actions on the current level. - -map(F, #c_tuple{es=Es}=R) -> - F(R#c_tuple{es=map_list(F, Es)}); -map(F, #c_cons{hd=Hd, tl=Tl}=R) -> - F(R#c_cons{hd=map(F, Hd), - tl=map(F, Tl)}); -map(F, #c_values{es=Es}=R) -> - F(R#c_values{es=map_list(F, Es)}); - -map(F, #c_alias{var=Var, pat=Pat}=R) -> - F(R#c_alias{var=map(F, Var), - pat=map(F, Pat)}); - -map(F, #c_module{defs=Defs}=R) -> - F(R#c_module{defs=map_list(F, Defs)}); -map(F, #c_def{val=Val}=R) -> - F(R#c_def{val=map(F, Val)}); - -map(F, #c_fun{vars=Vars, body=Body}=R) -> - F(R#c_fun{vars=map_list(F, Vars), - body=map(F, Body)}); -map(F, #c_let{vars=Vs, arg=Arg, body=Body}=R) -> - F(R#c_let{vars=map_list(F, Vs), - arg=map(F, Arg), - body=map(F, Body)}); -map(F, #c_letrec{defs=Fs,body=Body}=R) -> - F(R#c_letrec{defs=map_list(F, Fs), - body=map(F, Body)}); -map(F, #c_seq{arg=Arg, body=Body}=R) -> - F(R#c_seq{arg=map(F, Arg), - body=map(F, Body)}); -map(F, #c_case{arg=Arg, clauses=Clauses}=R) -> - F(R#c_case{arg=map(F, Arg), - clauses=map_list(F, Clauses)}); -map(F, #c_clause{pats=Ps, guard=Guard, body=Body}=R) -> - F(R#c_clause{pats=map_list(F, Ps), - guard=map(F, Guard), - body=map(F, Body)}); -map(F, #c_receive{clauses=Cls, timeout=Tout, action=Act}=R) -> - F(R#c_receive{clauses=map_list(F, Cls), - timeout=map(F, Tout), - action=map(F, Act)}); -map(F, #c_apply{op=Op,args=Args}=R) -> - F(R#c_apply{op=map(F, Op), - args=map_list(F, Args)}); -map(F, #c_call{module=M,name=N,args=Args}=R) -> - F(R#c_call{module=map(F, M), - name=map(F, N), - args=map_list(F, Args)}); -map(F, #c_primop{name=N,args=Args}=R) -> - F(R#c_primop{name=map(F, N), - args=map_list(F, Args)}); -map(F, #c_try{arg=Expr,vars=Vars,body=Body,evars=Evars,handler=Handler}=R) -> - F(R#c_try{arg=map(F, Expr), - vars=map(F, Vars), - body=map(F, Body), - evars=map(F, Evars), - handler=map(F, Handler)}); -map(F, #c_catch{body=Body}=R) -> - F(R#c_catch{body=map(F, Body)}); -map(F, T) -> F(T). %Atomic nodes. - -map_list(F, L) -> lists:map(fun (E) -> map(F, E) end, L). - -%% fold(FoldFun, Accumulator, CoreExpr) -> Accumulator. -%% This function traverses the core parse format, at each level -%% applying the submited argument function, assumed to do the real -%% work, and keeping the accumulated result in the A (accumulator) -%% argument. - -fold(F, Acc, #c_tuple{es=Es}=R) -> - F(R, fold_list(F, Acc, Es)); -fold(F, Acc, #c_cons{hd=Hd, tl=Tl}=R) -> - F(R, fold(F, fold(F, Acc, Hd), Tl)); -fold(F, Acc, #c_values{es=Es}=R) -> - F(R, fold_list(F, Acc, Es)); - -fold(F, Acc, #c_alias{pat=P,var=V}=R) -> - F(R, fold(F, fold(F, Acc, P), V)); - -fold(F, Acc, #c_module{defs=Defs}=R) -> - F(R, fold_list(F, Acc, Defs)); -fold(F, Acc, #c_def{val=Val}=R) -> - F(R, fold(F, Acc, Val)); - -fold(F, Acc, #c_fun{vars=Vars, body=Body}=R) -> - F(R, fold(F, fold_list(F, Acc, Vars), Body)); -fold(F, Acc, #c_let{vars=Vs, arg=Arg, body=Body}=R) -> - F(R, fold(F, fold(F, fold_list(F, Acc, Vs), Arg), Body)); -fold(F, Acc, #c_letrec{defs=Fs,body=Body}=R) -> - F(R, fold(F, fold_list(F, Acc, Fs), Body)); -fold(F, Acc, #c_seq{arg=Arg, body=Body}=R) -> - F(R, fold(F, fold(F, Acc, Arg), Body)); -fold(F, Acc, #c_case{arg=Arg, clauses=Clauses}=R) -> - F(R, fold_list(F, fold(F, Acc, Arg), Clauses)); -fold(F, Acc, #c_clause{pats=Ps,guard=G,body=B}=R) -> - F(R, fold(F, fold(F, fold_list(F, Acc, Ps), G), B)); -fold(F, Acc, #c_receive{clauses=Cl, timeout=Ti, action=Ac}=R) -> - F(R, fold_list(F, fold(F, fold(F, Acc, Ac), Ti), Cl)); -fold(F, Acc, #c_apply{op=Op, args=Args}=R) -> - F(R, fold_list(F, fold(F, Acc, Op), Args)); -fold(F, Acc, #c_call{module=Mod,name=Name,args=Args}=R) -> - F(R, fold_list(F, fold(F, fold(F, Acc, Mod), Name), Args)); -fold(F, Acc, #c_primop{name=Name,args=Args}=R) -> - F(R, fold_list(F, fold(F, Acc, Name), Args)); -fold(F, Acc, #c_try{arg=E,vars=Vs,body=Body,evars=Evs,handler=H}=R) -> - NewB = fold(F, fold_list(F, fold(F, Acc, E), Vs), Body), - F(R, fold(F, fold_list(F, NewB, Evs), H)); -fold(F, Acc, #c_catch{body=Body}=R) -> - F(R, fold(F, Acc, Body)); -fold(F, Acc, T) -> %Atomic nodes - F(T, Acc). - -fold_list(F, Acc, L) -> - lists:foldl(fun (E, A) -> fold(F, A, E) end, Acc, L). - -%% mapfold(MapfoldFun, Accumulator, CoreExpr) -> {CoreExpr,Accumulator}. -%% This function traverses the core parse format, at each level -%% applying the submited argument function, assumed to do the real -%% work, and keeping the accumulated result in the A (accumulator) -%% argument. - -mapfold(F, Acc0, #c_tuple{es=Es0}=R) -> - {Es1,Acc1} = mapfold_list(F, Acc0, Es0), - F(R#c_tuple{es=Es1}, Acc1); -mapfold(F, Acc0, #c_cons{hd=H0,tl=T0}=R) -> - {H1,Acc1} = mapfold(F, Acc0, H0), - {T1,Acc2} = mapfold(F, Acc1, T0), - F(R#c_cons{hd=H1,tl=T1}, Acc2); -mapfold(F, Acc0, #c_values{es=Es0}=R) -> - {Es1,Acc1} = mapfold_list(F, Acc0, Es0), - F(R#c_values{es=Es1}, Acc1); - -mapfold(F, Acc0, #c_alias{pat=P0,var=V0}=R) -> - {P1,Acc1} = mapfold(F, Acc0, P0), - {V1,Acc2} = mapfold(F, Acc1, V0), - F(R#c_alias{pat=P1,var=V1}, Acc2); - -mapfold(F, Acc0, #c_module{defs=D0}=R) -> - {D1,Acc1} = mapfold_list(F, Acc0, D0), - F(R#c_module{defs=D1}, Acc1); -mapfold(F, Acc0, #c_def{val=V0}=R) -> - {V1,Acc1} = mapfold(F, Acc0, V0), - F(R#c_def{val=V1}, Acc1); - -mapfold(F, Acc0, #c_fun{vars=Vs0, body=B0}=R) -> - {Vs1,Acc1} = mapfold_list(F, Acc0, Vs0), - {B1,Acc2} = mapfold(F, Acc1, B0), - F(R#c_fun{vars=Vs1,body=B1}, Acc2); -mapfold(F, Acc0, #c_let{vars=Vs0, arg=A0, body=B0}=R) -> - {Vs1,Acc1} = mapfold_list(F, Acc0, Vs0), - {A1,Acc2} = mapfold(F, Acc1, A0), - {B1,Acc3} = mapfold(F, Acc2, B0), - F(R#c_let{vars=Vs1,arg=A1,body=B1}, Acc3); -mapfold(F, Acc0, #c_letrec{defs=Fs0,body=B0}=R) -> - {Fs1,Acc1} = mapfold_list(F, Acc0, Fs0), - {B1,Acc2} = mapfold(F, Acc1, B0), - F(R#c_letrec{defs=Fs1,body=B1}, Acc2); -mapfold(F, Acc0, #c_seq{arg=A0, body=B0}=R) -> - {A1,Acc1} = mapfold(F, Acc0, A0), - {B1,Acc2} = mapfold(F, Acc1, B0), - F(R#c_seq{arg=A1,body=B1}, Acc2); -mapfold(F, Acc0, #c_case{arg=A0,clauses=Cs0}=R) -> - {A1,Acc1} = mapfold(F, Acc0, A0), - {Cs1,Acc2} = mapfold_list(F, Acc1, Cs0), - F(R#c_case{arg=A1,clauses=Cs1}, Acc2); -mapfold(F, Acc0, #c_clause{pats=Ps0,guard=G0,body=B0}=R) -> - {Ps1,Acc1} = mapfold_list(F, Acc0, Ps0), - {G1,Acc2} = mapfold(F, Acc1, G0), - {B1,Acc3} = mapfold(F, Acc2, B0), - F(R#c_clause{pats=Ps1,guard=G1,body=B1}, Acc3); -mapfold(F, Acc0, #c_receive{clauses=Cs0,timeout=T0,action=A0}=R) -> - {T1,Acc1} = mapfold(F, Acc0, T0), - {Cs1,Acc2} = mapfold_list(F, Acc1, Cs0), - {A1,Acc3} = mapfold(F, Acc2, A0), - F(R#c_receive{clauses=Cs1,timeout=T1,action=A1}, Acc3); -mapfold(F, Acc0, #c_apply{op=Op0, args=As0}=R) -> - {Op1,Acc1} = mapfold(F, Acc0, Op0), - {As1,Acc2} = mapfold_list(F, Acc1, As0), - F(R#c_apply{op=Op1,args=As1}, Acc2); -mapfold(F, Acc0, #c_call{module=M0,name=N0,args=As0}=R) -> - {M1,Acc1} = mapfold(F, Acc0, M0), - {N1,Acc2} = mapfold(F, Acc1, N0), - {As1,Acc3} = mapfold_list(F, Acc2, As0), - F(R#c_call{module=M1,name=N1,args=As1}, Acc3); -mapfold(F, Acc0, #c_primop{name=N0, args=As0}=R) -> - {N1,Acc1} = mapfold(F, Acc0, N0), - {As1,Acc2} = mapfold_list(F, Acc1, As0), - F(R#c_primop{name=N1,args=As1}, Acc2); -mapfold(F, Acc0, #c_try{arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=R) -> - {E1,Acc1} = mapfold(F, Acc0, E0), - {Vs1,Acc2} = mapfold_list(F, Acc1, Vs0), - {B1,Acc3} = mapfold(F, Acc2, B0), - {Evs1,Acc4} = mapfold_list(F, Acc3, Evs0), - {H1,Acc5} = mapfold(F, Acc4, H0), - F(R#c_try{arg=E1,vars=Vs1,body=B1,evars=Evs1,handler=H1}, Acc5); -mapfold(F, Acc0, #c_catch{body=B0}=R) -> - {B1,Acc1} = mapfold(F, Acc0, B0), - F(R#c_catch{body=B1}, Acc1); -mapfold(F, Acc, T) -> %Atomic nodes - F(T, Acc). - -mapfold_list(F, Acc, L) -> - lists:mapfoldl(fun (E, A) -> mapfold(F, A, E) end, Acc, L). - -%% is_var_used(VarName, Expr) -> true | false. -%% Test if the variable VarName is used in Expr. - -is_var_used(V, B) -> vu_body(V, B). - -vu_body(V, #c_values{es=Es}) -> - vu_expr_list(V, Es); -vu_body(V, Body) -> - vu_expr(V, Body). - -vu_expr(V, #c_var{name=V2}) -> V =:= V2; -vu_expr(V, #c_cons{hd=H,tl=T}) -> - case vu_expr(V, H) of - true -> true; - false -> vu_expr(V, T) - end; -vu_expr(V, #c_tuple{es=Es}) -> - vu_expr_list(V, Es); -vu_expr(V, #c_binary{segments=Ss}) -> - vu_seg_list(V, Ss); -vu_expr(V, #c_fun{vars=Vs,body=B}) -> - %% Variables in fun shadow previous variables - case vu_var_list(V, Vs) of - true -> false; - false -> vu_body(V, B) - end; -vu_expr(V, #c_let{vars=Vs,arg=Arg,body=B}) -> - case vu_body(V, Arg) of - true -> true; - false -> - %% Variables in let shadow previous variables. - case vu_var_list(V, Vs) of - true -> false; - false -> vu_body(V, B) - end - end; -vu_expr(V, #c_letrec{defs=Fs,body=B}) -> - case lists:any(fun (#c_def{val=Fb}) -> vu_body(V, Fb) end, Fs) of - true -> true; - false -> vu_body(V, B) - end; -vu_expr(V, #c_seq{arg=Arg,body=B}) -> - case vu_expr(V, Arg) of - true -> true; - false -> vu_body(V, B) - end; -vu_expr(V, #c_case{arg=Arg,clauses=Cs}) -> - case vu_expr(V, Arg) of - true -> true; - false -> vu_clauses(V, Cs) - end; -vu_expr(V, #c_receive{clauses=Cs,timeout=T,action=A}) -> - case vu_clauses(V, Cs) of - true -> true; - false -> - case vu_expr(V, T) of - true -> true; - false -> vu_body(V, A) - end - end; -vu_expr(V, #c_apply{op=Op,args=As}) -> - vu_expr_list(V, [Op|As]); -vu_expr(V, #c_call{module=M,name=N,args=As}) -> - vu_expr_list(V, [M,N|As]); -vu_expr(V, #c_primop{args=As}) -> %Name is an atom - vu_expr_list(V, As); -vu_expr(V, #c_catch{body=B}) -> - vu_body(V, B); -vu_expr(V, #c_try{arg=E,vars=Vs,body=B,evars=Evs,handler=H}) -> - case vu_body(V, E) of - true -> true; - false -> - %% Variables shadow previous ones. - case case vu_var_list(V, Vs) of - true -> false; - false -> vu_body(V, B) - end of - true -> true; - false -> - case vu_var_list(V, Evs) of - true -> false; - false -> vu_body(V, H) - end - end - end; -vu_expr(_, _) -> false. %Everything else - -vu_expr_list(V, Es) -> - lists:any(fun(E) -> vu_expr(V, E) end, Es). - -vu_seg_list(V, Ss) -> - lists:any(fun (#c_bitstr{val=Val,size=Size}) -> - case vu_expr(V, Val) of - true -> true; - false -> vu_expr(V, Size) - end - end, Ss). - -%% vu_clause(VarName, Clause) -> true | false. -%% vu_clauses(VarName, [Clause]) -> true | false. -%% Have to get the pattern results right. - -vu_clause(V, #c_clause{pats=Ps,guard=G,body=B}) -> - case vu_pattern_list(V, Ps) of - {true,_Shad} -> true; %It is used - {false,true} -> false; %Shadowed - {false,false} -> %Not affected - case vu_expr(V, G) of - true -> true; - false ->vu_body(V, B) - end - end. - -vu_clauses(V, Cs) -> - lists:any(fun(C) -> vu_clause(V, C) end, Cs). - -%% vu_pattern(VarName, Pattern) -> {Used,Shadow}. -%% vu_pattern_list(VarName, [Pattern]) -> {Used,Shadow}. -%% Binaries complicate patterns as a variable can both be properly -%% used, in a bit segment size, and shadow. They can also do both. - -%%vu_pattern(V, Pat) -> vu_pattern(V, Pat, {false,false}). - -vu_pattern(V, #c_var{name=V2}, St) -> - setelement(2, St, V =:= V2); -vu_pattern(V, #c_cons{hd=H,tl=T}, St0) -> - case vu_pattern(V, H, St0) of - {true,true}=St1 -> St1; %Nothing more to know - St1 -> vu_pattern(V, T, St1) - end; -vu_pattern(V, #c_tuple{es=Es}, St) -> - vu_pattern_list(V, Es, St); -vu_pattern(V, #c_binary{segments=Ss}, St) -> - vu_pat_seg_list(V, Ss, St); -vu_pattern(V, #c_alias{var=Var,pat=P}, St0) -> - case vu_pattern(V, Var, St0) of - {true,true}=St1 -> St1; - St1 -> vu_pattern(V, P, St1) - end; -vu_pattern(_, _, St) -> St. - -vu_pattern_list(V, Ps) -> vu_pattern_list(V, Ps, {false,false}). - -vu_pattern_list(V, Ps, St0) -> - lists:foldl(fun(P, St) -> vu_pattern(V, P, St) end, St0, Ps). - -vu_pat_seg_list(V, Ss, St) -> - lists:foldl(fun (#c_bitstr{val=Val,size=Size}, St0) -> - case vu_pattern(V, Val, St0) of - {true,true}=St1 -> St1; - {_Used,Shad} -> {vu_expr(V, Size),Shad} - end - end, St, Ss). - -%% vu_var_list(VarName, [Var]) -> true | false. - -vu_var_list(V, Vs) -> - lists:any(fun (#c_var{name=V2}) -> V =:= V2 end, Vs). diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_lint.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_lint.erl deleted file mode 100644 index 2946fcb8c0..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_lint.erl +++ /dev/null @@ -1,515 +0,0 @@ -%% ``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 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. -%% -%% 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: core_lint.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $ -%% -%% Purpose : Do necessary checking of Core Erlang code. - -%% Check Core module for errors. Seeing this module is used in the -%% compiler after optimisations wedone more checking than would be -%% necessary after just parsing. Don't check all constructs. -%% -%% We check the following: -%% -%% All referred functions, called and exported, are defined. -%% Format of export list. -%% Format of attributes -%% Used variables are defined. -%% Variables in let and funs. -%% Patterns case clauses. -%% Values only as multiple values/variables/patterns. -%% Return same number of values as requested -%% Correct number of arguments -%% -%% Checks to add: -%% -%% Consistency of values/variables -%% Consistency of function return values/calls. -%% -%% We keep the names defined variables and functions in a ordered list -%% of variable names and function name/arity pairs. - --module(core_lint). - - --export([module/1,module/2,format_error/1]). - --import(lists, [reverse/1,all/2,foldl/3]). --import(ordsets, [add_element/2,is_element/2,union/2]). -%-import(ordsets, [subtract/2]). - --include("core_parse.hrl"). - -%% Define the lint state record. - --record(lint, {module=[], %Current module - func=[], %Current function - errors=[], %Errors - warnings=[]}). %Warnings - -%% Keep track of defined --record(def, {vars=[], - funs=[]}). - -%%-deftype retcount() -> any | unknown | int(). - -%% format_error(Error) -%% Return a string describing the error. - -format_error(invalid_exports) -> "invalid exports"; -format_error(invalid_attributes) -> "invalid attributes"; -format_error({undefined_function,{F,A}}) -> - io_lib:format("function ~w/~w undefined", [F,A]); -format_error({undefined_function,{F1,A1},{F2,A2}}) -> - io_lib:format("undefined function ~w/~w in ~w/~w", [F1,A1,F2,A2]); -format_error({illegal_expr,{F,A}}) -> - io_lib:format("illegal expression in ~w/~w", [F,A]); -format_error({illegal_guard,{F,A}}) -> - io_lib:format("illegal guard expression in ~w/~w", [F,A]); -format_error({illegal_pattern,{F,A}}) -> - io_lib:format("illegal pattern in ~w/~w", [F,A]); -format_error({illegal_try,{F,A}}) -> - io_lib:format("illegal try expression in ~w/~w", [F,A]); -format_error({pattern_mismatch,{F,A}}) -> - io_lib:format("pattern count mismatch in ~w/~w", [F,A]); -format_error({return_mismatch,{F,A}}) -> - io_lib:format("return count mismatch in ~w/~w", [F,A]); -format_error({arg_mismatch,{F,A}}) -> - io_lib:format("argument count mismatch in ~w/~w", [F,A]); -format_error({unbound_var,N,{F,A}}) -> - io_lib:format("unbound variable ~s in ~w/~w", [N,F,A]); -format_error({duplicate_var,N,{F,A}}) -> - io_lib:format("duplicate variable ~s in ~w/~w", [N,F,A]); -format_error({not_var,{F,A}}) -> - io_lib:format("expecting variable in ~w/~w", [F,A]); -format_error({not_pattern,{F,A}}) -> - io_lib:format("expecting pattern in ~w/~w", [F,A]); -format_error({not_bs_pattern,{F,A}}) -> - io_lib:format("expecting bit syntax pattern in ~w/~w", [F,A]). - -%% module(CoreMod) -> -%% module(CoreMod, [CompileOption]) -> -%% {ok,[Warning]} | {error,[Error],[Warning]} - -module(M) -> module(M, []). - -module(#c_module{name=M,exports=Es,attrs=As,defs=Ds}, _Opts) -> - Defined = defined_funcs(Ds), - St0 = #lint{module=M#c_atom.val}, - St1 = check_exports(Es, St0), - St2 = check_attrs(As, St1), - St3 = module_defs(Ds, Defined, St2), - St4 = check_state(Es, Defined, St3), - return_status(St4). - -%% defined_funcs([FuncDef]) -> [Fname]. - -defined_funcs(Fs) -> - foldl(fun (#c_def{name=#c_fname{id=I,arity=A}}, Def) -> - add_element({I,A}, Def) - end, [], Fs). - -%% return_status(State) -> -%% {ok,[Warning]} | {error,[Error],[Warning]} -%% Pack errors and warnings properly and return ok | error. - -return_status(St) -> - Ws = reverse(St#lint.warnings), - case reverse(St#lint.errors) of - [] -> {ok,[{St#lint.module,Ws}]}; - Es -> {error,[{St#lint.module,Es}],[{St#lint.module,Ws}]} - end. - -%% add_error(ErrorDescriptor, State) -> State' -%% add_warning(ErrorDescriptor, State) -> State' -%% Note that we don't use line numbers here. - -add_error(E, St) -> St#lint{errors=[{none,core_lint,E}|St#lint.errors]}. - -%%add_warning(W, St) -> St#lint{warnings=[{none,core_lint,W}|St#lint.warnings]}. - -check_exports(Es, St) -> - case all(fun (#c_fname{id=Name,arity=Arity}) when - atom(Name), integer(Arity) -> true; - (_) -> false - end, Es) of - true -> St; - false -> add_error(invalid_exports, St) - end. - -check_attrs(As, St) -> - case all(fun (#c_def{name=#c_atom{},val=V}) -> core_lib:is_literal(V); - (_) -> false - end, As) of - true -> St; - false -> add_error(invalid_attributes, St) - end. - -check_state(Es, Defined, St) -> - foldl(fun (#c_fname{id=N,arity=A}, St1) -> - F = {N,A}, - case is_element(F, Defined) of - true -> St1; - false -> add_error({undefined_function,F}, St) - end - end, St, Es). -% Undef = subtract(Es, Defined), -% St1 = foldl(fun (F, St) -> add_error({undefined_function,F}, St) end, -% St0, Undef), -% St1. - -%% module_defs(CoreBody, Defined, State) -> State. - -module_defs(B, Def, St) -> - %% Set top level function name. - foldl(fun (Func, St0) -> - #c_fname{id=F,arity=A} = Func#c_def.name, - St1 = St0#lint{func={F,A}}, - function(Func, Def, St1) - end, St, B). - -%% functions([Fdef], Defined, State) -> State. - -functions(Fs, Def, St0) -> - foldl(fun (F, St) -> function(F, Def, St) end, St0, Fs). - -%% function(CoreFunc, Defined, State) -> State. - -function(#c_def{name=#c_fname{},val=B}, Def, St) -> - %% Body must be a fun! - case B of - #c_fun{} -> expr(B, Def, any, St); - _ -> add_error({illegal_expr,St#lint.func}, St) - end. - -%% body(Expr, Defined, RetCount, State) -> State. - -body(#c_values{es=Es}, Def, Rt, St) -> - return_match(Rt, length(Es), expr_list(Es, Def, St)); -body(E, Def, Rt, St0) -> - St1 = expr(E, Def, Rt, St0), - case core_lib:is_simple_top(E) of - true -> return_match(Rt, 1, St1); - false -> St1 - end. - -%% guard(Expr, Defined, State) -> State. -%% Guards are boolean expressions with test wrapped in a protected. - -guard(Expr, Def, St) -> gexpr(Expr, Def, 1, St). - -%% guard_list([Expr], Defined, State) -> State. - -%% guard_list(Es, Def, St0) -> -%% foldl(fun (E, St) -> guard(E, Def, St) end, St0, Es). - -%% gbody(Expr, Defined, RetCount, State) -> State. - -gbody(#c_values{es=Es}, Def, Rt, St) -> - return_match(Rt, length(Es), gexpr_list(Es, Def, St)); -gbody(E, Def, Rt, St0) -> - St1 = gexpr(E, Def, Rt, St0), - case core_lib:is_simple_top(E) of - true -> return_match(Rt, 1, St1); - false -> St1 - end. - -gexpr(#c_var{name=N}, Def, _Rt, St) -> expr_var(N, Def, St); -gexpr(#c_int{}, _Def, _Rt, St) -> St; -gexpr(#c_float{}, _Def, _Rt, St) -> St; -gexpr(#c_atom{}, _Def, _Rt, St) -> St; -gexpr(#c_char{}, _Def, _Rt, St) -> St; -gexpr(#c_string{}, _Def, _Rt, St) -> St; -gexpr(#c_nil{}, _Def, _Rt, St) -> St; -gexpr(#c_cons{hd=H,tl=T}, Def, _Rt, St) -> - gexpr_list([H,T], Def, St); -gexpr(#c_tuple{es=Es}, Def, _Rt, St) -> - gexpr_list(Es, Def, St); -gexpr(#c_binary{segments=Ss}, Def, _Rt, St) -> - gbitstr_list(Ss, Def, St); -gexpr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) -> - St1 = gexpr(Arg, Def, any, St0), %Ignore values - gbody(B, Def, Rt, St1); -gexpr(#c_let{vars=Vs,arg=Arg,body=B}, Def, Rt, St0) -> - St1 = gbody(Arg, Def, let_varcount(Vs), St0), %This is a guard body - {Lvs,St2} = variable_list(Vs, St1), - gbody(B, union(Lvs, Def), Rt, St2); -gexpr(#c_call{module=#c_atom{val=erlang}, - name=#c_atom{}, - args=As}, Def, 1, St) -> - gexpr_list(As, Def, St); -gexpr(#c_primop{name=N,args=As}, Def, _Rt, St0) when record(N, c_atom) -> - gexpr_list(As, Def, St0); -gexpr(#c_try{arg=E,vars=[#c_var{name=X}],body=#c_var{name=X}, - evars=[#c_var{},#c_var{},#c_var{}],handler=#c_atom{val=false}}, - Def, Rt, St) -> - gbody(E, Def, Rt, St); -gexpr(_, _, _, St) -> - add_error({illegal_guard,St#lint.func}, St). - -%% gexpr_list([Expr], Defined, State) -> State. - -gexpr_list(Es, Def, St0) -> - foldl(fun (E, St) -> gexpr(E, Def, 1, St) end, St0, Es). - -%% gbitstr_list([Elem], Defined, State) -> State. - -gbitstr_list(Es, Def, St0) -> - foldl(fun (E, St) -> gbitstr(E, Def, St) end, St0, Es). - -gbitstr(#c_bitstr{val=V,size=S,unit=U,type=T,flags=Fs}, Def, St0) -> - St1 = bit_type(U, T, Fs, St0), - gexpr_list([V,S], Def, St1). - -%% expr(Expr, Defined, RetCount, State) -> State. - -expr(#c_var{name=N}, Def, _Rt, St) -> expr_var(N, Def, St); -expr(#c_int{}, _Def, _Rt, St) -> St; -expr(#c_float{}, _Def, _Rt, St) -> St; -expr(#c_atom{}, _Def, _Rt, St) -> St; -expr(#c_char{}, _Def, _Rt, St) -> St; -expr(#c_string{}, _Def, _Rt, St) -> St; -expr(#c_nil{}, _Def, _Rt, St) -> St; -expr(#c_cons{hd=H,tl=T}, Def, _Rt, St) -> - expr_list([H,T], Def, St); -expr(#c_tuple{es=Es}, Def, _Rt, St) -> - expr_list(Es, Def, St); -expr(#c_binary{segments=Ss}, Def, _Rt, St) -> - bitstr_list(Ss, Def, St); -expr(#c_fname{id=I,arity=A}, Def, _Rt, St) -> - expr_fname({I,A}, Def, St); -expr(#c_fun{vars=Vs,body=B}, Def, Rt, St0) -> - {Vvs,St1} = variable_list(Vs, St0), - return_match(Rt, 1, body(B, union(Vvs, Def), any, St1)); -expr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) -> - St1 = expr(Arg, Def, any, St0), %Ignore values - body(B, Def, Rt, St1); -expr(#c_let{vars=Vs,arg=Arg,body=B}, Def, Rt, St0) -> - St1 = body(Arg, Def, let_varcount(Vs), St0), %This is a body - {Lvs,St2} = variable_list(Vs, St1), - body(B, union(Lvs, Def), Rt, St2); -expr(#c_letrec{defs=Fs,body=B}, Def0, Rt, St0) -> - Def1 = union(defined_funcs(Fs), Def0), %All defined stuff - St1 = functions(Fs, Def1, St0), - body(B, Def1, Rt, St1#lint{func=St0#lint.func}); -expr(#c_case{arg=Arg,clauses=Cs}, Def, Rt, St0) -> - Pc = case_patcount(Cs), - St1 = body(Arg, Def, Pc, St0), - clauses(Cs, Def, Pc, Rt, St1); -expr(#c_receive{clauses=Cs,timeout=T,action=A}, Def, Rt, St0) -> - St1 = expr(T, Def, 1, St0), - St2 = body(A, Def, Rt, St1), - clauses(Cs, Def, 1, Rt, St2); -expr(#c_apply{op=Op,args=As}, Def, _Rt, St0) -> - St1 = apply_op(Op, Def, length(As), St0), - expr_list(As, Def, St1); -expr(#c_call{module=M,name=N,args=As}, Def, _Rt, St0) -> - St1 = expr(M, Def, 1, St0), - St2 = expr(N, Def, 1, St1), - expr_list(As, Def, St2); -expr(#c_primop{name=N,args=As}, Def, _Rt, St0) when record(N, c_atom) -> - expr_list(As, Def, St0); -expr(#c_catch{body=B}, Def, Rt, St) -> - return_match(Rt, 1, body(B, Def, 1, St)); -expr(#c_try{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Def, Rt, St0) -> - St1 = case length(Evs) of - 2 -> St0; - _ -> add_error({illegal_try,St0#lint.func}, St0) - end, - St2 = body(A, Def, let_varcount(Vs), St1), - {Ns,St3} = variable_list(Vs, St2), - St4 = body(B, union(Ns, Def), Rt, St3), - {Ens,St5} = variable_list(Evs, St4), - body(H, union(Ens, Def), Rt, St5); -expr(_, _, _, St) -> - %%io:fwrite("clint: ~p~n", [Other]), - add_error({illegal_expr,St#lint.func}, St). - -%% expr_list([Expr], Defined, State) -> State. - -expr_list(Es, Def, St0) -> - foldl(fun (E, St) -> expr(E, Def, 1, St) end, St0, Es). - -%% bitstr_list([Elem], Defined, State) -> State. - -bitstr_list(Es, Def, St0) -> - foldl(fun (E, St) -> bitstr(E, Def, St) end, St0, Es). - -bitstr(#c_bitstr{val=V,size=S,unit=U,type=T,flags=Fs}, Def, St0) -> - St1 = bit_type(U, T, Fs, St0), - expr_list([V,S], Def, St1). - -%% apply_op(Op, Defined, ArgCount, State) -> State. -%% A apply op is either an fname or an expression. - -apply_op(#c_fname{id=I,arity=A}, Def, Ac, St0) -> - St1 = expr_fname({I,A}, Def, St0), - arg_match(Ac, A, St1); -apply_op(E, Def, _, St) -> expr(E, Def, 1, St). %Hard to check - -%% expr_var(VarName, Defined, State) -> State. - -expr_var(N, Def, St) -> - case is_element(N, Def) of - true -> St; - false -> add_error({unbound_var,N,St#lint.func}, St) - end. - -%% expr_fname(Fname, Defined, State) -> State. - -expr_fname(Fname, Def, St) -> - case is_element(Fname, Def) of - true -> St; - false -> add_error({undefined_function,Fname,St#lint.func}, St) - end. - -%% let_varcount([Var]) -> int(). - -let_varcount([]) -> any; %Ignore values -let_varcount(Es) -> length(Es). - -%% case_patcount([Clause]) -> int(). - -case_patcount([#c_clause{pats=Ps}|_]) -> length(Ps). - -%% clauses([Clause], Defined, PatCount, RetCount, State) -> State. - -clauses(Cs, Def, Pc, Rt, St0) -> - foldl(fun (C, St) -> clause(C, Def, Pc, Rt, St) end, St0, Cs). - -%% clause(Clause, Defined, PatCount, RetCount, State) -> State. - -clause(#c_clause{pats=Ps,guard=G,body=B}, Def0, Pc, Rt, St0) -> - St1 = pattern_match(Pc, length(Ps), St0), - {Pvs,St2} = pattern_list(Ps, Def0, St1), - Def1 = union(Pvs, Def0), - St3 = guard(G, Def1, St2), - body(B, Def1, Rt, St3). - -%% variable(Var, [PatVar], State) -> {[VarName],State}. - -variable(#c_var{name=N}, Ps, St) -> - case is_element(N, Ps) of - true -> {[],add_error({duplicate_var,N,St#lint.func}, St)}; - false -> {[N],St} - end; -variable(_, Def, St) -> {Def,add_error({not_var,St#lint.func}, St)}. - -%% variable_list([Var], State) -> {[Var],State}. -%% variable_list([Var], [PatVar], State) -> {[Var],State}. - -variable_list(Vs, St) -> variable_list(Vs, [], St). - -variable_list(Vs, Ps, St) -> - foldl(fun (V, {Ps0,St0}) -> - {Vvs,St1} = variable(V, Ps0, St0), - {union(Vvs, Ps0),St1} - end, {Ps,St}, Vs). - -%% pattern(Pattern, Defined, State) -> {[PatVar],State}. -%% pattern(Pattern, Defined, [PatVar], State) -> {[PatVar],State}. -%% Patterns are complicated by sizes in binaries. These are pure -%% input variables which create no bindings. We, therefor, need to -%% carry around the original defined variables to get the correct -%% handling. - -%% pattern(P, Def, St) -> pattern(P, Def, [], St). - -pattern(#c_var{name=N}, Def, Ps, St) -> - pat_var(N, Def, Ps, St); -pattern(#c_int{}, _Def, Ps, St) -> {Ps,St}; -pattern(#c_float{}, _Def, Ps, St) -> {Ps,St}; -pattern(#c_atom{}, _Def, Ps, St) -> {Ps,St}; -pattern(#c_char{}, _Def, Ps, St) -> {Ps,St}; -pattern(#c_string{}, _Def, Ps, St) -> {Ps,St}; -pattern(#c_nil{}, _Def, Ps, St) -> {Ps,St}; -pattern(#c_cons{hd=H,tl=T}, Def, Ps, St) -> - pattern_list([H,T], Def, Ps, St); -pattern(#c_tuple{es=Es}, Def, Ps, St) -> - pattern_list(Es, Def, Ps, St); -pattern(#c_binary{segments=Ss}, Def, Ps, St) -> - pat_bin(Ss, Def, Ps, St); -pattern(#c_alias{var=V,pat=P}, Def, Ps, St0) -> - {Vvs,St1} = variable(V, Ps, St0), - pattern(P, Def, union(Vvs, Ps), St1); -pattern(_, _, Ps, St) -> {Ps,add_error({not_pattern,St#lint.func}, St)}. - -pat_var(N, _Def, Ps, St) -> - case is_element(N, Ps) of - true -> {Ps,add_error({duplicate_var,N,St#lint.func}, St)}; - false -> {add_element(N, Ps),St} - end. - -%% pat_bin_list([Elem], Defined, [PatVar], State) -> {[PatVar],State}. - -pat_bin(Es, Def, Ps0, St0) -> - foldl(fun (E, {Ps,St}) -> pat_segment(E, Def, Ps, St) end, {Ps0,St0}, Es). - -pat_segment(#c_bitstr{val=V,size=S,unit=U,type=T,flags=Fs}, Def, Ps, St0) -> - St1 = bit_type(U, T, Fs, St0), - St2 = pat_bit_expr(S, T, Def, St1), - pattern(V, Def, Ps, St2); -pat_segment(_, _, Ps, St) -> - {Ps,add_error({not_bs_pattern,St#lint.func}, St)}. - -%% pat_bit_expr(SizePat, Type, Defined, State) -> State. -%% Check the Size pattern, this is an input! Be a bit tough here. - -pat_bit_expr(#c_int{val=I}, _, _, St) when I >= 0 -> St; -pat_bit_expr(#c_var{name=N}, _, Def, St) -> - expr_var(N, Def, St); -pat_bit_expr(#c_atom{val=all}, binary, _Def, St) -> St; -pat_bit_expr(_, _, _, St) -> - add_error({illegal_expr,St#lint.func}, St). - -bit_type(Unit, Type, Flags, St) -> - U = core_lib:literal_value(Unit), - T = core_lib:literal_value(Type), - Fs = core_lib:literal_value(Flags), - case erl_bits:set_bit_type(default, [T,{unit,U}|Fs]) of - {ok,_,_} -> St; - {error,E} -> add_error({E,St#lint.func}, St) - end. - -%% pattern_list([Var], Defined, State) -> {[PatVar],State}. -%% pattern_list([Var], Defined, [PatVar], State) -> {[PatVar],State}. - -pattern_list(Pats, Def, St) -> pattern_list(Pats, Def, [], St). - -pattern_list(Pats, Def, Ps0, St0) -> - foldl(fun (P, {Ps,St}) -> pattern(P, Def, Ps, St) end, {Ps0,St0}, Pats). - -%% pattern_match(Required, Supplied, State) -> State. -%% Check that the required number of patterns match the supplied. - -pattern_match(N, N, St) -> St; -pattern_match(_Req, _Sup, St) -> - add_error({pattern_mismatch,St#lint.func}, St). - -%% return_match(Required, Supplied, State) -> State. -%% Check that the required number of return values match the supplied. - -return_match(any, _Sup, St) -> St; -return_match(_Req, unknown, St) -> St; -return_match(N, N, St) -> St; -return_match(_Req, _Sup, St) -> - add_error({return_mismatch,St#lint.func}, St). - -%% arg_match(Required, Supplied, State) -> State. - -arg_match(_Req, unknown, St) -> St; -arg_match(N, N, St) -> St; -arg_match(_Req, _Sup, St) -> - add_error({arg_mismatch,St#lint.func}, St). diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_parse.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_parse.erl deleted file mode 100644 index 942845bef7..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_parse.erl +++ /dev/null @@ -1,4911 +0,0 @@ --module(core_parse). --define(THIS_MODULE, core_parse). --export([parse/1, parse_and_scan/1, format_error/1]). - --export([abstract/1,abstract/2,normalise/1]). - -%% The following directive is needed for (significantly) faster compilation -%% of the generated .erl file by the HiPE compiler. Please do not remove. --compile([{hipe,[{regalloc,linear_scan}]}]). - --include("core_parse.hrl"). - -tok_val(T) -> element(3, T). -tok_line(T) -> element(2, T). - -abstract(T, _N) -> abstract(T). - -abstract(Term) -> core_lib:make_literal(Term). - -normalise(Core) -> core_lib:literal_value(Core). - -%% ``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 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. -%% -%% 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: core_parse.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $ -%% - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% The parser generator will insert appropriate declarations before this line.% - -parse(Tokens) -> - case catch yeccpars1(Tokens, false, 0, [], []) of - error -> - Errorline = - if Tokens == [] -> 0; true -> element(2, hd(Tokens)) end, - {error, - {Errorline, ?THIS_MODULE, "syntax error at or after this line."}}; - Other -> - Other - end. - -parse_and_scan({Mod, Fun, Args}) -> - case apply(Mod, Fun, Args) of - {eof, _} -> - {ok, eof}; - {error, Descriptor, _} -> - {error, Descriptor}; - {ok, Tokens, _} -> - yeccpars1(Tokens, {Mod, Fun, Args}, 0, [], []) - end. - -format_error(Message) -> - case io_lib:deep_char_list(Message) of - true -> - Message; - _ -> - io_lib:write(Message) - end. - -% To be used in grammar files to throw an error message to the parser toplevel. -% Doesn't have to be exported! -return_error(Line, Message) -> - throw({error, {Line, ?THIS_MODULE, Message}}). - - -% Don't change yeccpars1/6 too much, it is called recursively by yeccpars2/8! -yeccpars1([Token | Tokens], Tokenizer, State, States, Vstack) -> - yeccpars2(State, element(1, Token), States, Vstack, Token, Tokens, - Tokenizer); -yeccpars1([], {M, F, A}, State, States, Vstack) -> - case catch apply(M, F, A) of - {eof, Endline} -> - {error, {Endline, ?THIS_MODULE, "end_of_file"}}; - {error, Descriptor, _Endline} -> - {error, Descriptor}; - {'EXIT', Reason} -> - {error, {0, ?THIS_MODULE, Reason}}; - {ok, Tokens, _Endline} -> - case catch yeccpars1(Tokens, {M, F, A}, State, States, Vstack) of - error -> - Errorline = element(2, hd(Tokens)), - {error, {Errorline, ?THIS_MODULE, - "syntax error at or after this line."}}; - Other -> - Other - end - end; -yeccpars1([], false, State, States, Vstack) -> - yeccpars2(State, '$end', States, Vstack, {'$end', 999999}, [], false). - -% For internal use only. -yeccerror(Token) -> - {error, - {element(2, Token), ?THIS_MODULE, - ["syntax error before: ", yecctoken2string(Token)]}}. - -yecctoken2string({atom, _, A}) -> io_lib:write(A); -yecctoken2string({integer,_,N}) -> io_lib:write(N); -yecctoken2string({float,_,F}) -> io_lib:write(F); -yecctoken2string({char,_,C}) -> io_lib:write_char(C); -yecctoken2string({var,_,V}) -> io_lib:format('~s', [V]); -yecctoken2string({string,_,S}) -> io_lib:write_string(S); -yecctoken2string({reserved_symbol, _, A}) -> io_lib:format('~w', [A]); -yecctoken2string({_Cat, _, Val}) -> io_lib:format('~w', [Val]); - -yecctoken2string({'dot', _}) -> io_lib:format('~w', ['.']); -yecctoken2string({'$end', _}) -> - []; -yecctoken2string({Other, _}) when atom(Other) -> - io_lib:format('~w', [Other]); -yecctoken2string(Other) -> - io_lib:write(Other). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - -yeccpars2(0, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 1, [0 | __Ss], [__T | __Stack]); -yeccpars2(0, 'module', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 2, [0 | __Ss], [__T | __Stack]); -yeccpars2(0, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(1, 'module', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 313, [1 | __Ss], [__T | __Stack]); -yeccpars2(1, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(2, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 4, [2 | __Ss], [__T | __Stack]); -yeccpars2(2, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(3, '$end', _, __Stack, _, _, _) -> - {ok, hd(__Stack)}; -yeccpars2(3, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(4, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 5, [4 | __Ss], [__T | __Stack]); -yeccpars2(4, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(5, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 11, [5 | __Ss], [__T | __Stack]); -yeccpars2(5, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 306, [5 | __Ss], [__T | __Stack]); -yeccpars2(5, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(6, 'attributes', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 7, [6 | __Ss], [__T | __Stack]); -yeccpars2(6, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(7, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 276, [7 | __Ss], [__T | __Stack]); -yeccpars2(7, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(8, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 9, [8 | __Ss], [__T | __Stack]); -yeccpars2(8, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 11, [8 | __Ss], [__T | __Stack]); -yeccpars2(8, __Cat, __Ss, __Stack, __T, __Ts, __Tzr) -> - __Val = [], - yeccpars2(13, __Cat, [8 | __Ss], [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(9, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 11, [9 | __Ss], [__T | __Stack]); -yeccpars2(9, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(10, '=', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 20, [10 | __Ss], [__T | __Stack]); -yeccpars2(10, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(11, '/', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 18, [11 | __Ss], [__T | __Stack]); -yeccpars2(11, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(12, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 9, [12 | __Ss], [__T | __Stack]); -yeccpars2(12, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 11, [12 | __Ss], [__T | __Stack]); -yeccpars2(12, __Cat, __Ss, __Stack, __T, __Ts, __Tzr) -> - __Val = [], - yeccpars2(17, __Cat, [12 | __Ss], [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(13, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(module_defs, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(14, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(anno_function_name, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(15, 'end', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 16, [15 | __Ss], [__T | __Stack]); -yeccpars2(15, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(16, __Cat, __Ss, [__6,__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_module{name = #c_atom{val = tok_val(__2)}, exports = __3, attrs = __4, defs = __5}, - __Nss = lists:nthtail(5, __Ss), - yeccpars2(yeccgoto(module_definition, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(17, __Cat, __Ss, [__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1|__2], - __Nss = lists:nthtail(1, __Ss), - yeccpars2(yeccgoto(function_definitions, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(18, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 19, [18 | __Ss], [__T | __Stack]); -yeccpars2(18, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(19, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_fname{id = tok_val(__1), arity = tok_val(__3)}, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(function_name, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(20, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [20 | __Ss], [__T | __Stack]); -yeccpars2(20, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 21, [20 | __Ss], [__T | __Stack]); -yeccpars2(20, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(21, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [21 | __Ss], [__T | __Stack]); -yeccpars2(21, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(22, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_def{name = __1, val = __3}, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(function_definition, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(23, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 25, [23 | __Ss], [__T | __Stack]); -yeccpars2(23, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(24, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(anno_fun, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(25, ')', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 27, [25 | __Ss], [__T | __Stack]); -yeccpars2(25, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 26, [25 | __Ss], [__T | __Stack]); -yeccpars2(25, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [25 | __Ss], [__T | __Stack]); -yeccpars2(25, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(26, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [26 | __Ss], [__T | __Stack]); -yeccpars2(26, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(27, '->', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 265, [27 | __Ss], [__T | __Stack]); -yeccpars2(27, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(28, ',', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 263, [28 | __Ss], [__T | __Stack]); -yeccpars2(28, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1], - yeccpars2(yeccgoto(anno_variables, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(29, ')', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 32, [29 | __Ss], [__T | __Stack]); -yeccpars2(29, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(30, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_var{name = tok_val(__1)}, - yeccpars2(yeccgoto(variable, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(31, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(anno_variable, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(32, '->', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 33, [32 | __Ss], [__T | __Stack]); -yeccpars2(32, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(33, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [33 | __Ss], [__T | __Stack]); -yeccpars2(33, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(34, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 247, [34 | __Ss], [__T | __Stack]); -yeccpars2(34, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(35, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [35 | __Ss], [__T | __Stack]); -yeccpars2(35, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(36, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, '>', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 240, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [36 | __Ss], [__T | __Stack]); -yeccpars2(36, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(37, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 149, [37 | __Ss], [__T | __Stack]); -yeccpars2(37, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(38, __Cat, __Ss, [__6,__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_fun{vars = __3, body = __6}, - __Nss = lists:nthtail(5, __Ss), - yeccpars2(yeccgoto(fun_expr, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(39, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(single_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(40, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [40 | __Ss], [__T | __Stack]); -yeccpars2(40, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(41, '/', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 18, [41 | __Ss], [__T | __Stack]); -yeccpars2(41, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_atom{val = tok_val(__1)}, - yeccpars2(yeccgoto(atomic_literal, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(42, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(single_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(43, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(single_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(44, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [44 | __Ss], [__T | __Stack]); -yeccpars2(44, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(45, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(single_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(46, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [46 | __Ss], [__T | __Stack]); -yeccpars2(46, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(47, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(single_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(48, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [48 | __Ss], [__T | __Stack]); -yeccpars2(48, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(49, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(single_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(50, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_char{val = tok_val(__1)}, - yeccpars2(yeccgoto(atomic_literal, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(51, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(single_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(52, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [52 | __Ss], [__T | __Stack]); -yeccpars2(52, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(53, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(anno_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(54, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_float{val = tok_val(__1)}, - yeccpars2(yeccgoto(atomic_literal, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(55, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(single_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(56, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(single_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(57, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_int{val = tok_val(__1)}, - yeccpars2(yeccgoto(atomic_literal, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(58, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 83, [58 | __Ss], [__T | __Stack]); -yeccpars2(58, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 26, [58 | __Ss], [__T | __Stack]); -yeccpars2(58, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [58 | __Ss], [__T | __Stack]); -yeccpars2(58, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(59, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(single_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(60, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 9, [60 | __Ss], [__T | __Stack]); -yeccpars2(60, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 11, [60 | __Ss], [__T | __Stack]); -yeccpars2(60, __Cat, __Ss, __Stack, __T, __Ts, __Tzr) -> - __Val = [], - yeccpars2(210, __Cat, [60 | __Ss], [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(61, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(single_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(62, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_nil{}, - yeccpars2(yeccgoto(atomic_literal, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(63, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 208, [63 | __Ss], [__T | __Stack]); -yeccpars2(63, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(64, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(single_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(65, 'after', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 99, [65 | __Ss], [__T | __Stack]); -yeccpars2(65, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 97, [65 | __Ss], [__T | __Stack]); -yeccpars2(65, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 96, [65 | __Ss], [__T | __Stack]); -yeccpars2(65, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [65 | __Ss], [__T | __Stack]); -yeccpars2(65, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [65 | __Ss], [__T | __Stack]); -yeccpars2(65, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [65 | __Ss], [__T | __Stack]); -yeccpars2(65, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [65 | __Ss], [__T | __Stack]); -yeccpars2(65, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [65 | __Ss], [__T | __Stack]); -yeccpars2(65, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [65 | __Ss], [__T | __Stack]); -yeccpars2(65, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 95, [65 | __Ss], [__T | __Stack]); -yeccpars2(65, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 98, [65 | __Ss], [__T | __Stack]); -yeccpars2(65, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 114, [65 | __Ss], [__T | __Stack]); -yeccpars2(65, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(66, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(single_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(67, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(single_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(68, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(69, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_string{val = tok_val(__1)}, - yeccpars2(yeccgoto(atomic_literal, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(70, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [70 | __Ss], [__T | __Stack]); -yeccpars2(70, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(71, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(single_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(72, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(single_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(73, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(single_expression, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(74, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, '}', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 77, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [74 | __Ss], [__T | __Stack]); -yeccpars2(74, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(75, ',', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 79, [75 | __Ss], [__T | __Stack]); -yeccpars2(75, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1], - yeccpars2(yeccgoto(anno_expressions, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(76, '}', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 78, [76 | __Ss], [__T | __Stack]); -yeccpars2(76, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(77, __Cat, __Ss, [__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_tuple{es = []}, - __Nss = lists:nthtail(1, __Ss), - yeccpars2(yeccgoto(tuple, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(78, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_tuple{es = __2}, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(tuple, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(79, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [79 | __Ss], [__T | __Stack]); -yeccpars2(79, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(80, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1|__3], - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(anno_expressions, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(81, 'of', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 82, [81 | __Ss], [__T | __Stack]); -yeccpars2(81, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(82, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 83, [82 | __Ss], [__T | __Stack]); -yeccpars2(82, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 26, [82 | __Ss], [__T | __Stack]); -yeccpars2(82, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [82 | __Ss], [__T | __Stack]); -yeccpars2(82, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(83, '>', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 92, [83 | __Ss], [__T | __Stack]); -yeccpars2(83, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 26, [83 | __Ss], [__T | __Stack]); -yeccpars2(83, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [83 | __Ss], [__T | __Stack]); -yeccpars2(83, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(84, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1], - yeccpars2(yeccgoto(let_vars, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(85, '->', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 86, [85 | __Ss], [__T | __Stack]); -yeccpars2(85, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(86, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [86 | __Ss], [__T | __Stack]); -yeccpars2(86, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(87, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 88, [87 | __Ss], [__T | __Stack]); -yeccpars2(87, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(88, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 83, [88 | __Ss], [__T | __Stack]); -yeccpars2(88, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 26, [88 | __Ss], [__T | __Stack]); -yeccpars2(88, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [88 | __Ss], [__T | __Stack]); -yeccpars2(88, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(89, '->', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 90, [89 | __Ss], [__T | __Stack]); -yeccpars2(89, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(90, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [90 | __Ss], [__T | __Stack]); -yeccpars2(90, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(91, __Cat, __Ss, [__10,__9,__8,__7,__6,__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = if length(__8) == 2 -> #c_try{arg = __2, vars = __4, body = __6, evars = __8, handler = __10}; true -> return_error(tok_line(__7),"expected 2 exception variables in 'try'") end, - __Nss = lists:nthtail(9, __Ss), - yeccpars2(yeccgoto(try_expr, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(92, __Cat, __Ss, [__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [], - __Nss = lists:nthtail(1, __Ss), - yeccpars2(yeccgoto(let_vars, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(93, '>', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 94, [93 | __Ss], [__T | __Stack]); -yeccpars2(93, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(94, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __2, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(let_vars, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(95, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 190, [95 | __Ss], [__T | __Stack]); -yeccpars2(95, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(96, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 97, [96 | __Ss], [__T | __Stack]); -yeccpars2(96, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [96 | __Ss], [__T | __Stack]); -yeccpars2(96, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [96 | __Ss], [__T | __Stack]); -yeccpars2(96, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [96 | __Ss], [__T | __Stack]); -yeccpars2(96, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [96 | __Ss], [__T | __Stack]); -yeccpars2(96, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [96 | __Ss], [__T | __Stack]); -yeccpars2(96, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 115, [96 | __Ss], [__T | __Stack]); -yeccpars2(96, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [96 | __Ss], [__T | __Stack]); -yeccpars2(96, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 95, [96 | __Ss], [__T | __Stack]); -yeccpars2(96, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 98, [96 | __Ss], [__T | __Stack]); -yeccpars2(96, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 114, [96 | __Ss], [__T | __Stack]); -yeccpars2(96, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(97, '>', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 182, [97 | __Ss], [__T | __Stack]); -yeccpars2(97, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [97 | __Ss], [__T | __Stack]); -yeccpars2(97, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [97 | __Ss], [__T | __Stack]); -yeccpars2(97, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [97 | __Ss], [__T | __Stack]); -yeccpars2(97, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [97 | __Ss], [__T | __Stack]); -yeccpars2(97, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [97 | __Ss], [__T | __Stack]); -yeccpars2(97, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 115, [97 | __Ss], [__T | __Stack]); -yeccpars2(97, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [97 | __Ss], [__T | __Stack]); -yeccpars2(97, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 95, [97 | __Ss], [__T | __Stack]); -yeccpars2(97, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 98, [97 | __Ss], [__T | __Stack]); -yeccpars2(97, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 114, [97 | __Ss], [__T | __Stack]); -yeccpars2(97, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(98, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [98 | __Ss], [__T | __Stack]); -yeccpars2(98, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [98 | __Ss], [__T | __Stack]); -yeccpars2(98, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [98 | __Ss], [__T | __Stack]); -yeccpars2(98, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [98 | __Ss], [__T | __Stack]); -yeccpars2(98, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [98 | __Ss], [__T | __Stack]); -yeccpars2(98, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 115, [98 | __Ss], [__T | __Stack]); -yeccpars2(98, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [98 | __Ss], [__T | __Stack]); -yeccpars2(98, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 95, [98 | __Ss], [__T | __Stack]); -yeccpars2(98, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 98, [98 | __Ss], [__T | __Stack]); -yeccpars2(98, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 114, [98 | __Ss], [__T | __Stack]); -yeccpars2(98, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 149, [98 | __Ss], [__T | __Stack]); -yeccpars2(98, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(99, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [99 | __Ss], [__T | __Stack]); -yeccpars2(99, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(100, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 97, [100 | __Ss], [__T | __Stack]); -yeccpars2(100, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 96, [100 | __Ss], [__T | __Stack]); -yeccpars2(100, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [100 | __Ss], [__T | __Stack]); -yeccpars2(100, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [100 | __Ss], [__T | __Stack]); -yeccpars2(100, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [100 | __Ss], [__T | __Stack]); -yeccpars2(100, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [100 | __Ss], [__T | __Stack]); -yeccpars2(100, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [100 | __Ss], [__T | __Stack]); -yeccpars2(100, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [100 | __Ss], [__T | __Stack]); -yeccpars2(100, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 95, [100 | __Ss], [__T | __Stack]); -yeccpars2(100, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 98, [100 | __Ss], [__T | __Stack]); -yeccpars2(100, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 114, [100 | __Ss], [__T | __Stack]); -yeccpars2(100, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1], - yeccpars2(yeccgoto(anno_clauses, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(101, 'after', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 99, [101 | __Ss], [__T | __Stack]); -yeccpars2(101, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(102, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1], - yeccpars2(yeccgoto(clause_pattern, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(103, '=', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 162, [103 | __Ss], [__T | __Stack]); -yeccpars2(103, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(anno_pattern, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(104, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_atom{val = tok_val(__1)}, - yeccpars2(yeccgoto(atomic_literal, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(105, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(atomic_pattern, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(106, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(other_pattern, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(107, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(other_pattern, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(108, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(anno_clause, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(109, 'when', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 164, [109 | __Ss], [__T | __Stack]); -yeccpars2(109, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(110, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(other_pattern, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(111, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(anno_pattern, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(112, __Cat, __Ss, [__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = begin - {T,A} = __2, #c_receive{clauses = [], timeout = T, action = A} - end, - __Nss = lists:nthtail(1, __Ss), - yeccpars2(yeccgoto(receive_expr, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(113, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(other_pattern, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(114, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [114 | __Ss], [__T | __Stack]); -yeccpars2(114, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [114 | __Ss], [__T | __Stack]); -yeccpars2(114, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [114 | __Ss], [__T | __Stack]); -yeccpars2(114, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [114 | __Ss], [__T | __Stack]); -yeccpars2(114, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [114 | __Ss], [__T | __Stack]); -yeccpars2(114, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 115, [114 | __Ss], [__T | __Stack]); -yeccpars2(114, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [114 | __Ss], [__T | __Stack]); -yeccpars2(114, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 95, [114 | __Ss], [__T | __Stack]); -yeccpars2(114, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 98, [114 | __Ss], [__T | __Stack]); -yeccpars2(114, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 114, [114 | __Ss], [__T | __Stack]); -yeccpars2(114, '}', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 118, [114 | __Ss], [__T | __Stack]); -yeccpars2(114, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(115, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [115 | __Ss], [__T | __Stack]); -yeccpars2(115, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [115 | __Ss], [__T | __Stack]); -yeccpars2(115, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [115 | __Ss], [__T | __Stack]); -yeccpars2(115, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [115 | __Ss], [__T | __Stack]); -yeccpars2(115, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [115 | __Ss], [__T | __Stack]); -yeccpars2(115, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 26, [115 | __Ss], [__T | __Stack]); -yeccpars2(115, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [115 | __Ss], [__T | __Stack]); -yeccpars2(115, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 95, [115 | __Ss], [__T | __Stack]); -yeccpars2(115, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 98, [115 | __Ss], [__T | __Stack]); -yeccpars2(115, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 114, [115 | __Ss], [__T | __Stack]); -yeccpars2(115, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(116, ',', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 120, [116 | __Ss], [__T | __Stack]); -yeccpars2(116, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1], - yeccpars2(yeccgoto(anno_patterns, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(117, '}', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 119, [117 | __Ss], [__T | __Stack]); -yeccpars2(117, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(118, __Cat, __Ss, [__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_tuple{es = []}, - __Nss = lists:nthtail(1, __Ss), - yeccpars2(yeccgoto(tuple_pattern, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(119, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_tuple{es = __2}, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(tuple_pattern, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(120, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [120 | __Ss], [__T | __Stack]); -yeccpars2(120, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [120 | __Ss], [__T | __Stack]); -yeccpars2(120, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [120 | __Ss], [__T | __Stack]); -yeccpars2(120, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [120 | __Ss], [__T | __Stack]); -yeccpars2(120, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [120 | __Ss], [__T | __Stack]); -yeccpars2(120, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 115, [120 | __Ss], [__T | __Stack]); -yeccpars2(120, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [120 | __Ss], [__T | __Stack]); -yeccpars2(120, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 95, [120 | __Ss], [__T | __Stack]); -yeccpars2(120, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 98, [120 | __Ss], [__T | __Stack]); -yeccpars2(120, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 114, [120 | __Ss], [__T | __Stack]); -yeccpars2(120, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(121, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1|__3], - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(anno_patterns, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(122, '=', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 162, [122 | __Ss], [__T | __Stack]); -yeccpars2(122, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(123, '-|', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 159, [123 | __Ss], [__T | __Stack]); -yeccpars2(123, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(124, '-|', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 125, [124 | __Ss], [__T | __Stack]); -yeccpars2(124, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(anno_variable, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(125, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 126, [125 | __Ss], [__T | __Stack]); -yeccpars2(125, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(126, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 129, [126 | __Ss], [__T | __Stack]); -yeccpars2(126, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 142, [126 | __Ss], [__T | __Stack]); -yeccpars2(126, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 140, [126 | __Ss], [__T | __Stack]); -yeccpars2(126, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 131, [126 | __Ss], [__T | __Stack]); -yeccpars2(126, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 137, [126 | __Ss], [__T | __Stack]); -yeccpars2(126, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 138, [126 | __Ss], [__T | __Stack]); -yeccpars2(126, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 133, [126 | __Ss], [__T | __Stack]); -yeccpars2(126, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 130, [126 | __Ss], [__T | __Stack]); -yeccpars2(126, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(127, ')', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 128, [127 | __Ss], [__T | __Stack]); -yeccpars2(127, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(128, __Cat, __Ss, [__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = core_lib:set_anno(__2,__4), - __Nss = lists:nthtail(4, __Ss), - yeccpars2(yeccgoto(anno_variable, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(129, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 129, [129 | __Ss], [__T | __Stack]); -yeccpars2(129, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 142, [129 | __Ss], [__T | __Stack]); -yeccpars2(129, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 140, [129 | __Ss], [__T | __Stack]); -yeccpars2(129, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 131, [129 | __Ss], [__T | __Stack]); -yeccpars2(129, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 137, [129 | __Ss], [__T | __Stack]); -yeccpars2(129, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 138, [129 | __Ss], [__T | __Stack]); -yeccpars2(129, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 133, [129 | __Ss], [__T | __Stack]); -yeccpars2(129, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 149, [129 | __Ss], [__T | __Stack]); -yeccpars2(129, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(130, __Cat, __Ss, [__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [], - __Nss = lists:nthtail(1, __Ss), - yeccpars2(yeccgoto(annotation, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(131, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = tok_val(__1), - yeccpars2(yeccgoto(atomic_constant, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(132, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(constant, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(133, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = tok_val(__1), - yeccpars2(yeccgoto(atomic_constant, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(134, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(constant, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(135, ',', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 147, [135 | __Ss], [__T | __Stack]); -yeccpars2(135, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1], - yeccpars2(yeccgoto(constants, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(136, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 146, [136 | __Ss], [__T | __Stack]); -yeccpars2(136, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(137, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = tok_val(__1), - yeccpars2(yeccgoto(atomic_constant, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(138, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = tok_val(__1), - yeccpars2(yeccgoto(atomic_constant, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(139, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [], - yeccpars2(yeccgoto(atomic_constant, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(140, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = tok_val(__1), - yeccpars2(yeccgoto(atomic_constant, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(141, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(constant, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(142, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 129, [142 | __Ss], [__T | __Stack]); -yeccpars2(142, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 142, [142 | __Ss], [__T | __Stack]); -yeccpars2(142, '}', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 144, [142 | __Ss], [__T | __Stack]); -yeccpars2(142, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 140, [142 | __Ss], [__T | __Stack]); -yeccpars2(142, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 131, [142 | __Ss], [__T | __Stack]); -yeccpars2(142, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 137, [142 | __Ss], [__T | __Stack]); -yeccpars2(142, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 138, [142 | __Ss], [__T | __Stack]); -yeccpars2(142, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 133, [142 | __Ss], [__T | __Stack]); -yeccpars2(142, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(143, '}', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 145, [143 | __Ss], [__T | __Stack]); -yeccpars2(143, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(144, __Cat, __Ss, [__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = {}, - __Nss = lists:nthtail(1, __Ss), - yeccpars2(yeccgoto(tuple_constant, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(145, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = list_to_tuple(__2), - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(tuple_constant, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(146, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __2, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(annotation, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(147, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 129, [147 | __Ss], [__T | __Stack]); -yeccpars2(147, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 142, [147 | __Ss], [__T | __Stack]); -yeccpars2(147, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 140, [147 | __Ss], [__T | __Stack]); -yeccpars2(147, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 131, [147 | __Ss], [__T | __Stack]); -yeccpars2(147, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 137, [147 | __Ss], [__T | __Stack]); -yeccpars2(147, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 138, [147 | __Ss], [__T | __Stack]); -yeccpars2(147, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 133, [147 | __Ss], [__T | __Stack]); -yeccpars2(147, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(148, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1|__3], - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(constants, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(149, __Cat, __Ss, [__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = {nil,tok_line(__1)}, - __Nss = lists:nthtail(1, __Ss), - yeccpars2(yeccgoto(nil, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(150, ',', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 151, [150 | __Ss], [__T | __Stack]); -yeccpars2(150, '|', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 154, [150 | __Ss], [__T | __Stack]); -yeccpars2(150, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 152, [150 | __Ss], [__T | __Stack]); -yeccpars2(150, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(151, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 129, [151 | __Ss], [__T | __Stack]); -yeccpars2(151, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 142, [151 | __Ss], [__T | __Stack]); -yeccpars2(151, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 140, [151 | __Ss], [__T | __Stack]); -yeccpars2(151, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 131, [151 | __Ss], [__T | __Stack]); -yeccpars2(151, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 137, [151 | __Ss], [__T | __Stack]); -yeccpars2(151, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 138, [151 | __Ss], [__T | __Stack]); -yeccpars2(151, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 133, [151 | __Ss], [__T | __Stack]); -yeccpars2(151, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(152, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [], - yeccpars2(yeccgoto(tail_constant, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(153, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__2|__3], - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(cons_constant, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(154, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 129, [154 | __Ss], [__T | __Stack]); -yeccpars2(154, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 142, [154 | __Ss], [__T | __Stack]); -yeccpars2(154, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 140, [154 | __Ss], [__T | __Stack]); -yeccpars2(154, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 131, [154 | __Ss], [__T | __Stack]); -yeccpars2(154, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 137, [154 | __Ss], [__T | __Stack]); -yeccpars2(154, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 138, [154 | __Ss], [__T | __Stack]); -yeccpars2(154, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 133, [154 | __Ss], [__T | __Stack]); -yeccpars2(154, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(155, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 156, [155 | __Ss], [__T | __Stack]); -yeccpars2(155, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(156, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __2, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(tail_constant, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(157, ',', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 151, [157 | __Ss], [__T | __Stack]); -yeccpars2(157, '|', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 154, [157 | __Ss], [__T | __Stack]); -yeccpars2(157, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 152, [157 | __Ss], [__T | __Stack]); -yeccpars2(157, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(158, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__2|__3], - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(tail_constant, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(159, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 126, [159 | __Ss], [__T | __Stack]); -yeccpars2(159, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(160, ')', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 161, [160 | __Ss], [__T | __Stack]); -yeccpars2(160, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(161, __Cat, __Ss, [__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = core_lib:set_anno(__2,__4), - __Nss = lists:nthtail(4, __Ss), - yeccpars2(yeccgoto(anno_pattern, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(162, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [162 | __Ss], [__T | __Stack]); -yeccpars2(162, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [162 | __Ss], [__T | __Stack]); -yeccpars2(162, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [162 | __Ss], [__T | __Stack]); -yeccpars2(162, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [162 | __Ss], [__T | __Stack]); -yeccpars2(162, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [162 | __Ss], [__T | __Stack]); -yeccpars2(162, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 115, [162 | __Ss], [__T | __Stack]); -yeccpars2(162, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [162 | __Ss], [__T | __Stack]); -yeccpars2(162, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 95, [162 | __Ss], [__T | __Stack]); -yeccpars2(162, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 98, [162 | __Ss], [__T | __Stack]); -yeccpars2(162, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 114, [162 | __Ss], [__T | __Stack]); -yeccpars2(162, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(163, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_alias{var = __1, pat = __3}, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(other_pattern, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(164, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [164 | __Ss], [__T | __Stack]); -yeccpars2(164, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(165, '->', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 166, [165 | __Ss], [__T | __Stack]); -yeccpars2(165, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(166, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [166 | __Ss], [__T | __Stack]); -yeccpars2(166, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(167, __Cat, __Ss, [__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_clause{pats = __1, guard = __3, body = __5}, - __Nss = lists:nthtail(4, __Ss), - yeccpars2(yeccgoto(clause, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(168, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = begin - {T,A} = __3, #c_receive{clauses = __2, timeout = T, action = A} - end, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(receive_expr, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(169, __Cat, __Ss, [__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1|__2], - __Nss = lists:nthtail(1, __Ss), - yeccpars2(yeccgoto(anno_clauses, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(170, '->', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 171, [170 | __Ss], [__T | __Stack]); -yeccpars2(170, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(171, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [171 | __Ss], [__T | __Stack]); -yeccpars2(171, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(172, __Cat, __Ss, [__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = {__2,__4}, - __Nss = lists:nthtail(3, __Ss), - yeccpars2(yeccgoto(timeout, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(173, ',', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 174, [173 | __Ss], [__T | __Stack]); -yeccpars2(173, '|', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 177, [173 | __Ss], [__T | __Stack]); -yeccpars2(173, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 175, [173 | __Ss], [__T | __Stack]); -yeccpars2(173, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(174, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [174 | __Ss], [__T | __Stack]); -yeccpars2(174, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [174 | __Ss], [__T | __Stack]); -yeccpars2(174, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [174 | __Ss], [__T | __Stack]); -yeccpars2(174, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [174 | __Ss], [__T | __Stack]); -yeccpars2(174, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [174 | __Ss], [__T | __Stack]); -yeccpars2(174, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 115, [174 | __Ss], [__T | __Stack]); -yeccpars2(174, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [174 | __Ss], [__T | __Stack]); -yeccpars2(174, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 95, [174 | __Ss], [__T | __Stack]); -yeccpars2(174, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 98, [174 | __Ss], [__T | __Stack]); -yeccpars2(174, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 114, [174 | __Ss], [__T | __Stack]); -yeccpars2(174, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(175, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_nil{}, - yeccpars2(yeccgoto(tail_pattern, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(176, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_cons{hd = __2, tl = __3}, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(cons_pattern, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(177, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [177 | __Ss], [__T | __Stack]); -yeccpars2(177, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [177 | __Ss], [__T | __Stack]); -yeccpars2(177, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [177 | __Ss], [__T | __Stack]); -yeccpars2(177, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [177 | __Ss], [__T | __Stack]); -yeccpars2(177, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [177 | __Ss], [__T | __Stack]); -yeccpars2(177, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 115, [177 | __Ss], [__T | __Stack]); -yeccpars2(177, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [177 | __Ss], [__T | __Stack]); -yeccpars2(177, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 95, [177 | __Ss], [__T | __Stack]); -yeccpars2(177, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 98, [177 | __Ss], [__T | __Stack]); -yeccpars2(177, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 114, [177 | __Ss], [__T | __Stack]); -yeccpars2(177, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(178, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 179, [178 | __Ss], [__T | __Stack]); -yeccpars2(178, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(179, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __2, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(tail_pattern, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(180, ',', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 174, [180 | __Ss], [__T | __Stack]); -yeccpars2(180, '|', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 177, [180 | __Ss], [__T | __Stack]); -yeccpars2(180, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 175, [180 | __Ss], [__T | __Stack]); -yeccpars2(180, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(181, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_cons{hd = __2, tl = __3}, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(tail_pattern, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(182, __Cat, __Ss, [__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [], - __Nss = lists:nthtail(1, __Ss), - yeccpars2(yeccgoto(clause_pattern, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(183, '>', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 184, [183 | __Ss], [__T | __Stack]); -yeccpars2(183, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(184, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __2, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(clause_pattern, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(185, '-|', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 187, [185 | __Ss], [__T | __Stack]); -yeccpars2(185, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(186, '-|', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 159, [186 | __Ss], [__T | __Stack]); -yeccpars2(186, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(anno_pattern, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(187, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 126, [187 | __Ss], [__T | __Stack]); -yeccpars2(187, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(188, ')', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 189, [188 | __Ss], [__T | __Stack]); -yeccpars2(188, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(189, __Cat, __Ss, [__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = core_lib:set_anno(__2,__4), - __Nss = lists:nthtail(4, __Ss), - yeccpars2(yeccgoto(anno_clause, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(190, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 191, [190 | __Ss], [__T | __Stack]); -yeccpars2(190, '}', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 194, [190 | __Ss], [__T | __Stack]); -yeccpars2(190, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(191, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 200, [191 | __Ss], [__T | __Stack]); -yeccpars2(191, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(192, ',', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 198, [192 | __Ss], [__T | __Stack]); -yeccpars2(192, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1], - yeccpars2(yeccgoto(segment_patterns, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(193, '}', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 196, [193 | __Ss], [__T | __Stack]); -yeccpars2(193, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(194, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 195, [194 | __Ss], [__T | __Stack]); -yeccpars2(194, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(195, __Cat, __Ss, [__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_binary{segments = []}, - __Nss = lists:nthtail(3, __Ss), - yeccpars2(yeccgoto(binary_pattern, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(196, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 197, [196 | __Ss], [__T | __Stack]); -yeccpars2(196, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(197, __Cat, __Ss, [__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_binary{segments = __3}, - __Nss = lists:nthtail(4, __Ss), - yeccpars2(yeccgoto(binary_pattern, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(198, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 191, [198 | __Ss], [__T | __Stack]); -yeccpars2(198, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(199, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1|__3], - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(segment_patterns, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(200, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [200 | __Ss], [__T | __Stack]); -yeccpars2(200, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [200 | __Ss], [__T | __Stack]); -yeccpars2(200, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [200 | __Ss], [__T | __Stack]); -yeccpars2(200, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [200 | __Ss], [__T | __Stack]); -yeccpars2(200, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [200 | __Ss], [__T | __Stack]); -yeccpars2(200, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 115, [200 | __Ss], [__T | __Stack]); -yeccpars2(200, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [200 | __Ss], [__T | __Stack]); -yeccpars2(200, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 95, [200 | __Ss], [__T | __Stack]); -yeccpars2(200, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 98, [200 | __Ss], [__T | __Stack]); -yeccpars2(200, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 114, [200 | __Ss], [__T | __Stack]); -yeccpars2(200, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(201, '>', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 202, [201 | __Ss], [__T | __Stack]); -yeccpars2(201, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(202, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 203, [202 | __Ss], [__T | __Stack]); -yeccpars2(202, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(203, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, ')', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 205, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [203 | __Ss], [__T | __Stack]); -yeccpars2(203, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(204, __Cat, __Ss, [__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = case __5 of [S,U,T,Fs] -> #c_bitstr{val = __3, size = S, unit = U, type = T, flags = Fs}; true -> return_error(tok_line(__1),"expected 4 arguments in binary segment") end, - __Nss = lists:nthtail(4, __Ss), - yeccpars2(yeccgoto(segment_pattern, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(205, __Cat, __Ss, [__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [], - __Nss = lists:nthtail(1, __Ss), - yeccpars2(yeccgoto(arg_list, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(206, ')', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 207, [206 | __Ss], [__T | __Stack]); -yeccpars2(206, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(207, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __2, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(arg_list, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(208, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 203, [208 | __Ss], [__T | __Stack]); -yeccpars2(208, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(209, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = begin - Name = #c_atom{val = tok_val(__2)}, #c_primop{name = Name, args = __3} - end, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(primop_expr, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(210, 'in', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 211, [210 | __Ss], [__T | __Stack]); -yeccpars2(210, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(211, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [211 | __Ss], [__T | __Stack]); -yeccpars2(211, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(212, __Cat, __Ss, [__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_letrec{defs = __2, body = __4}, - __Nss = lists:nthtail(3, __Ss), - yeccpars2(yeccgoto(letrec_expr, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(213, '=', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 214, [213 | __Ss], [__T | __Stack]); -yeccpars2(213, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(214, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [214 | __Ss], [__T | __Stack]); -yeccpars2(214, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(215, 'in', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 216, [215 | __Ss], [__T | __Stack]); -yeccpars2(215, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(216, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [216 | __Ss], [__T | __Stack]); -yeccpars2(216, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(217, __Cat, __Ss, [__6,__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_let{vars = __2, arg = __4, body = __6}, - __Nss = lists:nthtail(5, __Ss), - yeccpars2(yeccgoto(let_expr, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(218, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [218 | __Ss], [__T | __Stack]); -yeccpars2(218, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(219, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_seq{arg = __2, body = __3}, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(sequence, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(220, __Cat, __Ss, [__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_catch{body = __2}, - __Nss = lists:nthtail(1, __Ss), - yeccpars2(yeccgoto(catch_expr, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(221, 'of', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 222, [221 | __Ss], [__T | __Stack]); -yeccpars2(221, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(222, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 97, [222 | __Ss], [__T | __Stack]); -yeccpars2(222, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 96, [222 | __Ss], [__T | __Stack]); -yeccpars2(222, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [222 | __Ss], [__T | __Stack]); -yeccpars2(222, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [222 | __Ss], [__T | __Stack]); -yeccpars2(222, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [222 | __Ss], [__T | __Stack]); -yeccpars2(222, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [222 | __Ss], [__T | __Stack]); -yeccpars2(222, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [222 | __Ss], [__T | __Stack]); -yeccpars2(222, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [222 | __Ss], [__T | __Stack]); -yeccpars2(222, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 95, [222 | __Ss], [__T | __Stack]); -yeccpars2(222, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 98, [222 | __Ss], [__T | __Stack]); -yeccpars2(222, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 114, [222 | __Ss], [__T | __Stack]); -yeccpars2(222, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(223, 'end', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 224, [223 | __Ss], [__T | __Stack]); -yeccpars2(223, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(224, __Cat, __Ss, [__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_case{arg = __2, clauses = __4}, - __Nss = lists:nthtail(4, __Ss), - yeccpars2(yeccgoto(case_expr, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(225, ':', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 226, [225 | __Ss], [__T | __Stack]); -yeccpars2(225, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(226, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [226 | __Ss], [__T | __Stack]); -yeccpars2(226, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(227, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 203, [227 | __Ss], [__T | __Stack]); -yeccpars2(227, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(228, __Cat, __Ss, [__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_call{module = __2, name = __4, args = __5}, - __Nss = lists:nthtail(4, __Ss), - yeccpars2(yeccgoto(call_expr, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(229, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 203, [229 | __Ss], [__T | __Stack]); -yeccpars2(229, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(230, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_apply{op = __2, args = __3}, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(application_expr, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(231, ',', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 232, [231 | __Ss], [__T | __Stack]); -yeccpars2(231, '|', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 235, [231 | __Ss], [__T | __Stack]); -yeccpars2(231, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 233, [231 | __Ss], [__T | __Stack]); -yeccpars2(231, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(232, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [232 | __Ss], [__T | __Stack]); -yeccpars2(232, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(233, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_nil{}, - yeccpars2(yeccgoto(tail, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(234, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_cons{hd = __2, tl = __3}, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(cons, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(235, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [235 | __Ss], [__T | __Stack]); -yeccpars2(235, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(236, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 237, [236 | __Ss], [__T | __Stack]); -yeccpars2(236, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(237, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __2, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(tail, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(238, ',', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 232, [238 | __Ss], [__T | __Stack]); -yeccpars2(238, '|', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 235, [238 | __Ss], [__T | __Stack]); -yeccpars2(238, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 233, [238 | __Ss], [__T | __Stack]); -yeccpars2(238, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(239, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_cons{hd = __2, tl = __3}, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(tail, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(240, __Cat, __Ss, [__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_values{es = []}, - __Nss = lists:nthtail(1, __Ss), - yeccpars2(yeccgoto(expression, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(241, '>', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 242, [241 | __Ss], [__T | __Stack]); -yeccpars2(241, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(242, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_values{es = __2}, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(expression, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(243, '-|', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 244, [243 | __Ss], [__T | __Stack]); -yeccpars2(243, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(244, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 126, [244 | __Ss], [__T | __Stack]); -yeccpars2(244, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(245, ')', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 246, [245 | __Ss], [__T | __Stack]); -yeccpars2(245, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(246, __Cat, __Ss, [__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = core_lib:set_anno(__2,__4), - __Nss = lists:nthtail(4, __Ss), - yeccpars2(yeccgoto(anno_expression, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(247, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 248, [247 | __Ss], [__T | __Stack]); -yeccpars2(247, '}', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 251, [247 | __Ss], [__T | __Stack]); -yeccpars2(247, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(248, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 257, [248 | __Ss], [__T | __Stack]); -yeccpars2(248, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(249, ',', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 255, [249 | __Ss], [__T | __Stack]); -yeccpars2(249, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1], - yeccpars2(yeccgoto(segments, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(250, '}', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 253, [250 | __Ss], [__T | __Stack]); -yeccpars2(250, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(251, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 252, [251 | __Ss], [__T | __Stack]); -yeccpars2(251, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(252, __Cat, __Ss, [__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_binary{segments = []}, - __Nss = lists:nthtail(3, __Ss), - yeccpars2(yeccgoto(binary, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(253, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 254, [253 | __Ss], [__T | __Stack]); -yeccpars2(253, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(254, __Cat, __Ss, [__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_binary{segments = __3}, - __Nss = lists:nthtail(4, __Ss), - yeccpars2(yeccgoto(binary, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(255, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 248, [255 | __Ss], [__T | __Stack]); -yeccpars2(255, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(256, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1|__3], - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(segments, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(257, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [257 | __Ss], [__T | __Stack]); -yeccpars2(257, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(258, '>', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 259, [258 | __Ss], [__T | __Stack]); -yeccpars2(258, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(259, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 260, [259 | __Ss], [__T | __Stack]); -yeccpars2(259, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(260, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [260 | __Ss], [__T | __Stack]); -yeccpars2(260, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(261, ')', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 262, [261 | __Ss], [__T | __Stack]); -yeccpars2(261, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(262, __Cat, __Ss, [__7,__6,__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = case __6 of [S,U,T,Fs] -> #c_bitstr{val = __3, size = S, unit = U, type = T, flags = Fs}; true -> return_error(tok_line(__1),"expected 4 arguments in binary segment") end, - __Nss = lists:nthtail(6, __Ss), - yeccpars2(yeccgoto(segment, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(263, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 26, [263 | __Ss], [__T | __Stack]); -yeccpars2(263, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [263 | __Ss], [__T | __Stack]); -yeccpars2(263, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(264, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1|__3], - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(anno_variables, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(265, 'receive', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 65, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, 'catch', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 48, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, 'try', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 70, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, 'primop', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 63, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, 'call', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 44, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, 'apply', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 40, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, 'case', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 46, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, 'letrec', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 60, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, 'let', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 58, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, 'fun', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 23, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, 'do', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 52, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 41, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, '#', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 34, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 37, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 74, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, '<', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 36, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 35, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, 'var', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 30, [265 | __Ss], [__T | __Stack]); -yeccpars2(265, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(266, __Cat, __Ss, [__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_fun{vars = [], body = __5}, - __Nss = lists:nthtail(4, __Ss), - yeccpars2(yeccgoto(fun_expr, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(267, '-|', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 125, [267 | __Ss], [__T | __Stack]); -yeccpars2(267, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(268, '-|', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 269, [268 | __Ss], [__T | __Stack]); -yeccpars2(268, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(269, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 126, [269 | __Ss], [__T | __Stack]); -yeccpars2(269, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(270, ')', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 271, [270 | __Ss], [__T | __Stack]); -yeccpars2(270, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(271, __Cat, __Ss, [__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = core_lib:set_anno(__2,__4), - __Nss = lists:nthtail(4, __Ss), - yeccpars2(yeccgoto(anno_fun, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(272, '-|', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 273, [272 | __Ss], [__T | __Stack]); -yeccpars2(272, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(273, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 126, [273 | __Ss], [__T | __Stack]); -yeccpars2(273, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(274, ')', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 275, [274 | __Ss], [__T | __Stack]); -yeccpars2(274, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(275, __Cat, __Ss, [__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = core_lib:set_anno(__2,__4), - __Nss = lists:nthtail(4, __Ss), - yeccpars2(yeccgoto(anno_function_name, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(276, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 278, [276 | __Ss], [__T | __Stack]); -yeccpars2(276, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 277, [276 | __Ss], [__T | __Stack]); -yeccpars2(276, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(277, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [], - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(module_attribute, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(278, '=', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 284, [278 | __Ss], [__T | __Stack]); -yeccpars2(278, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(279, ',', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 282, [279 | __Ss], [__T | __Stack]); -yeccpars2(279, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1], - yeccpars2(yeccgoto(attribute_list, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(280, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 281, [280 | __Ss], [__T | __Stack]); -yeccpars2(280, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(281, __Cat, __Ss, [__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __3, - __Nss = lists:nthtail(3, __Ss), - yeccpars2(yeccgoto(module_attribute, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(282, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 278, [282 | __Ss], [__T | __Stack]); -yeccpars2(282, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(283, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1|__3], - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(attribute_list, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(284, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 285, [284 | __Ss], [__T | __Stack]); -yeccpars2(284, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 290, [284 | __Ss], [__T | __Stack]); -yeccpars2(284, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [284 | __Ss], [__T | __Stack]); -yeccpars2(284, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [284 | __Ss], [__T | __Stack]); -yeccpars2(284, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [284 | __Ss], [__T | __Stack]); -yeccpars2(284, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [284 | __Ss], [__T | __Stack]); -yeccpars2(284, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [284 | __Ss], [__T | __Stack]); -yeccpars2(284, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(285, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 285, [285 | __Ss], [__T | __Stack]); -yeccpars2(285, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 290, [285 | __Ss], [__T | __Stack]); -yeccpars2(285, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [285 | __Ss], [__T | __Stack]); -yeccpars2(285, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [285 | __Ss], [__T | __Stack]); -yeccpars2(285, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [285 | __Ss], [__T | __Stack]); -yeccpars2(285, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [285 | __Ss], [__T | __Stack]); -yeccpars2(285, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [285 | __Ss], [__T | __Stack]); -yeccpars2(285, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 149, [285 | __Ss], [__T | __Stack]); -yeccpars2(285, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(286, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(literal, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(287, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(literal, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(288, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_def{name = #c_atom{val = tok_val(__1)}, val = __3}, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(attribute, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(289, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(literal, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(290, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 285, [290 | __Ss], [__T | __Stack]); -yeccpars2(290, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 290, [290 | __Ss], [__T | __Stack]); -yeccpars2(290, '}', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 293, [290 | __Ss], [__T | __Stack]); -yeccpars2(290, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [290 | __Ss], [__T | __Stack]); -yeccpars2(290, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [290 | __Ss], [__T | __Stack]); -yeccpars2(290, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [290 | __Ss], [__T | __Stack]); -yeccpars2(290, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [290 | __Ss], [__T | __Stack]); -yeccpars2(290, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [290 | __Ss], [__T | __Stack]); -yeccpars2(290, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(291, ',', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 295, [291 | __Ss], [__T | __Stack]); -yeccpars2(291, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1], - yeccpars2(yeccgoto(literals, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(292, '}', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 294, [292 | __Ss], [__T | __Stack]); -yeccpars2(292, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(293, __Cat, __Ss, [__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_tuple{es = []}, - __Nss = lists:nthtail(1, __Ss), - yeccpars2(yeccgoto(tuple_literal, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(294, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_tuple{es = __2}, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(tuple_literal, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(295, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 285, [295 | __Ss], [__T | __Stack]); -yeccpars2(295, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 290, [295 | __Ss], [__T | __Stack]); -yeccpars2(295, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [295 | __Ss], [__T | __Stack]); -yeccpars2(295, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [295 | __Ss], [__T | __Stack]); -yeccpars2(295, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [295 | __Ss], [__T | __Stack]); -yeccpars2(295, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [295 | __Ss], [__T | __Stack]); -yeccpars2(295, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [295 | __Ss], [__T | __Stack]); -yeccpars2(295, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(296, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1|__3], - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(literals, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(297, ',', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 298, [297 | __Ss], [__T | __Stack]); -yeccpars2(297, '|', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 301, [297 | __Ss], [__T | __Stack]); -yeccpars2(297, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 299, [297 | __Ss], [__T | __Stack]); -yeccpars2(297, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(298, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 285, [298 | __Ss], [__T | __Stack]); -yeccpars2(298, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 290, [298 | __Ss], [__T | __Stack]); -yeccpars2(298, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [298 | __Ss], [__T | __Stack]); -yeccpars2(298, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [298 | __Ss], [__T | __Stack]); -yeccpars2(298, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [298 | __Ss], [__T | __Stack]); -yeccpars2(298, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [298 | __Ss], [__T | __Stack]); -yeccpars2(298, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [298 | __Ss], [__T | __Stack]); -yeccpars2(298, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(299, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_nil{}, - yeccpars2(yeccgoto(tail_literal, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(300, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_cons{hd = __2, tl = __3}, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(cons_literal, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(301, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 285, [301 | __Ss], [__T | __Stack]); -yeccpars2(301, '{', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 290, [301 | __Ss], [__T | __Stack]); -yeccpars2(301, 'string', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 69, [301 | __Ss], [__T | __Stack]); -yeccpars2(301, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 104, [301 | __Ss], [__T | __Stack]); -yeccpars2(301, 'float', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 54, [301 | __Ss], [__T | __Stack]); -yeccpars2(301, 'integer', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 57, [301 | __Ss], [__T | __Stack]); -yeccpars2(301, 'char', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 50, [301 | __Ss], [__T | __Stack]); -yeccpars2(301, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(302, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 303, [302 | __Ss], [__T | __Stack]); -yeccpars2(302, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(303, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __2, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(tail_literal, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(304, ',', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 298, [304 | __Ss], [__T | __Stack]); -yeccpars2(304, '|', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 301, [304 | __Ss], [__T | __Stack]); -yeccpars2(304, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 299, [304 | __Ss], [__T | __Stack]); -yeccpars2(304, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(305, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_cons{hd = __2, tl = __3}, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(tail_literal, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(306, __Cat, __Ss, [__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [], - __Nss = lists:nthtail(1, __Ss), - yeccpars2(yeccgoto(module_export, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(307, ',', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 311, [307 | __Ss], [__T | __Stack]); -yeccpars2(307, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1], - yeccpars2(yeccgoto(exported_names, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(308, ']', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 310, [308 | __Ss], [__T | __Stack]); -yeccpars2(308, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(309, __Cat, __Ss, [__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __1, - yeccpars2(yeccgoto(exported_name, hd(__Ss)), __Cat, __Ss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(310, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = __2, - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(module_export, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(311, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 11, [311 | __Ss], [__T | __Stack]); -yeccpars2(311, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(312, __Cat, __Ss, [__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = [__1|__3], - __Nss = lists:nthtail(2, __Ss), - yeccpars2(yeccgoto(exported_names, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(313, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 314, [313 | __Ss], [__T | __Stack]); -yeccpars2(313, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(314, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 5, [314 | __Ss], [__T | __Stack]); -yeccpars2(314, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(315, 'attributes', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 7, [315 | __Ss], [__T | __Stack]); -yeccpars2(315, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(316, '(', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 9, [316 | __Ss], [__T | __Stack]); -yeccpars2(316, 'atom', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 11, [316 | __Ss], [__T | __Stack]); -yeccpars2(316, __Cat, __Ss, __Stack, __T, __Ts, __Tzr) -> - __Val = [], - yeccpars2(13, __Cat, [316 | __Ss], [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(317, 'end', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 318, [317 | __Ss], [__T | __Stack]); -yeccpars2(317, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(318, '-|', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 319, [318 | __Ss], [__T | __Stack]); -yeccpars2(318, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(319, '[', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 126, [319 | __Ss], [__T | __Stack]); -yeccpars2(319, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(320, ')', __Ss, __Stack, __T, __Ts, __Tzr) -> - yeccpars1(__Ts, __Tzr, 321, [320 | __Ss], [__T | __Stack]); -yeccpars2(320, _, _, _, __T, _, _) -> - yeccerror(__T); -yeccpars2(321, __Cat, __Ss, [__10,__9,__8,__7,__6,__5,__4,__3,__2,__1|__Stack], __T, __Ts, __Tzr) -> - __Val = #c_module{anno = __9, name = tok_val(__3), exports = __4, attrs = __5, defs = __6}, - __Nss = lists:nthtail(9, __Ss), - yeccpars2(yeccgoto(module_definition, hd(__Nss)), __Cat, __Nss, [__Val | __Stack], __T, __Ts, __Tzr); -yeccpars2(__Other, _, _, _, _, _, _) -> - exit({parser, __Other, missing_state_in_action_table}). - -yeccgoto(anno_clause, 65) -> - 100; -yeccgoto(anno_clause, 100) -> - 100; -yeccgoto(anno_clause, 222) -> - 100; -yeccgoto(anno_clauses, 65) -> - 101; -yeccgoto(anno_clauses, 100) -> - 169; -yeccgoto(anno_clauses, 222) -> - 223; -yeccgoto(anno_expression, 33) -> - 38; -yeccgoto(anno_expression, 36) -> - 75; -yeccgoto(anno_expression, 37) -> - 231; -yeccgoto(anno_expression, 40) -> - 229; -yeccgoto(anno_expression, 44) -> - 225; -yeccgoto(anno_expression, 46) -> - 221; -yeccgoto(anno_expression, 48) -> - 220; -yeccgoto(anno_expression, 52) -> - 218; -yeccgoto(anno_expression, 70) -> - 81; -yeccgoto(anno_expression, 74) -> - 75; -yeccgoto(anno_expression, 79) -> - 75; -yeccgoto(anno_expression, 86) -> - 87; -yeccgoto(anno_expression, 90) -> - 91; -yeccgoto(anno_expression, 99) -> - 170; -yeccgoto(anno_expression, 164) -> - 165; -yeccgoto(anno_expression, 166) -> - 167; -yeccgoto(anno_expression, 171) -> - 172; -yeccgoto(anno_expression, 203) -> - 75; -yeccgoto(anno_expression, 211) -> - 212; -yeccgoto(anno_expression, 214) -> - 215; -yeccgoto(anno_expression, 216) -> - 217; -yeccgoto(anno_expression, 218) -> - 219; -yeccgoto(anno_expression, 226) -> - 227; -yeccgoto(anno_expression, 232) -> - 238; -yeccgoto(anno_expression, 235) -> - 236; -yeccgoto(anno_expression, 257) -> - 258; -yeccgoto(anno_expression, 260) -> - 75; -yeccgoto(anno_expression, 265) -> - 266; -yeccgoto(anno_expressions, 36) -> - 241; -yeccgoto(anno_expressions, 74) -> - 76; -yeccgoto(anno_expressions, 79) -> - 80; -yeccgoto(anno_expressions, 203) -> - 206; -yeccgoto(anno_expressions, 260) -> - 261; -yeccgoto(anno_fun, 20) -> - 22; -yeccgoto(anno_function_name, 8) -> - 10; -yeccgoto(anno_function_name, 12) -> - 10; -yeccgoto(anno_function_name, 60) -> - 10; -yeccgoto(anno_function_name, 316) -> - 10; -yeccgoto(anno_pattern, 65) -> - 102; -yeccgoto(anno_pattern, 96) -> - 102; -yeccgoto(anno_pattern, 97) -> - 116; -yeccgoto(anno_pattern, 98) -> - 173; -yeccgoto(anno_pattern, 100) -> - 102; -yeccgoto(anno_pattern, 114) -> - 116; -yeccgoto(anno_pattern, 120) -> - 116; -yeccgoto(anno_pattern, 162) -> - 163; -yeccgoto(anno_pattern, 174) -> - 180; -yeccgoto(anno_pattern, 177) -> - 178; -yeccgoto(anno_pattern, 200) -> - 201; -yeccgoto(anno_pattern, 222) -> - 102; -yeccgoto(anno_patterns, 97) -> - 183; -yeccgoto(anno_patterns, 114) -> - 117; -yeccgoto(anno_patterns, 120) -> - 121; -yeccgoto(anno_variable, 25) -> - 28; -yeccgoto(anno_variable, 58) -> - 84; -yeccgoto(anno_variable, 65) -> - 103; -yeccgoto(anno_variable, 82) -> - 84; -yeccgoto(anno_variable, 83) -> - 28; -yeccgoto(anno_variable, 88) -> - 84; -yeccgoto(anno_variable, 96) -> - 103; -yeccgoto(anno_variable, 97) -> - 103; -yeccgoto(anno_variable, 98) -> - 103; -yeccgoto(anno_variable, 100) -> - 103; -yeccgoto(anno_variable, 114) -> - 103; -yeccgoto(anno_variable, 115) -> - 122; -yeccgoto(anno_variable, 120) -> - 103; -yeccgoto(anno_variable, 162) -> - 103; -yeccgoto(anno_variable, 174) -> - 103; -yeccgoto(anno_variable, 177) -> - 103; -yeccgoto(anno_variable, 200) -> - 103; -yeccgoto(anno_variable, 222) -> - 103; -yeccgoto(anno_variable, 263) -> - 28; -yeccgoto(anno_variables, 25) -> - 29; -yeccgoto(anno_variables, 83) -> - 93; -yeccgoto(anno_variables, 263) -> - 264; -yeccgoto(annotation, 125) -> - 127; -yeccgoto(annotation, 159) -> - 160; -yeccgoto(annotation, 187) -> - 188; -yeccgoto(annotation, 244) -> - 245; -yeccgoto(annotation, 269) -> - 270; -yeccgoto(annotation, 273) -> - 274; -yeccgoto(annotation, 319) -> - 320; -yeccgoto(application_expr, 33) -> - 39; -yeccgoto(application_expr, 35) -> - 39; -yeccgoto(application_expr, 36) -> - 39; -yeccgoto(application_expr, 37) -> - 39; -yeccgoto(application_expr, 40) -> - 39; -yeccgoto(application_expr, 44) -> - 39; -yeccgoto(application_expr, 46) -> - 39; -yeccgoto(application_expr, 48) -> - 39; -yeccgoto(application_expr, 52) -> - 39; -yeccgoto(application_expr, 70) -> - 39; -yeccgoto(application_expr, 74) -> - 39; -yeccgoto(application_expr, 79) -> - 39; -yeccgoto(application_expr, 86) -> - 39; -yeccgoto(application_expr, 90) -> - 39; -yeccgoto(application_expr, 99) -> - 39; -yeccgoto(application_expr, 164) -> - 39; -yeccgoto(application_expr, 166) -> - 39; -yeccgoto(application_expr, 171) -> - 39; -yeccgoto(application_expr, 203) -> - 39; -yeccgoto(application_expr, 211) -> - 39; -yeccgoto(application_expr, 214) -> - 39; -yeccgoto(application_expr, 216) -> - 39; -yeccgoto(application_expr, 218) -> - 39; -yeccgoto(application_expr, 226) -> - 39; -yeccgoto(application_expr, 232) -> - 39; -yeccgoto(application_expr, 235) -> - 39; -yeccgoto(application_expr, 257) -> - 39; -yeccgoto(application_expr, 260) -> - 39; -yeccgoto(application_expr, 265) -> - 39; -yeccgoto(arg_list, 202) -> - 204; -yeccgoto(arg_list, 208) -> - 209; -yeccgoto(arg_list, 227) -> - 228; -yeccgoto(arg_list, 229) -> - 230; -yeccgoto(atomic_constant, 126) -> - 132; -yeccgoto(atomic_constant, 129) -> - 132; -yeccgoto(atomic_constant, 142) -> - 132; -yeccgoto(atomic_constant, 147) -> - 132; -yeccgoto(atomic_constant, 151) -> - 132; -yeccgoto(atomic_constant, 154) -> - 132; -yeccgoto(atomic_literal, 33) -> - 42; -yeccgoto(atomic_literal, 35) -> - 42; -yeccgoto(atomic_literal, 36) -> - 42; -yeccgoto(atomic_literal, 37) -> - 42; -yeccgoto(atomic_literal, 40) -> - 42; -yeccgoto(atomic_literal, 44) -> - 42; -yeccgoto(atomic_literal, 46) -> - 42; -yeccgoto(atomic_literal, 48) -> - 42; -yeccgoto(atomic_literal, 52) -> - 42; -yeccgoto(atomic_literal, 65) -> - 105; -yeccgoto(atomic_literal, 70) -> - 42; -yeccgoto(atomic_literal, 74) -> - 42; -yeccgoto(atomic_literal, 79) -> - 42; -yeccgoto(atomic_literal, 86) -> - 42; -yeccgoto(atomic_literal, 90) -> - 42; -yeccgoto(atomic_literal, 96) -> - 105; -yeccgoto(atomic_literal, 97) -> - 105; -yeccgoto(atomic_literal, 98) -> - 105; -yeccgoto(atomic_literal, 99) -> - 42; -yeccgoto(atomic_literal, 100) -> - 105; -yeccgoto(atomic_literal, 114) -> - 105; -yeccgoto(atomic_literal, 115) -> - 105; -yeccgoto(atomic_literal, 120) -> - 105; -yeccgoto(atomic_literal, 162) -> - 105; -yeccgoto(atomic_literal, 164) -> - 42; -yeccgoto(atomic_literal, 166) -> - 42; -yeccgoto(atomic_literal, 171) -> - 42; -yeccgoto(atomic_literal, 174) -> - 105; -yeccgoto(atomic_literal, 177) -> - 105; -yeccgoto(atomic_literal, 200) -> - 105; -yeccgoto(atomic_literal, 203) -> - 42; -yeccgoto(atomic_literal, 211) -> - 42; -yeccgoto(atomic_literal, 214) -> - 42; -yeccgoto(atomic_literal, 216) -> - 42; -yeccgoto(atomic_literal, 218) -> - 42; -yeccgoto(atomic_literal, 222) -> - 105; -yeccgoto(atomic_literal, 226) -> - 42; -yeccgoto(atomic_literal, 232) -> - 42; -yeccgoto(atomic_literal, 235) -> - 42; -yeccgoto(atomic_literal, 257) -> - 42; -yeccgoto(atomic_literal, 260) -> - 42; -yeccgoto(atomic_literal, 265) -> - 42; -yeccgoto(atomic_literal, 284) -> - 286; -yeccgoto(atomic_literal, 285) -> - 286; -yeccgoto(atomic_literal, 290) -> - 286; -yeccgoto(atomic_literal, 295) -> - 286; -yeccgoto(atomic_literal, 298) -> - 286; -yeccgoto(atomic_literal, 301) -> - 286; -yeccgoto(atomic_pattern, 65) -> - 106; -yeccgoto(atomic_pattern, 96) -> - 106; -yeccgoto(atomic_pattern, 97) -> - 106; -yeccgoto(atomic_pattern, 98) -> - 106; -yeccgoto(atomic_pattern, 100) -> - 106; -yeccgoto(atomic_pattern, 114) -> - 106; -yeccgoto(atomic_pattern, 115) -> - 106; -yeccgoto(atomic_pattern, 120) -> - 106; -yeccgoto(atomic_pattern, 162) -> - 106; -yeccgoto(atomic_pattern, 174) -> - 106; -yeccgoto(atomic_pattern, 177) -> - 106; -yeccgoto(atomic_pattern, 200) -> - 106; -yeccgoto(atomic_pattern, 222) -> - 106; -yeccgoto(attribute, 276) -> - 279; -yeccgoto(attribute, 282) -> - 279; -yeccgoto(attribute_list, 276) -> - 280; -yeccgoto(attribute_list, 282) -> - 283; -yeccgoto(binary, 33) -> - 43; -yeccgoto(binary, 35) -> - 43; -yeccgoto(binary, 36) -> - 43; -yeccgoto(binary, 37) -> - 43; -yeccgoto(binary, 40) -> - 43; -yeccgoto(binary, 44) -> - 43; -yeccgoto(binary, 46) -> - 43; -yeccgoto(binary, 48) -> - 43; -yeccgoto(binary, 52) -> - 43; -yeccgoto(binary, 70) -> - 43; -yeccgoto(binary, 74) -> - 43; -yeccgoto(binary, 79) -> - 43; -yeccgoto(binary, 86) -> - 43; -yeccgoto(binary, 90) -> - 43; -yeccgoto(binary, 99) -> - 43; -yeccgoto(binary, 164) -> - 43; -yeccgoto(binary, 166) -> - 43; -yeccgoto(binary, 171) -> - 43; -yeccgoto(binary, 203) -> - 43; -yeccgoto(binary, 211) -> - 43; -yeccgoto(binary, 214) -> - 43; -yeccgoto(binary, 216) -> - 43; -yeccgoto(binary, 218) -> - 43; -yeccgoto(binary, 226) -> - 43; -yeccgoto(binary, 232) -> - 43; -yeccgoto(binary, 235) -> - 43; -yeccgoto(binary, 257) -> - 43; -yeccgoto(binary, 260) -> - 43; -yeccgoto(binary, 265) -> - 43; -yeccgoto(binary_pattern, 65) -> - 107; -yeccgoto(binary_pattern, 96) -> - 107; -yeccgoto(binary_pattern, 97) -> - 107; -yeccgoto(binary_pattern, 98) -> - 107; -yeccgoto(binary_pattern, 100) -> - 107; -yeccgoto(binary_pattern, 114) -> - 107; -yeccgoto(binary_pattern, 115) -> - 107; -yeccgoto(binary_pattern, 120) -> - 107; -yeccgoto(binary_pattern, 162) -> - 107; -yeccgoto(binary_pattern, 174) -> - 107; -yeccgoto(binary_pattern, 177) -> - 107; -yeccgoto(binary_pattern, 200) -> - 107; -yeccgoto(binary_pattern, 222) -> - 107; -yeccgoto(call_expr, 33) -> - 45; -yeccgoto(call_expr, 35) -> - 45; -yeccgoto(call_expr, 36) -> - 45; -yeccgoto(call_expr, 37) -> - 45; -yeccgoto(call_expr, 40) -> - 45; -yeccgoto(call_expr, 44) -> - 45; -yeccgoto(call_expr, 46) -> - 45; -yeccgoto(call_expr, 48) -> - 45; -yeccgoto(call_expr, 52) -> - 45; -yeccgoto(call_expr, 70) -> - 45; -yeccgoto(call_expr, 74) -> - 45; -yeccgoto(call_expr, 79) -> - 45; -yeccgoto(call_expr, 86) -> - 45; -yeccgoto(call_expr, 90) -> - 45; -yeccgoto(call_expr, 99) -> - 45; -yeccgoto(call_expr, 164) -> - 45; -yeccgoto(call_expr, 166) -> - 45; -yeccgoto(call_expr, 171) -> - 45; -yeccgoto(call_expr, 203) -> - 45; -yeccgoto(call_expr, 211) -> - 45; -yeccgoto(call_expr, 214) -> - 45; -yeccgoto(call_expr, 216) -> - 45; -yeccgoto(call_expr, 218) -> - 45; -yeccgoto(call_expr, 226) -> - 45; -yeccgoto(call_expr, 232) -> - 45; -yeccgoto(call_expr, 235) -> - 45; -yeccgoto(call_expr, 257) -> - 45; -yeccgoto(call_expr, 260) -> - 45; -yeccgoto(call_expr, 265) -> - 45; -yeccgoto(case_expr, 33) -> - 47; -yeccgoto(case_expr, 35) -> - 47; -yeccgoto(case_expr, 36) -> - 47; -yeccgoto(case_expr, 37) -> - 47; -yeccgoto(case_expr, 40) -> - 47; -yeccgoto(case_expr, 44) -> - 47; -yeccgoto(case_expr, 46) -> - 47; -yeccgoto(case_expr, 48) -> - 47; -yeccgoto(case_expr, 52) -> - 47; -yeccgoto(case_expr, 70) -> - 47; -yeccgoto(case_expr, 74) -> - 47; -yeccgoto(case_expr, 79) -> - 47; -yeccgoto(case_expr, 86) -> - 47; -yeccgoto(case_expr, 90) -> - 47; -yeccgoto(case_expr, 99) -> - 47; -yeccgoto(case_expr, 164) -> - 47; -yeccgoto(case_expr, 166) -> - 47; -yeccgoto(case_expr, 171) -> - 47; -yeccgoto(case_expr, 203) -> - 47; -yeccgoto(case_expr, 211) -> - 47; -yeccgoto(case_expr, 214) -> - 47; -yeccgoto(case_expr, 216) -> - 47; -yeccgoto(case_expr, 218) -> - 47; -yeccgoto(case_expr, 226) -> - 47; -yeccgoto(case_expr, 232) -> - 47; -yeccgoto(case_expr, 235) -> - 47; -yeccgoto(case_expr, 257) -> - 47; -yeccgoto(case_expr, 260) -> - 47; -yeccgoto(case_expr, 265) -> - 47; -yeccgoto(catch_expr, 33) -> - 49; -yeccgoto(catch_expr, 35) -> - 49; -yeccgoto(catch_expr, 36) -> - 49; -yeccgoto(catch_expr, 37) -> - 49; -yeccgoto(catch_expr, 40) -> - 49; -yeccgoto(catch_expr, 44) -> - 49; -yeccgoto(catch_expr, 46) -> - 49; -yeccgoto(catch_expr, 48) -> - 49; -yeccgoto(catch_expr, 52) -> - 49; -yeccgoto(catch_expr, 70) -> - 49; -yeccgoto(catch_expr, 74) -> - 49; -yeccgoto(catch_expr, 79) -> - 49; -yeccgoto(catch_expr, 86) -> - 49; -yeccgoto(catch_expr, 90) -> - 49; -yeccgoto(catch_expr, 99) -> - 49; -yeccgoto(catch_expr, 164) -> - 49; -yeccgoto(catch_expr, 166) -> - 49; -yeccgoto(catch_expr, 171) -> - 49; -yeccgoto(catch_expr, 203) -> - 49; -yeccgoto(catch_expr, 211) -> - 49; -yeccgoto(catch_expr, 214) -> - 49; -yeccgoto(catch_expr, 216) -> - 49; -yeccgoto(catch_expr, 218) -> - 49; -yeccgoto(catch_expr, 226) -> - 49; -yeccgoto(catch_expr, 232) -> - 49; -yeccgoto(catch_expr, 235) -> - 49; -yeccgoto(catch_expr, 257) -> - 49; -yeccgoto(catch_expr, 260) -> - 49; -yeccgoto(catch_expr, 265) -> - 49; -yeccgoto(clause, 65) -> - 108; -yeccgoto(clause, 96) -> - 185; -yeccgoto(clause, 100) -> - 108; -yeccgoto(clause, 222) -> - 108; -yeccgoto(clause_pattern, 65) -> - 109; -yeccgoto(clause_pattern, 96) -> - 109; -yeccgoto(clause_pattern, 100) -> - 109; -yeccgoto(clause_pattern, 222) -> - 109; -yeccgoto(cons, 33) -> - 51; -yeccgoto(cons, 35) -> - 51; -yeccgoto(cons, 36) -> - 51; -yeccgoto(cons, 37) -> - 51; -yeccgoto(cons, 40) -> - 51; -yeccgoto(cons, 44) -> - 51; -yeccgoto(cons, 46) -> - 51; -yeccgoto(cons, 48) -> - 51; -yeccgoto(cons, 52) -> - 51; -yeccgoto(cons, 70) -> - 51; -yeccgoto(cons, 74) -> - 51; -yeccgoto(cons, 79) -> - 51; -yeccgoto(cons, 86) -> - 51; -yeccgoto(cons, 90) -> - 51; -yeccgoto(cons, 99) -> - 51; -yeccgoto(cons, 164) -> - 51; -yeccgoto(cons, 166) -> - 51; -yeccgoto(cons, 171) -> - 51; -yeccgoto(cons, 203) -> - 51; -yeccgoto(cons, 211) -> - 51; -yeccgoto(cons, 214) -> - 51; -yeccgoto(cons, 216) -> - 51; -yeccgoto(cons, 218) -> - 51; -yeccgoto(cons, 226) -> - 51; -yeccgoto(cons, 232) -> - 51; -yeccgoto(cons, 235) -> - 51; -yeccgoto(cons, 257) -> - 51; -yeccgoto(cons, 260) -> - 51; -yeccgoto(cons, 265) -> - 51; -yeccgoto(cons_constant, 126) -> - 134; -yeccgoto(cons_constant, 129) -> - 134; -yeccgoto(cons_constant, 142) -> - 134; -yeccgoto(cons_constant, 147) -> - 134; -yeccgoto(cons_constant, 151) -> - 134; -yeccgoto(cons_constant, 154) -> - 134; -yeccgoto(cons_literal, 284) -> - 287; -yeccgoto(cons_literal, 285) -> - 287; -yeccgoto(cons_literal, 290) -> - 287; -yeccgoto(cons_literal, 295) -> - 287; -yeccgoto(cons_literal, 298) -> - 287; -yeccgoto(cons_literal, 301) -> - 287; -yeccgoto(cons_pattern, 65) -> - 110; -yeccgoto(cons_pattern, 96) -> - 110; -yeccgoto(cons_pattern, 97) -> - 110; -yeccgoto(cons_pattern, 98) -> - 110; -yeccgoto(cons_pattern, 100) -> - 110; -yeccgoto(cons_pattern, 114) -> - 110; -yeccgoto(cons_pattern, 115) -> - 110; -yeccgoto(cons_pattern, 120) -> - 110; -yeccgoto(cons_pattern, 162) -> - 110; -yeccgoto(cons_pattern, 174) -> - 110; -yeccgoto(cons_pattern, 177) -> - 110; -yeccgoto(cons_pattern, 200) -> - 110; -yeccgoto(cons_pattern, 222) -> - 110; -yeccgoto(constant, 126) -> - 135; -yeccgoto(constant, 129) -> - 150; -yeccgoto(constant, 142) -> - 135; -yeccgoto(constant, 147) -> - 135; -yeccgoto(constant, 151) -> - 157; -yeccgoto(constant, 154) -> - 155; -yeccgoto(constants, 126) -> - 136; -yeccgoto(constants, 142) -> - 143; -yeccgoto(constants, 147) -> - 148; -yeccgoto(exported_name, 5) -> - 307; -yeccgoto(exported_name, 311) -> - 307; -yeccgoto(exported_names, 5) -> - 308; -yeccgoto(exported_names, 311) -> - 312; -yeccgoto(expression, 33) -> - 53; -yeccgoto(expression, 35) -> - 243; -yeccgoto(expression, 36) -> - 53; -yeccgoto(expression, 37) -> - 53; -yeccgoto(expression, 40) -> - 53; -yeccgoto(expression, 44) -> - 53; -yeccgoto(expression, 46) -> - 53; -yeccgoto(expression, 48) -> - 53; -yeccgoto(expression, 52) -> - 53; -yeccgoto(expression, 70) -> - 53; -yeccgoto(expression, 74) -> - 53; -yeccgoto(expression, 79) -> - 53; -yeccgoto(expression, 86) -> - 53; -yeccgoto(expression, 90) -> - 53; -yeccgoto(expression, 99) -> - 53; -yeccgoto(expression, 164) -> - 53; -yeccgoto(expression, 166) -> - 53; -yeccgoto(expression, 171) -> - 53; -yeccgoto(expression, 203) -> - 53; -yeccgoto(expression, 211) -> - 53; -yeccgoto(expression, 214) -> - 53; -yeccgoto(expression, 216) -> - 53; -yeccgoto(expression, 218) -> - 53; -yeccgoto(expression, 226) -> - 53; -yeccgoto(expression, 232) -> - 53; -yeccgoto(expression, 235) -> - 53; -yeccgoto(expression, 257) -> - 53; -yeccgoto(expression, 260) -> - 53; -yeccgoto(expression, 265) -> - 53; -yeccgoto(fun_expr, 20) -> - 24; -yeccgoto(fun_expr, 21) -> - 268; -yeccgoto(fun_expr, 33) -> - 55; -yeccgoto(fun_expr, 35) -> - 55; -yeccgoto(fun_expr, 36) -> - 55; -yeccgoto(fun_expr, 37) -> - 55; -yeccgoto(fun_expr, 40) -> - 55; -yeccgoto(fun_expr, 44) -> - 55; -yeccgoto(fun_expr, 46) -> - 55; -yeccgoto(fun_expr, 48) -> - 55; -yeccgoto(fun_expr, 52) -> - 55; -yeccgoto(fun_expr, 70) -> - 55; -yeccgoto(fun_expr, 74) -> - 55; -yeccgoto(fun_expr, 79) -> - 55; -yeccgoto(fun_expr, 86) -> - 55; -yeccgoto(fun_expr, 90) -> - 55; -yeccgoto(fun_expr, 99) -> - 55; -yeccgoto(fun_expr, 164) -> - 55; -yeccgoto(fun_expr, 166) -> - 55; -yeccgoto(fun_expr, 171) -> - 55; -yeccgoto(fun_expr, 203) -> - 55; -yeccgoto(fun_expr, 211) -> - 55; -yeccgoto(fun_expr, 214) -> - 55; -yeccgoto(fun_expr, 216) -> - 55; -yeccgoto(fun_expr, 218) -> - 55; -yeccgoto(fun_expr, 226) -> - 55; -yeccgoto(fun_expr, 232) -> - 55; -yeccgoto(fun_expr, 235) -> - 55; -yeccgoto(fun_expr, 257) -> - 55; -yeccgoto(fun_expr, 260) -> - 55; -yeccgoto(fun_expr, 265) -> - 55; -yeccgoto(function_definition, 8) -> - 12; -yeccgoto(function_definition, 12) -> - 12; -yeccgoto(function_definition, 60) -> - 12; -yeccgoto(function_definition, 316) -> - 12; -yeccgoto(function_definitions, 8) -> - 13; -yeccgoto(function_definitions, 12) -> - 17; -yeccgoto(function_definitions, 60) -> - 210; -yeccgoto(function_definitions, 316) -> - 13; -yeccgoto(function_name, 5) -> - 309; -yeccgoto(function_name, 8) -> - 14; -yeccgoto(function_name, 9) -> - 272; -yeccgoto(function_name, 12) -> - 14; -yeccgoto(function_name, 33) -> - 56; -yeccgoto(function_name, 35) -> - 56; -yeccgoto(function_name, 36) -> - 56; -yeccgoto(function_name, 37) -> - 56; -yeccgoto(function_name, 40) -> - 56; -yeccgoto(function_name, 44) -> - 56; -yeccgoto(function_name, 46) -> - 56; -yeccgoto(function_name, 48) -> - 56; -yeccgoto(function_name, 52) -> - 56; -yeccgoto(function_name, 60) -> - 14; -yeccgoto(function_name, 70) -> - 56; -yeccgoto(function_name, 74) -> - 56; -yeccgoto(function_name, 79) -> - 56; -yeccgoto(function_name, 86) -> - 56; -yeccgoto(function_name, 90) -> - 56; -yeccgoto(function_name, 99) -> - 56; -yeccgoto(function_name, 164) -> - 56; -yeccgoto(function_name, 166) -> - 56; -yeccgoto(function_name, 171) -> - 56; -yeccgoto(function_name, 203) -> - 56; -yeccgoto(function_name, 211) -> - 56; -yeccgoto(function_name, 214) -> - 56; -yeccgoto(function_name, 216) -> - 56; -yeccgoto(function_name, 218) -> - 56; -yeccgoto(function_name, 226) -> - 56; -yeccgoto(function_name, 232) -> - 56; -yeccgoto(function_name, 235) -> - 56; -yeccgoto(function_name, 257) -> - 56; -yeccgoto(function_name, 260) -> - 56; -yeccgoto(function_name, 265) -> - 56; -yeccgoto(function_name, 311) -> - 309; -yeccgoto(function_name, 316) -> - 14; -yeccgoto(let_expr, 33) -> - 59; -yeccgoto(let_expr, 35) -> - 59; -yeccgoto(let_expr, 36) -> - 59; -yeccgoto(let_expr, 37) -> - 59; -yeccgoto(let_expr, 40) -> - 59; -yeccgoto(let_expr, 44) -> - 59; -yeccgoto(let_expr, 46) -> - 59; -yeccgoto(let_expr, 48) -> - 59; -yeccgoto(let_expr, 52) -> - 59; -yeccgoto(let_expr, 70) -> - 59; -yeccgoto(let_expr, 74) -> - 59; -yeccgoto(let_expr, 79) -> - 59; -yeccgoto(let_expr, 86) -> - 59; -yeccgoto(let_expr, 90) -> - 59; -yeccgoto(let_expr, 99) -> - 59; -yeccgoto(let_expr, 164) -> - 59; -yeccgoto(let_expr, 166) -> - 59; -yeccgoto(let_expr, 171) -> - 59; -yeccgoto(let_expr, 203) -> - 59; -yeccgoto(let_expr, 211) -> - 59; -yeccgoto(let_expr, 214) -> - 59; -yeccgoto(let_expr, 216) -> - 59; -yeccgoto(let_expr, 218) -> - 59; -yeccgoto(let_expr, 226) -> - 59; -yeccgoto(let_expr, 232) -> - 59; -yeccgoto(let_expr, 235) -> - 59; -yeccgoto(let_expr, 257) -> - 59; -yeccgoto(let_expr, 260) -> - 59; -yeccgoto(let_expr, 265) -> - 59; -yeccgoto(let_vars, 58) -> - 213; -yeccgoto(let_vars, 82) -> - 85; -yeccgoto(let_vars, 88) -> - 89; -yeccgoto(letrec_expr, 33) -> - 61; -yeccgoto(letrec_expr, 35) -> - 61; -yeccgoto(letrec_expr, 36) -> - 61; -yeccgoto(letrec_expr, 37) -> - 61; -yeccgoto(letrec_expr, 40) -> - 61; -yeccgoto(letrec_expr, 44) -> - 61; -yeccgoto(letrec_expr, 46) -> - 61; -yeccgoto(letrec_expr, 48) -> - 61; -yeccgoto(letrec_expr, 52) -> - 61; -yeccgoto(letrec_expr, 70) -> - 61; -yeccgoto(letrec_expr, 74) -> - 61; -yeccgoto(letrec_expr, 79) -> - 61; -yeccgoto(letrec_expr, 86) -> - 61; -yeccgoto(letrec_expr, 90) -> - 61; -yeccgoto(letrec_expr, 99) -> - 61; -yeccgoto(letrec_expr, 164) -> - 61; -yeccgoto(letrec_expr, 166) -> - 61; -yeccgoto(letrec_expr, 171) -> - 61; -yeccgoto(letrec_expr, 203) -> - 61; -yeccgoto(letrec_expr, 211) -> - 61; -yeccgoto(letrec_expr, 214) -> - 61; -yeccgoto(letrec_expr, 216) -> - 61; -yeccgoto(letrec_expr, 218) -> - 61; -yeccgoto(letrec_expr, 226) -> - 61; -yeccgoto(letrec_expr, 232) -> - 61; -yeccgoto(letrec_expr, 235) -> - 61; -yeccgoto(letrec_expr, 257) -> - 61; -yeccgoto(letrec_expr, 260) -> - 61; -yeccgoto(letrec_expr, 265) -> - 61; -yeccgoto(literal, 284) -> - 288; -yeccgoto(literal, 285) -> - 297; -yeccgoto(literal, 290) -> - 291; -yeccgoto(literal, 295) -> - 291; -yeccgoto(literal, 298) -> - 304; -yeccgoto(literal, 301) -> - 302; -yeccgoto(literals, 290) -> - 292; -yeccgoto(literals, 295) -> - 296; -yeccgoto(module_attribute, 6) -> - 8; -yeccgoto(module_attribute, 315) -> - 316; -yeccgoto(module_definition, 0) -> - 3; -yeccgoto(module_defs, 8) -> - 15; -yeccgoto(module_defs, 316) -> - 317; -yeccgoto(module_export, 4) -> - 6; -yeccgoto(module_export, 314) -> - 315; -yeccgoto(nil, 33) -> - 62; -yeccgoto(nil, 35) -> - 62; -yeccgoto(nil, 36) -> - 62; -yeccgoto(nil, 37) -> - 62; -yeccgoto(nil, 40) -> - 62; -yeccgoto(nil, 44) -> - 62; -yeccgoto(nil, 46) -> - 62; -yeccgoto(nil, 48) -> - 62; -yeccgoto(nil, 52) -> - 62; -yeccgoto(nil, 65) -> - 62; -yeccgoto(nil, 70) -> - 62; -yeccgoto(nil, 74) -> - 62; -yeccgoto(nil, 79) -> - 62; -yeccgoto(nil, 86) -> - 62; -yeccgoto(nil, 90) -> - 62; -yeccgoto(nil, 96) -> - 62; -yeccgoto(nil, 97) -> - 62; -yeccgoto(nil, 98) -> - 62; -yeccgoto(nil, 99) -> - 62; -yeccgoto(nil, 100) -> - 62; -yeccgoto(nil, 114) -> - 62; -yeccgoto(nil, 115) -> - 62; -yeccgoto(nil, 120) -> - 62; -yeccgoto(nil, 126) -> - 139; -yeccgoto(nil, 129) -> - 139; -yeccgoto(nil, 142) -> - 139; -yeccgoto(nil, 147) -> - 139; -yeccgoto(nil, 151) -> - 139; -yeccgoto(nil, 154) -> - 139; -yeccgoto(nil, 162) -> - 62; -yeccgoto(nil, 164) -> - 62; -yeccgoto(nil, 166) -> - 62; -yeccgoto(nil, 171) -> - 62; -yeccgoto(nil, 174) -> - 62; -yeccgoto(nil, 177) -> - 62; -yeccgoto(nil, 200) -> - 62; -yeccgoto(nil, 203) -> - 62; -yeccgoto(nil, 211) -> - 62; -yeccgoto(nil, 214) -> - 62; -yeccgoto(nil, 216) -> - 62; -yeccgoto(nil, 218) -> - 62; -yeccgoto(nil, 222) -> - 62; -yeccgoto(nil, 226) -> - 62; -yeccgoto(nil, 232) -> - 62; -yeccgoto(nil, 235) -> - 62; -yeccgoto(nil, 257) -> - 62; -yeccgoto(nil, 260) -> - 62; -yeccgoto(nil, 265) -> - 62; -yeccgoto(nil, 284) -> - 62; -yeccgoto(nil, 285) -> - 62; -yeccgoto(nil, 290) -> - 62; -yeccgoto(nil, 295) -> - 62; -yeccgoto(nil, 298) -> - 62; -yeccgoto(nil, 301) -> - 62; -yeccgoto(other_pattern, 65) -> - 111; -yeccgoto(other_pattern, 96) -> - 186; -yeccgoto(other_pattern, 97) -> - 111; -yeccgoto(other_pattern, 98) -> - 111; -yeccgoto(other_pattern, 100) -> - 111; -yeccgoto(other_pattern, 114) -> - 111; -yeccgoto(other_pattern, 115) -> - 123; -yeccgoto(other_pattern, 120) -> - 111; -yeccgoto(other_pattern, 162) -> - 111; -yeccgoto(other_pattern, 174) -> - 111; -yeccgoto(other_pattern, 177) -> - 111; -yeccgoto(other_pattern, 200) -> - 111; -yeccgoto(other_pattern, 222) -> - 111; -yeccgoto(primop_expr, 33) -> - 64; -yeccgoto(primop_expr, 35) -> - 64; -yeccgoto(primop_expr, 36) -> - 64; -yeccgoto(primop_expr, 37) -> - 64; -yeccgoto(primop_expr, 40) -> - 64; -yeccgoto(primop_expr, 44) -> - 64; -yeccgoto(primop_expr, 46) -> - 64; -yeccgoto(primop_expr, 48) -> - 64; -yeccgoto(primop_expr, 52) -> - 64; -yeccgoto(primop_expr, 70) -> - 64; -yeccgoto(primop_expr, 74) -> - 64; -yeccgoto(primop_expr, 79) -> - 64; -yeccgoto(primop_expr, 86) -> - 64; -yeccgoto(primop_expr, 90) -> - 64; -yeccgoto(primop_expr, 99) -> - 64; -yeccgoto(primop_expr, 164) -> - 64; -yeccgoto(primop_expr, 166) -> - 64; -yeccgoto(primop_expr, 171) -> - 64; -yeccgoto(primop_expr, 203) -> - 64; -yeccgoto(primop_expr, 211) -> - 64; -yeccgoto(primop_expr, 214) -> - 64; -yeccgoto(primop_expr, 216) -> - 64; -yeccgoto(primop_expr, 218) -> - 64; -yeccgoto(primop_expr, 226) -> - 64; -yeccgoto(primop_expr, 232) -> - 64; -yeccgoto(primop_expr, 235) -> - 64; -yeccgoto(primop_expr, 257) -> - 64; -yeccgoto(primop_expr, 260) -> - 64; -yeccgoto(primop_expr, 265) -> - 64; -yeccgoto(receive_expr, 33) -> - 66; -yeccgoto(receive_expr, 35) -> - 66; -yeccgoto(receive_expr, 36) -> - 66; -yeccgoto(receive_expr, 37) -> - 66; -yeccgoto(receive_expr, 40) -> - 66; -yeccgoto(receive_expr, 44) -> - 66; -yeccgoto(receive_expr, 46) -> - 66; -yeccgoto(receive_expr, 48) -> - 66; -yeccgoto(receive_expr, 52) -> - 66; -yeccgoto(receive_expr, 70) -> - 66; -yeccgoto(receive_expr, 74) -> - 66; -yeccgoto(receive_expr, 79) -> - 66; -yeccgoto(receive_expr, 86) -> - 66; -yeccgoto(receive_expr, 90) -> - 66; -yeccgoto(receive_expr, 99) -> - 66; -yeccgoto(receive_expr, 164) -> - 66; -yeccgoto(receive_expr, 166) -> - 66; -yeccgoto(receive_expr, 171) -> - 66; -yeccgoto(receive_expr, 203) -> - 66; -yeccgoto(receive_expr, 211) -> - 66; -yeccgoto(receive_expr, 214) -> - 66; -yeccgoto(receive_expr, 216) -> - 66; -yeccgoto(receive_expr, 218) -> - 66; -yeccgoto(receive_expr, 226) -> - 66; -yeccgoto(receive_expr, 232) -> - 66; -yeccgoto(receive_expr, 235) -> - 66; -yeccgoto(receive_expr, 257) -> - 66; -yeccgoto(receive_expr, 260) -> - 66; -yeccgoto(receive_expr, 265) -> - 66; -yeccgoto(segment, 247) -> - 249; -yeccgoto(segment, 255) -> - 249; -yeccgoto(segment_pattern, 190) -> - 192; -yeccgoto(segment_pattern, 198) -> - 192; -yeccgoto(segment_patterns, 190) -> - 193; -yeccgoto(segment_patterns, 198) -> - 199; -yeccgoto(segments, 247) -> - 250; -yeccgoto(segments, 255) -> - 256; -yeccgoto(sequence, 33) -> - 67; -yeccgoto(sequence, 35) -> - 67; -yeccgoto(sequence, 36) -> - 67; -yeccgoto(sequence, 37) -> - 67; -yeccgoto(sequence, 40) -> - 67; -yeccgoto(sequence, 44) -> - 67; -yeccgoto(sequence, 46) -> - 67; -yeccgoto(sequence, 48) -> - 67; -yeccgoto(sequence, 52) -> - 67; -yeccgoto(sequence, 70) -> - 67; -yeccgoto(sequence, 74) -> - 67; -yeccgoto(sequence, 79) -> - 67; -yeccgoto(sequence, 86) -> - 67; -yeccgoto(sequence, 90) -> - 67; -yeccgoto(sequence, 99) -> - 67; -yeccgoto(sequence, 164) -> - 67; -yeccgoto(sequence, 166) -> - 67; -yeccgoto(sequence, 171) -> - 67; -yeccgoto(sequence, 203) -> - 67; -yeccgoto(sequence, 211) -> - 67; -yeccgoto(sequence, 214) -> - 67; -yeccgoto(sequence, 216) -> - 67; -yeccgoto(sequence, 218) -> - 67; -yeccgoto(sequence, 226) -> - 67; -yeccgoto(sequence, 232) -> - 67; -yeccgoto(sequence, 235) -> - 67; -yeccgoto(sequence, 257) -> - 67; -yeccgoto(sequence, 260) -> - 67; -yeccgoto(sequence, 265) -> - 67; -yeccgoto(single_expression, 33) -> - 68; -yeccgoto(single_expression, 35) -> - 68; -yeccgoto(single_expression, 36) -> - 68; -yeccgoto(single_expression, 37) -> - 68; -yeccgoto(single_expression, 40) -> - 68; -yeccgoto(single_expression, 44) -> - 68; -yeccgoto(single_expression, 46) -> - 68; -yeccgoto(single_expression, 48) -> - 68; -yeccgoto(single_expression, 52) -> - 68; -yeccgoto(single_expression, 70) -> - 68; -yeccgoto(single_expression, 74) -> - 68; -yeccgoto(single_expression, 79) -> - 68; -yeccgoto(single_expression, 86) -> - 68; -yeccgoto(single_expression, 90) -> - 68; -yeccgoto(single_expression, 99) -> - 68; -yeccgoto(single_expression, 164) -> - 68; -yeccgoto(single_expression, 166) -> - 68; -yeccgoto(single_expression, 171) -> - 68; -yeccgoto(single_expression, 203) -> - 68; -yeccgoto(single_expression, 211) -> - 68; -yeccgoto(single_expression, 214) -> - 68; -yeccgoto(single_expression, 216) -> - 68; -yeccgoto(single_expression, 218) -> - 68; -yeccgoto(single_expression, 226) -> - 68; -yeccgoto(single_expression, 232) -> - 68; -yeccgoto(single_expression, 235) -> - 68; -yeccgoto(single_expression, 257) -> - 68; -yeccgoto(single_expression, 260) -> - 68; -yeccgoto(single_expression, 265) -> - 68; -yeccgoto(tail, 231) -> - 234; -yeccgoto(tail, 238) -> - 239; -yeccgoto(tail_constant, 150) -> - 153; -yeccgoto(tail_constant, 157) -> - 158; -yeccgoto(tail_literal, 297) -> - 300; -yeccgoto(tail_literal, 304) -> - 305; -yeccgoto(tail_pattern, 173) -> - 176; -yeccgoto(tail_pattern, 180) -> - 181; -yeccgoto(timeout, 65) -> - 112; -yeccgoto(timeout, 101) -> - 168; -yeccgoto(try_expr, 33) -> - 71; -yeccgoto(try_expr, 35) -> - 71; -yeccgoto(try_expr, 36) -> - 71; -yeccgoto(try_expr, 37) -> - 71; -yeccgoto(try_expr, 40) -> - 71; -yeccgoto(try_expr, 44) -> - 71; -yeccgoto(try_expr, 46) -> - 71; -yeccgoto(try_expr, 48) -> - 71; -yeccgoto(try_expr, 52) -> - 71; -yeccgoto(try_expr, 70) -> - 71; -yeccgoto(try_expr, 74) -> - 71; -yeccgoto(try_expr, 79) -> - 71; -yeccgoto(try_expr, 86) -> - 71; -yeccgoto(try_expr, 90) -> - 71; -yeccgoto(try_expr, 99) -> - 71; -yeccgoto(try_expr, 164) -> - 71; -yeccgoto(try_expr, 166) -> - 71; -yeccgoto(try_expr, 171) -> - 71; -yeccgoto(try_expr, 203) -> - 71; -yeccgoto(try_expr, 211) -> - 71; -yeccgoto(try_expr, 214) -> - 71; -yeccgoto(try_expr, 216) -> - 71; -yeccgoto(try_expr, 218) -> - 71; -yeccgoto(try_expr, 226) -> - 71; -yeccgoto(try_expr, 232) -> - 71; -yeccgoto(try_expr, 235) -> - 71; -yeccgoto(try_expr, 257) -> - 71; -yeccgoto(try_expr, 260) -> - 71; -yeccgoto(try_expr, 265) -> - 71; -yeccgoto(tuple, 33) -> - 72; -yeccgoto(tuple, 35) -> - 72; -yeccgoto(tuple, 36) -> - 72; -yeccgoto(tuple, 37) -> - 72; -yeccgoto(tuple, 40) -> - 72; -yeccgoto(tuple, 44) -> - 72; -yeccgoto(tuple, 46) -> - 72; -yeccgoto(tuple, 48) -> - 72; -yeccgoto(tuple, 52) -> - 72; -yeccgoto(tuple, 70) -> - 72; -yeccgoto(tuple, 74) -> - 72; -yeccgoto(tuple, 79) -> - 72; -yeccgoto(tuple, 86) -> - 72; -yeccgoto(tuple, 90) -> - 72; -yeccgoto(tuple, 99) -> - 72; -yeccgoto(tuple, 164) -> - 72; -yeccgoto(tuple, 166) -> - 72; -yeccgoto(tuple, 171) -> - 72; -yeccgoto(tuple, 203) -> - 72; -yeccgoto(tuple, 211) -> - 72; -yeccgoto(tuple, 214) -> - 72; -yeccgoto(tuple, 216) -> - 72; -yeccgoto(tuple, 218) -> - 72; -yeccgoto(tuple, 226) -> - 72; -yeccgoto(tuple, 232) -> - 72; -yeccgoto(tuple, 235) -> - 72; -yeccgoto(tuple, 257) -> - 72; -yeccgoto(tuple, 260) -> - 72; -yeccgoto(tuple, 265) -> - 72; -yeccgoto(tuple_constant, 126) -> - 141; -yeccgoto(tuple_constant, 129) -> - 141; -yeccgoto(tuple_constant, 142) -> - 141; -yeccgoto(tuple_constant, 147) -> - 141; -yeccgoto(tuple_constant, 151) -> - 141; -yeccgoto(tuple_constant, 154) -> - 141; -yeccgoto(tuple_literal, 284) -> - 289; -yeccgoto(tuple_literal, 285) -> - 289; -yeccgoto(tuple_literal, 290) -> - 289; -yeccgoto(tuple_literal, 295) -> - 289; -yeccgoto(tuple_literal, 298) -> - 289; -yeccgoto(tuple_literal, 301) -> - 289; -yeccgoto(tuple_pattern, 65) -> - 113; -yeccgoto(tuple_pattern, 96) -> - 113; -yeccgoto(tuple_pattern, 97) -> - 113; -yeccgoto(tuple_pattern, 98) -> - 113; -yeccgoto(tuple_pattern, 100) -> - 113; -yeccgoto(tuple_pattern, 114) -> - 113; -yeccgoto(tuple_pattern, 115) -> - 113; -yeccgoto(tuple_pattern, 120) -> - 113; -yeccgoto(tuple_pattern, 162) -> - 113; -yeccgoto(tuple_pattern, 174) -> - 113; -yeccgoto(tuple_pattern, 177) -> - 113; -yeccgoto(tuple_pattern, 200) -> - 113; -yeccgoto(tuple_pattern, 222) -> - 113; -yeccgoto(variable, 25) -> - 31; -yeccgoto(variable, 26) -> - 267; -yeccgoto(variable, 33) -> - 73; -yeccgoto(variable, 35) -> - 73; -yeccgoto(variable, 36) -> - 73; -yeccgoto(variable, 37) -> - 73; -yeccgoto(variable, 40) -> - 73; -yeccgoto(variable, 44) -> - 73; -yeccgoto(variable, 46) -> - 73; -yeccgoto(variable, 48) -> - 73; -yeccgoto(variable, 52) -> - 73; -yeccgoto(variable, 58) -> - 31; -yeccgoto(variable, 65) -> - 31; -yeccgoto(variable, 70) -> - 73; -yeccgoto(variable, 74) -> - 73; -yeccgoto(variable, 79) -> - 73; -yeccgoto(variable, 82) -> - 31; -yeccgoto(variable, 83) -> - 31; -yeccgoto(variable, 86) -> - 73; -yeccgoto(variable, 88) -> - 31; -yeccgoto(variable, 90) -> - 73; -yeccgoto(variable, 96) -> - 124; -yeccgoto(variable, 97) -> - 31; -yeccgoto(variable, 98) -> - 31; -yeccgoto(variable, 99) -> - 73; -yeccgoto(variable, 100) -> - 31; -yeccgoto(variable, 114) -> - 31; -yeccgoto(variable, 115) -> - 124; -yeccgoto(variable, 120) -> - 31; -yeccgoto(variable, 162) -> - 31; -yeccgoto(variable, 164) -> - 73; -yeccgoto(variable, 166) -> - 73; -yeccgoto(variable, 171) -> - 73; -yeccgoto(variable, 174) -> - 31; -yeccgoto(variable, 177) -> - 31; -yeccgoto(variable, 200) -> - 31; -yeccgoto(variable, 203) -> - 73; -yeccgoto(variable, 211) -> - 73; -yeccgoto(variable, 214) -> - 73; -yeccgoto(variable, 216) -> - 73; -yeccgoto(variable, 218) -> - 73; -yeccgoto(variable, 222) -> - 31; -yeccgoto(variable, 226) -> - 73; -yeccgoto(variable, 232) -> - 73; -yeccgoto(variable, 235) -> - 73; -yeccgoto(variable, 257) -> - 73; -yeccgoto(variable, 260) -> - 73; -yeccgoto(variable, 263) -> - 31; -yeccgoto(variable, 265) -> - 73; -yeccgoto(__Symbol, __State) -> - exit({__Symbol, __State, missing_in_goto_table}). - - diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_parse.hrl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_parse.hrl deleted file mode 100644 index aaf913a15a..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_parse.hrl +++ /dev/null @@ -1,111 +0,0 @@ -%% ``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 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. -%% -%% 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: core_parse.hrl,v 1.1 2008/12/17 09:53:42 mikpe Exp $ -%% -%% Purpose : Core Erlang syntax trees as records. - -%% It would be nice to incorporate some generic functions as well but -%% this could make including this file difficult. - -%% Note: the annotation list is *always* the first record field. -%% Thus it is possible to define the macros: -%% -define(get_ann(X), element(2, X)). -%% -define(set_ann(X, Y), setelement(2, X, Y)). - --record(c_int, {anno=[], val}). % val :: integer() - --record(c_float, {anno=[], val}). % val :: float() - --record(c_atom, {anno=[], val}). % val :: atom() - --record(c_char, {anno=[], val}). % val :: char() - --record(c_string, {anno=[], val}). % val :: string() - --record(c_nil, {anno=[]}). - --record(c_binary, {anno=[], segments}). % segments :: [#ce_bitstr{}] - --record(c_bitstr, {anno=[],val, % val :: Tree, - size, % size :: Tree, - unit, % unit :: integer(), - type, % type :: atom(), - flags}). % flags :: [atom()], - --record(c_cons, {anno=[], hd, % hd :: Tree, - tl}). % tl :: Tree - --record(c_tuple, {anno=[], es}). % es :: [Tree] - --record(c_var, {anno=[], name}). % name :: integer() | atom() - --record(c_fname, {anno=[], id, % id :: atom(), - arity}). % arity :: integer() - --record(c_values, {anno=[], es}). % es :: [Tree] - --record(c_fun, {anno=[], vars, % vars :: [Tree], - body}). % body :: Tree - --record(c_seq, {anno=[], arg, % arg :: Tree, - body}). % body :: Tree - --record(c_let, {anno=[], vars, % vars :: [Tree], - arg, % arg :: Tree, - body}). % body :: Tree - --record(c_letrec, {anno=[], defs, % defs :: [#ce_def{}], - body}). % body :: Tree - --record(c_def, {anno=[], name, % name :: Tree, - val}). % val :: Tree, - --record(c_case, {anno=[], arg, % arg :: Tree, - clauses}). % clauses :: [Tree] - --record(c_clause, {anno=[], pats, % pats :: [Tree], - guard, % guard :: Tree, - body}). % body :: Tree - --record(c_alias, {anno=[], var, % var :: Tree, - pat}). % pat :: Tree - --record(c_receive, {anno=[], clauses, % clauses :: [Tree], - timeout, % timeout :: Tree, - action}). % action :: Tree - --record(c_apply, {anno=[], op, % op :: Tree, - args}). % args :: [Tree] - --record(c_call, {anno=[], module, % module :: Tree, - name, % name :: Tree, - args}). % args :: [Tree] - --record(c_primop, {anno=[], name, % name :: Tree, - args}). % args :: [Tree] - --record(c_try, {anno=[], arg, % arg :: Tree, - vars, % vars :: [Tree], - body, % body :: Tree - evars, % evars :: [Tree], - handler}). % handler :: Tree - --record(c_catch, {anno=[], body}). % body :: Tree - --record(c_module, {anno=[], name, % name :: Tree, - exports, % exports :: [Tree], - attrs, % attrs :: [#ce_def{}], - defs}). % defs :: [#ce_def{}] diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_pp.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_pp.erl deleted file mode 100644 index 147a0dba6c..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_pp.erl +++ /dev/null @@ -1,430 +0,0 @@ -%% ``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 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. -%% -%% 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: core_pp.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $ -%% -%% Purpose : Core Erlang (naive) prettyprinter - --module(core_pp). - --export([format/1]). - --include("core_parse.hrl"). - -%% ====================================================================== %% -%% format(Node) -> Text -%% Node = coreErlang() -%% Text = string() | [Text] -%% -%% Prettyprint-formats (naively) an abstract Core Erlang syntax -%% tree. - --record(ctxt, {class = term, - indent = 0, - item_indent = 2, - body_indent = 4, - tab_width = 8, - line = 0}). - -format(Node) -> case catch format(Node, #ctxt{}) of - {'EXIT',_} -> io_lib:format("~p",[Node]); - Other -> Other - end. - -maybe_anno(Node, Fun, Ctxt) -> - As = core_lib:get_anno(Node), - case get_line(As) of - none -> - maybe_anno(Node, Fun, Ctxt, As); - Line -> - if Line > Ctxt#ctxt.line -> - [io_lib:format("%% Line ~w",[Line]), - nl_indent(Ctxt), - maybe_anno(Node, Fun, Ctxt#ctxt{line = Line}, As) - ]; - true -> - maybe_anno(Node, Fun, Ctxt, As) - end - end. - -maybe_anno(Node, Fun, Ctxt, As) -> - case strip_line(As) of - [] -> - Fun(Node, Ctxt); - List -> - Ctxt1 = add_indent(Ctxt, 2), - Ctxt2 = add_indent(Ctxt1, 3), - ["( ", - Fun(Node, Ctxt1), - nl_indent(Ctxt1), - "-| ",format_1(core_lib:make_literal(List), Ctxt2)," )" - ] - end. - -strip_line([A | As]) when integer(A) -> - strip_line(As); -strip_line([A | As]) -> - [A | strip_line(As)]; -strip_line([]) -> - []. - -get_line([L | _As]) when integer(L) -> - L; -get_line([_ | As]) -> - get_line(As); -get_line([]) -> - none. - -format(Node, Ctxt) -> - maybe_anno(Node, fun format_1/2, Ctxt). - -format_1(#c_char{val=C}, _) -> io_lib:write_char(C); -format_1(#c_int{val=I}, _) -> integer_to_list(I); -format_1(#c_float{val=F}, _) -> float_to_list(F); -format_1(#c_atom{val=A}, _) -> core_atom(A); -format_1(#c_nil{}, _) -> "[]"; -format_1(#c_string{val=S}, _) -> io_lib:write_string(S); -format_1(#c_var{name=V}, _) -> - %% Internal variable names may be: - %% - atoms representing proper Erlang variable names, or - %% any atoms that may be printed without single-quoting - %% - nonnegative integers. - %% It is important that when printing variables, no two names - %% should ever map to the same string. - if atom(V) -> - S = atom_to_list(V), - case S of - [C | _] when C >= $A, C =< $Z -> - %% Ordinary uppercase-prefixed names are - %% printed just as they are. - S; - [$_ | _] -> - %% Already "_"-prefixed names are prefixed - %% with "_X", e.g. '_foo' => '_X_foo', to - %% avoid generating things like "____foo" upon - %% repeated writing and reading of code. - %% ("_X_X_X_foo" is better.) - [$_, $X | S]; - _ -> - %% Plain atoms are prefixed with a single "_". - %% E.g. foo => "_foo". - [$_ | S] - end; - integer(V) -> - %% Integers are also simply prefixed with "_". - [$_ | integer_to_list(V)] - end; -format_1(#c_binary{segments=Segs}, Ctxt) -> - ["#{", - format_vseq(Segs, "", ",", add_indent(Ctxt, 2), - fun format_bitstr/2), - "}#" - ]; -format_1(#c_tuple{es=Es}, Ctxt) -> - [${, - format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), - $} - ]; -format_1(#c_cons{hd=H,tl=T}, Ctxt) -> - Txt = ["["|format(H, add_indent(Ctxt, 1))], - [Txt|format_list_tail(T, add_indent(Ctxt, width(Txt, Ctxt)))]; -format_1(#c_values{es=Es}, Ctxt) -> - format_values(Es, Ctxt); -format_1(#c_alias{var=V,pat=P}, Ctxt) -> - Txt = [format(V, Ctxt)|" = "], - [Txt|format(P, add_indent(Ctxt, width(Txt, Ctxt)))]; -format_1(#c_let{vars=Vs,arg=A,body=B}, Ctxt) -> - Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.body_indent), - ["let ", - format_values(Vs, add_indent(Ctxt, 4)), - " =", - nl_indent(Ctxt1), - format(A, Ctxt1), - nl_indent(Ctxt), - "in " - | format(B, add_indent(Ctxt, 4)) - ]; -format_1(#c_letrec{defs=Fs,body=B}, Ctxt) -> - Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.body_indent), - ["letrec", - nl_indent(Ctxt1), - format_funcs(Fs, Ctxt1), - nl_indent(Ctxt), - "in " - | format(B, add_indent(Ctxt, 4)) - ]; -format_1(#c_seq{arg=A,body=B}, Ctxt) -> - Ctxt1 = add_indent(Ctxt, 4), - ["do ", - format(A, Ctxt1), - nl_indent(Ctxt1) - | format(B, Ctxt1) - ]; -format_1(#c_case{arg=A,clauses=Cs}, Ctxt) -> - Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.item_indent), - ["case ", - format(A, add_indent(Ctxt, 5)), - " of", - nl_indent(Ctxt1), - format_clauses(Cs, Ctxt1), - nl_indent(Ctxt) - | "end" - ]; -format_1(#c_receive{clauses=Cs,timeout=T,action=A}, Ctxt) -> - Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.item_indent), - ["receive", - nl_indent(Ctxt1), - format_clauses(Cs, Ctxt1), - nl_indent(Ctxt), - "after ", - format(T, add_indent(Ctxt, 6)), - " ->", - nl_indent(Ctxt1), - format(A, Ctxt1) - ]; -format_1(#c_fname{id=I,arity=A}, _) -> - [core_atom(I),$/,integer_to_list(A)]; -format_1(#c_fun{vars=Vs,body=B}, Ctxt) -> - Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.body_indent), - ["fun (", - format_hseq(Vs, ",", add_indent(Ctxt, 5), fun format/2), - ") ->", - nl_indent(Ctxt1) - | format(B, Ctxt1) - ]; -format_1(#c_apply{op=O,args=As}, Ctxt0) -> - Ctxt1 = add_indent(Ctxt0, 6), %"apply " - Op = format(O, Ctxt1), - Ctxt2 = add_indent(Ctxt0, 4), - ["apply ",Op, - nl_indent(Ctxt2), - $(,format_hseq(As, ", ", add_indent(Ctxt2, 1), fun format/2),$) - ]; -format_1(#c_call{module=M,name=N,args=As}, Ctxt0) -> - Ctxt1 = add_indent(Ctxt0, 5), %"call " - Mod = format(M, Ctxt1), - Ctxt2 = add_indent(Ctxt1, width(Mod, Ctxt1)+1), - Name = format(N, Ctxt2), - Ctxt3 = add_indent(Ctxt0, 4), - ["call ",Mod,":",Name, - nl_indent(Ctxt3), - $(,format_hseq(As, ", ", add_indent(Ctxt3, 1), fun format/2),$) - ]; -format_1(#c_primop{name=N,args=As}, Ctxt0) -> - Ctxt1 = add_indent(Ctxt0, 7), %"primop " - Name = format(N, Ctxt1), - Ctxt2 = add_indent(Ctxt0, 4), - ["primop ",Name, - nl_indent(Ctxt2), - $(,format_hseq(As, ", ", add_indent(Ctxt2, 1), fun format/2),$) - ]; -format_1(#c_catch{body=B}, Ctxt) -> - Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.body_indent), - ["catch", - nl_indent(Ctxt1), - format(B, Ctxt1) - ]; -format_1(#c_try{arg=E,vars=Vs,body=B,evars=Evs,handler=H}, Ctxt) -> - Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.body_indent), - ["try", - nl_indent(Ctxt1), - format(E, Ctxt1), - nl_indent(Ctxt), - "of ", - format_values(Vs, add_indent(Ctxt, 3)), - " ->", - nl_indent(Ctxt1), - format(B, Ctxt1), - nl_indent(Ctxt), - "catch ", - format_values(Evs, add_indent(Ctxt, 6)), - " ->", - nl_indent(Ctxt1) - | format(H, Ctxt1) - ]; -format_1(#c_def{name=N,val=V}, Ctxt) -> - Ctxt1 = add_indent(set_class(Ctxt, expr), Ctxt#ctxt.body_indent), - [format(N, Ctxt), - " =", - nl_indent(Ctxt1) - | format(V, Ctxt1) - ]; -format_1(#c_module{name=N,exports=Es,attrs=As,defs=Ds}, Ctxt) -> - Mod = ["module ", format(N, Ctxt)], - [Mod," [", - format_vseq(Es, - "", ",", - add_indent(set_class(Ctxt, term), width(Mod, Ctxt)+2), - fun format/2), - "]", - nl_indent(Ctxt), - " attributes [", - format_vseq(As, - "", ",", - add_indent(set_class(Ctxt, def), 16), - fun format/2), - "]", - nl_indent(Ctxt), - format_funcs(Ds, Ctxt), - nl_indent(Ctxt) - | "end" - ]; -format_1(Type, _) -> - ["** Unsupported type: ", - io_lib:write(Type) - | " **" - ]. - -format_funcs(Fs, Ctxt) -> - format_vseq(Fs, - "", "", - set_class(Ctxt, def), - fun format/2). - -format_values(Vs, Ctxt) -> - [$<, - format_hseq(Vs, ",", add_indent(Ctxt, 1), fun format/2), - $>]. - -format_bitstr(#c_bitstr{val=V,size=S,unit=U,type=T,flags=Fs}, Ctxt0) -> - Vs = [S, U, T, Fs], - Ctxt1 = add_indent(Ctxt0, 2), - Val = format(V, Ctxt1), - Ctxt2 = add_indent(Ctxt1, width(Val, Ctxt1) + 2), - ["#<", Val, ">(", format_hseq(Vs,",", Ctxt2, fun format/2), $)]. - -format_clauses(Cs, Ctxt) -> - format_vseq(Cs, "", "", set_class(Ctxt, clause), - fun format_clause/2). - -format_clause(Node, Ctxt) -> - maybe_anno(Node, fun format_clause_1/2, Ctxt). - -format_clause_1(#c_clause{pats=Ps,guard=G,body=B}, Ctxt) -> - Ptxt = format_values(Ps, Ctxt), - Ctxt2 = add_indent(Ctxt, Ctxt#ctxt.body_indent), - [Ptxt, - " when ", - format_guard(G, add_indent(set_class(Ctxt, expr), - width(Ptxt, Ctxt) + 6)), - " ->", - nl_indent(Ctxt2) - | format(B, set_class(Ctxt2, expr)) - ]. - -format_guard(Node, Ctxt) -> - maybe_anno(Node, fun format_guard_1/2, Ctxt). - -format_guard_1(#c_call{module=M,name=N,args=As}, Ctxt0) -> - Ctxt1 = add_indent(Ctxt0, 5), %"call " - Mod = format(M, Ctxt1), - Ctxt2 = add_indent(Ctxt1, width(Mod, Ctxt1)+1), - Name = format(N, Ctxt2), - Ctxt3 = add_indent(Ctxt0, 4), - ["call ",Mod,":",Name, - nl_indent(Ctxt3), - $(,format_vseq(As, "",",", add_indent(Ctxt3, 1), fun format_guard/2),$) - ]; -format_guard_1(E, Ctxt) -> format_1(E, Ctxt). %Anno already done - -%% format_hseq([Thing], Separator, Context, Fun) -> Txt. -%% Format a sequence horizontally on the same line with Separator between. - -format_hseq([H], _, Ctxt, Fun) -> - Fun(H, Ctxt); -format_hseq([H|T], Sep, Ctxt, Fun) -> - Txt = [Fun(H, Ctxt)|Sep], - Ctxt1 = add_indent(Ctxt, width(Txt, Ctxt)), - [Txt|format_hseq(T, Sep, Ctxt1, Fun)]; -format_hseq([], _, _, _) -> "". - -%% format_vseq([Thing], LinePrefix, LineSuffix, Context, Fun) -> Txt. -%% Format a sequence vertically in indented lines adding LinePrefix -%% to the beginning of each line and LineSuffix to the end of each -%% line. No prefix on the first line or suffix on the last line. - -format_vseq([H], _Pre, _Suf, Ctxt, Fun) -> - Fun(H, Ctxt); -format_vseq([H|T], Pre, Suf, Ctxt, Fun) -> - [Fun(H, Ctxt),Suf,nl_indent(Ctxt),Pre| - format_vseq(T, Pre, Suf, Ctxt, Fun)]; -format_vseq([], _, _, _, _) -> "". - -format_list_tail(#c_nil{anno=[]}, _) -> "]"; -format_list_tail(#c_cons{anno=[],hd=H,tl=T}, Ctxt) -> - Txt = [$,|format(H, Ctxt)], - Ctxt1 = add_indent(Ctxt, width(Txt, Ctxt)), - [Txt|format_list_tail(T, Ctxt1)]; -format_list_tail(Tail, Ctxt) -> - ["|",format(Tail, add_indent(Ctxt, 1)),"]"]. - -indent(Ctxt) -> indent(Ctxt#ctxt.indent, Ctxt). - -indent(N, _) when N =< 0 -> ""; -indent(N, Ctxt) -> - T = Ctxt#ctxt.tab_width, - string:chars($\t, N div T, string:chars($\s, N rem T)). - -nl_indent(Ctxt) -> [$\n|indent(Ctxt)]. - - -unindent(T, Ctxt) -> - unindent(T, Ctxt#ctxt.indent, Ctxt, []). - -unindent(T, N, _, C) when N =< 0 -> - [T|C]; -unindent([$\s|T], N, Ctxt, C) -> - unindent(T, N - 1, Ctxt, C); -unindent([$\t|T], N, Ctxt, C) -> - Tab = Ctxt#ctxt.tab_width, - if N >= Tab -> - unindent(T, N - Tab, Ctxt, C); - true -> - unindent([string:chars($\s, Tab - N)|T], 0, Ctxt, C) - end; -unindent([L|T], N, Ctxt, C) when list(L) -> - unindent(L, N, Ctxt, [T|C]); -unindent([H|T], _, _, C) -> - [H|[T|C]]; -unindent([], N, Ctxt, [H|T]) -> - unindent(H, N, Ctxt, T); -unindent([], _, _, []) -> []. - - -width(Txt, Ctxt) -> - case catch width(Txt, 0, Ctxt, []) of - {'EXIT',_} -> exit({bad_text,Txt}); - Other -> Other - end. - -width([$\t|T], A, Ctxt, C) -> - width(T, A + Ctxt#ctxt.tab_width, Ctxt, C); -width([$\n|T], _, Ctxt, C) -> - width(unindent([T|C], Ctxt), Ctxt); -width([H|T], A, Ctxt, C) when list(H) -> - width(H, A, Ctxt, [T|C]); -width([_|T], A, Ctxt, C) -> - width(T, A + 1, Ctxt, C); -width([], A, Ctxt, [H|T]) -> - width(H, A, Ctxt, T); -width([], A, _, []) -> A. - -add_indent(Ctxt, Dx) -> - Ctxt#ctxt{indent = Ctxt#ctxt.indent + Dx}. - -set_class(Ctxt, Class) -> - Ctxt#ctxt{class = Class}. - -core_atom(A) -> io_lib:write_string(atom_to_list(A), $'). diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_scan.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_scan.erl deleted file mode 100644 index f53c3c1631..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_scan.erl +++ /dev/null @@ -1,495 +0,0 @@ -%% ``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 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. -%% -%% 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: core_scan.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $ -%% -%% Purpose: Scanner for Core Erlang. - -%% For handling ISO 8859-1 (Latin-1) we use the following type -%% information: -%% -%% 000 - 037 NUL - US control -%% 040 - 057 SPC - / punctuation -%% 060 - 071 0 - 9 digit -%% 072 - 100 : - @ punctuation -%% 101 - 132 A - Z uppercase -%% 133 - 140 [ - ` punctuation -%% 141 - 172 a - z lowercase -%% 173 - 176 { - ~ punctuation -%% 177 DEL control -%% 200 - 237 control -%% 240 - 277 NBSP - � punctuation -%% 300 - 326 � - � uppercase -%% 327 � punctuation -%% 330 - 336 � - � uppercase -%% 337 - 366 � - � lowercase -%% 367 � punctuation -%% 370 - 377 � - � lowercase -%% -%% Many punctuation characters region have special meaning. Must -%% watch using � \327, bvery close to x \170 - --module(core_scan). - --export([string/1,string/2,tokens/3,format_error/1]). - --import(lists, [reverse/1]). - -%% tokens(Continuation, CharList, StartPos) -> -%% {done, {ok, [Tok], EndPos}, Rest} | -%% {done, {error,{ErrorPos,core_scan,What}, EndPos}, Rest} | -%% {more, Continuation'} -%% This is the main function into the re-entrant scanner. It calls the -%% re-entrant pre-scanner until this says done, then calls scan/1 on -%% the result. -%% -%% The continuation has the form: -%% {RestChars,CharsSoFar,CurrentPos,StartPos} - -tokens([], Chars, Pos) -> %First call - tokens({[],[],Pos,Pos}, Chars, Pos); -tokens({Chars,SoFar0,Cp,Sp}, MoreChars, _) -> - In = Chars ++ MoreChars, - case pre_scan(In, SoFar0, Cp) of - {done,_,[],Ep} -> %Found nothing - {done,{eof,Ep},[]}; - {done,_,SoFar1,Ep} -> %Got complete tokens - Res = case scan(reverse(SoFar1), Sp) of - {ok,Toks} -> {ok,Toks,Ep}; - {error,E} -> {error,E,Ep} - end, - {done,Res,[]}; - {more,Rest,SoFar1,Cp1} -> %Missing end token - {more,{Rest,SoFar1,Cp1,Sp}}; - Other -> %An error has occurred - {done,Other,[]} - end. - -%% string([Char]) -> -%% string([Char], StartPos) -> -%% {ok, [Tok], EndPos} | -%% {error,{Pos,core_scan,What}, EndPos} - -string(Cs) -> string(Cs, 1). - -string(Cs, Sp) -> - %% Add an 'eof' to always get correct handling. - case string_pre_scan(Cs, [], Sp) of - {done,_,SoFar,Ep} -> %Got tokens - case scan(reverse(SoFar), Sp) of - {ok,Toks} -> {ok,Toks,Ep}; - {error,E} -> {error,E,Ep} - end; - Other -> Other %An error has occurred - end. - -%% string_pre_scan(Cs, SoFar0, StartPos) -> -%% {done,Rest,SoFar,EndPos} | {error,E,EndPos}. - -string_pre_scan(Cs, SoFar0, Sp) -> - case pre_scan(Cs, SoFar0, Sp) of - {done,Rest,SoFar1,Ep} -> %Got complete tokens - {done,Rest,SoFar1,Ep}; - {more,Rest,SoFar1,Ep} -> %Missing end token - string_pre_scan(Rest ++ eof, SoFar1, Ep); - Other -> Other %An error has occurred - end. - -%% format_error(Error) -%% Return a string describing the error. - -format_error({string,Quote,Head}) -> - ["unterminated " ++ string_thing(Quote) ++ - " starting with " ++ io_lib:write_string(Head,Quote)]; -format_error({illegal,Type}) -> io_lib:fwrite("illegal ~w", [Type]); -format_error(char) -> "unterminated character"; -format_error(scan) -> "premature end"; -format_error({base,Base}) -> io_lib:fwrite("illegal base '~w'", [Base]); -format_error(float) -> "bad float"; -format_error(Other) -> io_lib:write(Other). - -string_thing($') -> "atom"; -string_thing($") -> "string". - -%% Re-entrant pre-scanner. -%% -%% If the input list of characters is insufficient to build a term the -%% scanner returns a request for more characters and a continuation to be -%% used when trying to build a term with more characters. To indicate -%% end-of-file the input character list should be replaced with 'eof' -%% as an empty list has meaning. -%% -%% When more characters are need inside a comment, string or quoted -%% atom, which can become rather long, instead of pushing the -%% characters read so far back onto RestChars to be reread, a special -%% reentry token is returned indicating the middle of a construct. -%% The token is the start character as an atom, '%', '"' and '\''. - -%% pre_scan([Char], SoFar, StartPos) -> -%% {done,RestChars,ScannedChars,NewPos} | -%% {more,RestChars,ScannedChars,NewPos} | -%% {error,{ErrorPos,core_scan,Description},NewPos}. -%% Main pre-scan function. It has been split into 2 functions because of -%% efficiency, with a good indexing compiler it would be unnecessary. - -pre_scan([C|Cs], SoFar, Pos) -> - pre_scan(C, Cs, SoFar, Pos); -pre_scan([], SoFar, Pos) -> - {more,[],SoFar,Pos}; -pre_scan(eof, SoFar, Pos) -> - {done,eof,SoFar,Pos}. - -%% pre_scan(Char, [Char], SoFar, Pos) - -pre_scan($$, Cs0, SoFar0, Pos) -> - case pre_char(Cs0, [$$|SoFar0]) of - {Cs,SoFar} -> - pre_scan(Cs, SoFar, Pos); - more -> - {more,[$$|Cs0],SoFar0, Pos}; - error -> - pre_error(char, Pos, Pos) - end; -pre_scan($', Cs, SoFar, Pos) -> - pre_string(Cs, $', '\'', Pos, [$'|SoFar], Pos); -pre_scan({'\'',Sp}, Cs, SoFar, Pos) -> %Re-entering quoted atom - pre_string(Cs, $', '\'', Sp, SoFar, Pos); -pre_scan($", Cs, SoFar, Pos) -> - pre_string(Cs, $", '"', Pos, [$"|SoFar], Pos); -pre_scan({'"',Sp}, Cs, SoFar, Pos) -> %Re-entering string - pre_string(Cs, $", '"', Sp, SoFar, Pos); -pre_scan($%, Cs, SoFar, Pos) -> - pre_comment(Cs, SoFar, Pos); -pre_scan('%', Cs, SoFar, Pos) -> %Re-entering comment - pre_comment(Cs, SoFar, Pos); -pre_scan($\n, Cs, SoFar, Pos) -> - pre_scan(Cs, [$\n|SoFar], Pos+1); -pre_scan(C, Cs, SoFar, Pos) -> - pre_scan(Cs, [C|SoFar], Pos). - -%% pre_string([Char], Quote, Reent, StartPos, SoFar, Pos) - -pre_string([Q|Cs], Q, _, _, SoFar, Pos) -> - pre_scan(Cs, [Q|SoFar], Pos); -pre_string([$\n|Cs], Q, Reent, Sp, SoFar, Pos) -> - pre_string(Cs, Q, Reent, Sp, [$\n|SoFar], Pos+1); -pre_string([$\\|Cs0], Q, Reent, Sp, SoFar0, Pos) -> - case pre_escape(Cs0, SoFar0) of - {Cs,SoFar} -> - pre_string(Cs, Q, Reent, Sp, SoFar, Pos); - more -> - {more,[{Reent,Sp},$\\|Cs0],SoFar0,Pos}; - error -> - pre_string_error(Q, Sp, SoFar0, Pos) - end; -pre_string([C|Cs], Q, Reent, Sp, SoFar, Pos) -> - pre_string(Cs, Q, Reent, Sp, [C|SoFar], Pos); -pre_string([], _, Reent, Sp, SoFar, Pos) -> - {more,[{Reent,Sp}],SoFar,Pos}; -pre_string(eof, Q, _, Sp, SoFar, Pos) -> - pre_string_error(Q, Sp, SoFar, Pos). - -pre_string_error(Q, Sp, SoFar, Pos) -> - S = reverse(string:substr(SoFar, 1, string:chr(SoFar, Q)-1)), - pre_error({string,Q,string:substr(S, 1, 16)}, Sp, Pos). - -pre_char([C|Cs], SoFar) -> pre_char(C, Cs, SoFar); -pre_char([], _) -> more; -pre_char(eof, _) -> error. - -pre_char($\\, Cs, SoFar) -> - pre_escape(Cs, SoFar); -pre_char(C, Cs, SoFar) -> - {Cs,[C|SoFar]}. - -pre_escape([$^|Cs0], SoFar) -> - case Cs0 of - [C3|Cs] -> - {Cs,[C3,$^,$\\|SoFar]}; - [] -> more; - eof -> error - end; -pre_escape([C|Cs], SoFar) -> - {Cs,[C,$\\|SoFar]}; -pre_escape([], _) -> more; -pre_escape(eof, _) -> error. - -%% pre_comment([Char], SoFar, Pos) -%% Comments are replaced by one SPACE. - -pre_comment([$\n|Cs], SoFar, Pos) -> - pre_scan(Cs, [$\n,$\s|SoFar], Pos+1); %Terminate comment -pre_comment([_|Cs], SoFar, Pos) -> - pre_comment(Cs, SoFar, Pos); -pre_comment([], SoFar, Pos) -> - {more,['%'],SoFar,Pos}; -pre_comment(eof, Sofar, Pos) -> - pre_scan(eof, [$\s|Sofar], Pos). - -pre_error(E, Epos, Pos) -> - {error,{Epos,core_scan,E}, Pos}. - -%% scan(CharList, StartPos) -%% This takes a list of characters and tries to tokenise them. -%% -%% The token list is built in reverse order (in a stack) to save appending -%% and then reversed when all the tokens have been collected. Most tokens -%% are built in the same way. -%% -%% Returns: -%% {ok,[Tok]} -%% {error,{ErrorPos,core_scan,What}} - -scan(Cs, Pos) -> - scan1(Cs, [], Pos). - -%% scan1(Characters, TokenStack, Position) -%% Scan a list of characters into tokens. - -scan1([$\n|Cs], Toks, Pos) -> %Skip newline - scan1(Cs, Toks, Pos+1); -scan1([C|Cs], Toks, Pos) when C >= $\000, C =< $\s -> %Skip control chars - scan1(Cs, Toks, Pos); -scan1([C|Cs], Toks, Pos) when C >= $\200, C =< $\240 -> - scan1(Cs, Toks, Pos); -scan1([C|Cs], Toks, Pos) when C >= $a, C =< $z -> %Keywords - scan_key_word(C, Cs, Toks, Pos); -scan1([C|Cs], Toks, Pos) when C >= $�, C =< $�, C /= $� -> - scan_key_word(C, Cs, Toks, Pos); -scan1([C|Cs], Toks, Pos) when C >= $A, C =< $Z -> %Variables - scan_variable(C, Cs, Toks, Pos); -scan1([C|Cs], Toks, Pos) when C >= $�, C =< $�, C /= $� -> - scan_variable(C, Cs, Toks, Pos); -scan1([C|Cs], Toks, Pos) when C >= $0, C =< $9 -> %Numbers - scan_number(C, Cs, Toks, Pos); -scan1([$-,C|Cs], Toks, Pos) when C >= $0, C =< $9 -> %Signed numbers - scan_signed_number($-, C, Cs, Toks, Pos); -scan1([$+,C|Cs], Toks, Pos) when C >= $0, C =< $9 -> %Signed numbers - scan_signed_number($+, C, Cs, Toks, Pos); -scan1([$_|Cs], Toks, Pos) -> %_ variables - scan_variable($_, Cs, Toks, Pos); -scan1([$$|Cs0], Toks, Pos) -> %Character constant - {C,Cs,Pos1} = scan_char(Cs0, Pos), - scan1(Cs, [{char,Pos,C}|Toks], Pos1); -scan1([$'|Cs0], Toks, Pos) -> %Atom (always quoted) - {S,Cs1,Pos1} = scan_string(Cs0, $', Pos), - case catch list_to_atom(S) of - A when atom(A) -> - scan1(Cs1, [{atom,Pos,A}|Toks], Pos1); - _Error -> scan_error({illegal,atom}, Pos) - end; -scan1([$"|Cs0], Toks, Pos) -> %String - {S,Cs1,Pos1} = scan_string(Cs0, $", Pos), - scan1(Cs1, [{string,Pos,S}|Toks], Pos1); -%% Punctuation characters and operators, first recognise multiples. -scan1("->" ++ Cs, Toks, Pos) -> - scan1(Cs, [{'->',Pos}|Toks], Pos); -scan1("-|" ++ Cs, Toks, Pos) -> - scan1(Cs, [{'-|',Pos}|Toks], Pos); -scan1([C|Cs], Toks, Pos) -> %Punctuation character - P = list_to_atom([C]), - scan1(Cs, [{P,Pos}|Toks], Pos); -scan1([], Toks0, _) -> - Toks = reverse(Toks0), - {ok,Toks}. - -%% scan_key_word(FirstChar, CharList, Tokens, Pos) -%% scan_variable(FirstChar, CharList, Tokens, Pos) - -scan_key_word(C, Cs0, Toks, Pos) -> - {Wcs,Cs} = scan_name(Cs0, []), - case catch list_to_atom([C|reverse(Wcs)]) of - Name when atom(Name) -> - scan1(Cs, [{Name,Pos}|Toks], Pos); - _Error -> scan_error({illegal,atom}, Pos) - end. - -scan_variable(C, Cs0, Toks, Pos) -> - {Wcs,Cs} = scan_name(Cs0, []), - case catch list_to_atom([C|reverse(Wcs)]) of - Name when atom(Name) -> - scan1(Cs, [{var,Pos,Name}|Toks], Pos); - _Error -> scan_error({illegal,var}, Pos) - end. - -%% scan_name(Cs) -> lists:splitwith(fun (C) -> name_char(C) end, Cs). - -scan_name([C|Cs], Ncs) -> - case name_char(C) of - true -> scan_name(Cs, [C|Ncs]); - false -> {Ncs,[C|Cs]} %Must rebuild here, sigh! - end; -scan_name([], Ncs) -> - {Ncs,[]}. - -name_char(C) when C >= $a, C =< $z -> true; -name_char(C) when C >= $�, C =< $�, C /= $� -> true; -name_char(C) when C >= $A, C =< $Z -> true; -name_char(C) when C >= $�, C =< $�, C /= $� -> true; -name_char(C) when C >= $0, C =< $9 -> true; -name_char($_) -> true; -name_char($@) -> true; -name_char(_) -> false. - -%% scan_string(CharList, QuoteChar, Pos) -> {StringChars,RestChars,NewPos}. - -scan_string(Cs, Q, Pos) -> - scan_string(Cs, [], Q, Pos). - -scan_string([Q|Cs], Scs, Q, Pos) -> - {reverse(Scs),Cs,Pos}; -scan_string([$\n|Cs], Scs, Q, Pos) -> - scan_string(Cs, [$\n|Scs], Q, Pos+1); -scan_string([$\\|Cs0], Scs, Q, Pos) -> - {C,Cs,Pos1} = scan_escape(Cs0, Pos), - scan_string(Cs, [C|Scs], Q, Pos1); -scan_string([C|Cs], Scs, Q, Pos) -> - scan_string(Cs, [C|Scs], Q, Pos). - -%% scan_char(Chars, Pos) -> {Char,RestChars,NewPos}. -%% Read a single character from a character constant. The pre-scan -%% phase has checked for errors here. - -scan_char([$\\|Cs], Pos) -> - scan_escape(Cs, Pos); -scan_char([$\n|Cs], Pos) -> %Newline - {$\n,Cs,Pos+1}; -scan_char([C|Cs], Pos) -> - {C,Cs,Pos}. - -scan_escape([O1,O2,O3|Cs], Pos) when %\<1-3> octal digits - O1 >= $0, O1 =< $7, O2 >= $0, O2 =< $7, O3 >= $0, O3 =< $7 -> - Val = (O1*8 + O2)*8 + O3 - 73*$0, - {Val,Cs,Pos}; -scan_escape([O1,O2|Cs], Pos) when - O1 >= $0, O1 =< $7, O2 >= $0, O2 =< $7 -> - Val = (O1*8 + O2) - 9*$0, - {Val,Cs,Pos}; -scan_escape([O1|Cs], Pos) when - O1 >= $0, O1 =< $7 -> - {O1 - $0,Cs,Pos}; -scan_escape([$^,C|Cs], Pos) -> %\^X -> CTL-X - Val = C band 31, - {Val,Cs,Pos}; -%scan_escape([$\n,C1|Cs],Pos) -> -% {C1,Cs,Pos+1}; -%scan_escape([C,C1|Cs],Pos) when C >= $\000, C =< $\s -> -% {C1,Cs,Pos}; -scan_escape([$\n|Cs],Pos) -> - {$\n,Cs,Pos+1}; -scan_escape([C0|Cs],Pos) -> - C = escape_char(C0), - {C,Cs,Pos}. - -escape_char($n) -> $\n; %\n = LF -escape_char($r) -> $\r; %\r = CR -escape_char($t) -> $\t; %\t = TAB -escape_char($v) -> $\v; %\v = VT -escape_char($b) -> $\b; %\b = BS -escape_char($f) -> $\f; %\f = FF -escape_char($e) -> $\e; %\e = ESC -escape_char($s) -> $\s; %\s = SPC -escape_char($d) -> $\d; %\d = DEL -escape_char(C) -> C. - -%% scan_number(Char, CharList, TokenStack, Pos) -%% We can handle simple radix notation: -%% <digit>#<digits> - the digits read in that base -%% <digits> - the digits in base 10 -%% <digits>.<digits> -%% <digits>.<digits>E+-<digits> -%% -%% Except for explicitly based integers we build a list of all the -%% characters and then use list_to_integer/1 or list_to_float/1 to -%% generate the value. - -%% SPos == Start position -%% CPos == Current position - -scan_number(C, Cs0, Toks, Pos) -> - {Ncs,Cs,Pos1} = scan_integer(Cs0, [C], Pos), - scan_after_int(Cs, Ncs, Toks, Pos, Pos1). - -scan_signed_number(S, C, Cs0, Toks, Pos) -> - {Ncs,Cs,Pos1} = scan_integer(Cs0, [C,S], Pos), - scan_after_int(Cs, Ncs, Toks, Pos, Pos1). - -scan_integer([C|Cs], Stack, Pos) when C >= $0, C =< $9 -> - scan_integer(Cs, [C|Stack], Pos); -scan_integer(Cs, Stack, Pos) -> - {Stack,Cs,Pos}. - -scan_after_int([$.,C|Cs0], Ncs0, Toks, SPos, CPos) when C >= $0, C =< $9 -> - {Ncs,Cs,CPos1} = scan_integer(Cs0, [C,$.|Ncs0], CPos), - scan_after_fraction(Cs, Ncs, Toks, SPos, CPos1); -scan_after_int([$#|Cs], Ncs, Toks, SPos, CPos) -> - case list_to_integer(reverse(Ncs)) of - Base when Base >= 2, Base =< 16 -> - scan_based_int(Cs, 0, Base, Toks, SPos, CPos); - Base -> - scan_error({base,Base}, CPos) - end; -scan_after_int(Cs, Ncs, Toks, SPos, CPos) -> - N = list_to_integer(reverse(Ncs)), - scan1(Cs, [{integer,SPos,N}|Toks], CPos). - -scan_based_int([C|Cs], SoFar, Base, Toks, SPos, CPos) when - C >= $0, C =< $9, C < Base + $0 -> - Next = SoFar * Base + (C - $0), - scan_based_int(Cs, Next, Base, Toks, SPos, CPos); -scan_based_int([C|Cs], SoFar, Base, Toks, SPos, CPos) when - C >= $a, C =< $f, C < Base + $a - 10 -> - Next = SoFar * Base + (C - $a + 10), - scan_based_int(Cs, Next, Base, Toks, SPos, CPos); -scan_based_int([C|Cs], SoFar, Base, Toks, SPos, CPos) when - C >= $A, C =< $F, C < Base + $A - 10 -> - Next = SoFar * Base + (C - $A + 10), - scan_based_int(Cs, Next, Base, Toks, SPos, CPos); -scan_based_int(Cs, SoFar, _, Toks, SPos, CPos) -> - scan1(Cs, [{integer,SPos,SoFar}|Toks], CPos). - -scan_after_fraction([$E|Cs], Ncs, Toks, SPos, CPos) -> - scan_exponent(Cs, [$E|Ncs], Toks, SPos, CPos); -scan_after_fraction([$e|Cs], Ncs, Toks, SPos, CPos) -> - scan_exponent(Cs, [$E|Ncs], Toks, SPos, CPos); -scan_after_fraction(Cs, Ncs, Toks, SPos, CPos) -> - case catch list_to_float(reverse(Ncs)) of - N when float(N) -> - scan1(Cs, [{float,SPos,N}|Toks], CPos); - _Error -> scan_error({illegal,float}, SPos) - end. - -%% scan_exponent(CharList, NumberCharStack, TokenStack, StartPos, CurPos) -%% Generate an error here if E{+|-} not followed by any digits. - -scan_exponent([$+|Cs], Ncs, Toks, SPos, CPos) -> - scan_exponent1(Cs, [$+|Ncs], Toks, SPos, CPos); -scan_exponent([$-|Cs], Ncs, Toks, SPos, CPos) -> - scan_exponent1(Cs, [$-|Ncs], Toks, SPos, CPos); -scan_exponent(Cs, Ncs, Toks, SPos, CPos) -> - scan_exponent1(Cs, Ncs, Toks, SPos, CPos). - -scan_exponent1([C|Cs0], Ncs0, Toks, SPos, CPos) when C >= $0, C =< $9 -> - {Ncs,Cs,CPos1} = scan_integer(Cs0, [C|Ncs0], CPos), - case catch list_to_float(reverse(Ncs)) of - N when float(N) -> - scan1(Cs, [{float,SPos,N}|Toks], CPos1); - _Error -> scan_error({illegal,float}, SPos) - end; -scan_exponent1(_, _, _, _, CPos) -> - scan_error(float, CPos). - -scan_error(In, Pos) -> - {error,{Pos,core_scan,In}}. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/erl_bifs.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/erl_bifs.erl deleted file mode 100644 index 088f44f9fd..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/erl_bifs.erl +++ /dev/null @@ -1,486 +0,0 @@ -%% ``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 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. -%% -%% 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: erl_bifs.erl,v 1.2 2009/09/17 09:46:19 kostis Exp $ -%% -%% Purpose: Information about the Erlang built-in functions. - --module(erl_bifs). - --export([is_bif/3, is_guard_bif/3, is_pure/3, is_safe/3]). - - -%% ===================================================================== -%% is_bif(Module, Name, Arity) -> boolean() -%% -%% Module = Name = atom() -%% Arity = integer() -%% -%% Returns `true' if the function `Module:Name/Arity' is a Built-In -%% Function (BIF) of Erlang. BIFs "come with the implementation", -%% and can be assumed to exist and have the same behaviour in any -%% later versions of the same implementation of the language. Being -%% a BIF does *not* imply that the function belongs to the module -%% `erlang', nor that it is implemented in C or assembler (cf. -%% `erlang:is_builtin/3'), or that it is auto-imported by the -%% compiler (cf. `erl_internal:bif/3'). - -is_bif(erlang, '!', 2) -> true; -is_bif(erlang, '*', 2) -> true; -is_bif(erlang, '+', 1) -> true; -is_bif(erlang, '+', 2) -> true; -is_bif(erlang, '++', 2) -> true; -is_bif(erlang, '-', 1) -> true; -is_bif(erlang, '-', 2) -> true; -is_bif(erlang, '--', 2) -> true; -is_bif(erlang, '/', 2) -> true; -is_bif(erlang, '/=', 2) -> true; -is_bif(erlang, '<', 2) -> true; -is_bif(erlang, '=/=', 2) -> true; -is_bif(erlang, '=:=', 2) -> true; -is_bif(erlang, '=<', 2) -> true; -is_bif(erlang, '==', 2) -> true; -is_bif(erlang, '>', 2) -> true; -is_bif(erlang, '>=', 2) -> true; -is_bif(erlang, 'and', 2) -> true; -is_bif(erlang, 'band', 2) -> true; -is_bif(erlang, 'bnot', 1) -> true; -is_bif(erlang, 'bor', 2) -> true; -is_bif(erlang, 'bsl', 2) -> true; -is_bif(erlang, 'bsr', 2) -> true; -is_bif(erlang, 'bxor', 2) -> true; -is_bif(erlang, 'div', 2) -> true; -is_bif(erlang, 'not', 1) -> true; -is_bif(erlang, 'or', 2) -> true; -is_bif(erlang, 'rem', 2) -> true; -is_bif(erlang, 'xor', 2) -> true; -is_bif(erlang, abs, 1) -> true; -is_bif(erlang, append_element, 2) -> true; -is_bif(erlang, apply, 2) -> true; -is_bif(erlang, apply, 3) -> true; -is_bif(erlang, atom_to_list, 1) -> true; -is_bif(erlang, binary_to_list, 1) -> true; -is_bif(erlang, binary_to_list, 3) -> true; -is_bif(erlang, binary_to_term, 1) -> true; -is_bif(erlang, cancel_timer, 1) -> true; -is_bif(erlang, concat_binary, 1) -> true; -is_bif(erlang, date, 0) -> true; -is_bif(erlang, demonitor, 1) -> true; -is_bif(erlang, disconnect_node, 1) -> true; -is_bif(erlang, display, 1) -> true; -is_bif(erlang, element, 2) -> true; -is_bif(erlang, erase, 0) -> true; -is_bif(erlang, erase, 1) -> true; -is_bif(erlang, error, 1) -> true; -is_bif(erlang, error, 2) -> true; -is_bif(erlang, exit, 1) -> true; -is_bif(erlang, exit, 2) -> true; -is_bif(erlang, fault, 1) -> true; -is_bif(erlang, fault, 2) -> true; -is_bif(erlang, float, 1) -> true; -is_bif(erlang, float_to_list, 1) -> true; -is_bif(erlang, fun_info, 1) -> true; -is_bif(erlang, fun_info, 2) -> true; -is_bif(erlang, fun_to_list, 1) -> true; -is_bif(erlang, get, 0) -> true; -is_bif(erlang, get, 1) -> true; -is_bif(erlang, get_cookie, 0) -> true; -is_bif(erlang, get_keys, 1) -> true; -is_bif(erlang, group_leader, 0) -> true; -is_bif(erlang, group_leader, 2) -> true; -is_bif(erlang, halt, 0) -> false; -is_bif(erlang, halt, 1) -> false; -is_bif(erlang, hash, 2) -> false; -is_bif(erlang, hd, 1) -> true; -is_bif(erlang, info, 1) -> true; -is_bif(erlang, integer_to_list, 1) -> true; -is_bif(erlang, is_alive, 0) -> true; -is_bif(erlang, is_atom, 1) -> true; -is_bif(erlang, is_binary, 1) -> true; -is_bif(erlang, is_boolean, 1) -> true; -is_bif(erlang, is_builtin, 3) -> true; -is_bif(erlang, is_constant, 1) -> true; -is_bif(erlang, is_float, 1) -> true; -is_bif(erlang, is_function, 1) -> true; -is_bif(erlang, is_integer, 1) -> true; -is_bif(erlang, is_list, 1) -> true; -is_bif(erlang, is_number, 1) -> true; -is_bif(erlang, is_pid, 1) -> true; -is_bif(erlang, is_port, 1) -> true; -is_bif(erlang, is_process_alive, 1) -> true; -is_bif(erlang, is_record, 3) -> true; -is_bif(erlang, is_reference, 1) -> true; -is_bif(erlang, is_tuple, 1) -> true; -is_bif(erlang, length, 1) -> true; -is_bif(erlang, link, 1) -> true; -is_bif(erlang, list_to_atom, 1) -> true; -is_bif(erlang, list_to_binary, 1) -> true; -is_bif(erlang, list_to_float, 1) -> true; -is_bif(erlang, list_to_integer, 1) -> true; -is_bif(erlang, list_to_pid, 1) -> true; -is_bif(erlang, list_to_tuple, 1) -> true; -is_bif(erlang, loaded, 0) -> true; -is_bif(erlang, localtime, 0) -> true; -is_bif(erlang, localtime_to_universaltime, 1) -> true; -is_bif(erlang, make_ref, 0) -> true; -is_bif(erlang, make_tuple, 2) -> true; -is_bif(erlang, md5, 1) -> true; -is_bif(erlang, md5_final, 1) -> true; -is_bif(erlang, md5_init, 0) -> true; -is_bif(erlang, md5_update, 2) -> true; -is_bif(erlang, monitor, 2) -> true; -is_bif(erlang, monitor_node, 2) -> true; -is_bif(erlang, node, 0) -> true; -is_bif(erlang, node, 1) -> true; -is_bif(erlang, nodes, 0) -> true; -is_bif(erlang, now, 0) -> true; -is_bif(erlang, open_port, 2) -> true; -is_bif(erlang, phash, 2) -> true; -is_bif(erlang, pid_to_list, 1) -> true; -is_bif(erlang, port_close, 2) -> true; -is_bif(erlang, port_command, 2) -> true; -is_bif(erlang, port_connect, 2) -> true; -is_bif(erlang, port_control, 3) -> true; -is_bif(erlang, port_info, 2) -> true; -is_bif(erlang, port_to_list, 1) -> true; -is_bif(erlang, ports, 0) -> true; -is_bif(erlang, pre_loaded, 0) -> true; -is_bif(erlang, process_display, 2) -> true; -is_bif(erlang, process_flag, 2) -> true; -is_bif(erlang, process_flag, 3) -> true; -is_bif(erlang, process_info, 1) -> true; -is_bif(erlang, process_info, 2) -> true; -is_bif(erlang, processes, 0) -> true; -is_bif(erlang, put, 2) -> true; -is_bif(erlang, read_timer, 1) -> true; -is_bif(erlang, ref_to_list, 1) -> true; -is_bif(erlang, register, 2) -> true; -is_bif(erlang, registered, 0) -> true; -is_bif(erlang, resume_process, 1) -> true; -is_bif(erlang, round, 1) -> true; -is_bif(erlang, self, 0) -> true; -is_bif(erlang, send_after, 3) -> true; -is_bif(erlang, set_cookie, 2) -> true; -is_bif(erlang, setelement, 3) -> true; -is_bif(erlang, size, 1) -> true; -is_bif(erlang, spawn, 1) -> true; -is_bif(erlang, spawn, 2) -> true; -is_bif(erlang, spawn, 3) -> true; -is_bif(erlang, spawn, 4) -> true; -is_bif(erlang, spawn_link, 1) -> true; -is_bif(erlang, spawn_link, 2) -> true; -is_bif(erlang, spawn_link, 3) -> true; -is_bif(erlang, spawn_link, 4) -> true; -is_bif(erlang, spawn_opt, 4) -> true; -is_bif(erlang, split_binary, 2) -> true; -is_bif(erlang, start_timer, 3) -> true; -is_bif(erlang, statistics, 1) -> true; -is_bif(erlang, suspend_process, 1) -> true; -is_bif(erlang, system_flag, 2) -> true; -is_bif(erlang, system_info, 1) -> true; -is_bif(erlang, term_to_binary, 1) -> true; -is_bif(erlang, term_to_binary, 2) -> true; -is_bif(erlang, throw, 1) -> true; -is_bif(erlang, time, 0) -> true; -is_bif(erlang, tl, 1) -> true; -is_bif(erlang, trace, 3) -> true; -is_bif(erlang, trace_info, 2) -> true; -is_bif(erlang, trace_pattern, 2) -> true; -is_bif(erlang, trace_pattern, 3) -> true; -is_bif(erlang, trunc, 1) -> true; -is_bif(erlang, tuple_to_list, 1) -> true; -is_bif(erlang, universaltime, 0) -> true; -is_bif(erlang, universaltime_to_localtime, 1) -> true; -is_bif(erlang, unlink, 1) -> true; -is_bif(erlang, unregister, 1) -> true; -is_bif(erlang, whereis, 1) -> true; -is_bif(erlang, yield, 0) -> true; -is_bif(lists, append, 2) -> true; -is_bif(lists, reverse, 1) -> true; -is_bif(lists, reverse, 2) -> true; -is_bif(lists, subtract, 2) -> true; -is_bif(math, acos, 1) -> true; -is_bif(math, acosh, 1) -> true; -is_bif(math, asin, 1) -> true; -is_bif(math, asinh, 1) -> true; -is_bif(math, atan, 1) -> true; -is_bif(math, atan2, 2) -> true; -is_bif(math, atanh, 1) -> true; -is_bif(math, cos, 1) -> true; -is_bif(math, cosh, 1) -> true; -is_bif(math, erf, 1) -> true; -is_bif(math, erfc, 1) -> true; -is_bif(math, exp, 1) -> true; -is_bif(math, log, 1) -> true; -is_bif(math, log10, 1) -> true; -is_bif(math, pow, 2) -> true; -is_bif(math, sin, 1) -> true; -is_bif(math, sinh, 1) -> true; -is_bif(math, sqrt, 1) -> true; -is_bif(math, tan, 1) -> true; -is_bif(math, tanh, 1) -> true; -is_bif(_, _, _) -> false. - - -%% ===================================================================== -%% is_guard_bif(Module, Name, Arity) -> boolean() -%% -%% Module = Name = atom() -%% Arity = integer() -%% -%% Returns `true' if the built-in function `Module:Name/Arity' may -%% be called from a clause guard. Note that such "guard BIFs" are -%% not necessarily "pure", since some (notably `erlang:self/0') may -%% depend on the current state, nor "safe", since many guard BIFs -%% can fail. Also note that even a "pure" function could be -%% unsuitable for calling from a guard because of its time or space -%% complexity. - -is_guard_bif(erlang, '*', 2) -> true; -is_guard_bif(erlang, '+', 1) -> true; -is_guard_bif(erlang, '+', 2) -> true; -is_guard_bif(erlang, '-', 1) -> true; -is_guard_bif(erlang, '-', 2) -> true; -is_guard_bif(erlang, '/', 2) -> true; -is_guard_bif(erlang, '/=', 2) -> true; -is_guard_bif(erlang, '<', 2) -> true; -is_guard_bif(erlang, '=/=', 2) -> true; -is_guard_bif(erlang, '=:=', 2) -> true; -is_guard_bif(erlang, '=<', 2) -> true; -is_guard_bif(erlang, '==', 2) -> true; -is_guard_bif(erlang, '>', 2) -> true; -is_guard_bif(erlang, '>=', 2) -> true; -is_guard_bif(erlang, 'and', 2) -> true; -is_guard_bif(erlang, 'band', 2) -> true; -is_guard_bif(erlang, 'bnot', 1) -> true; -is_guard_bif(erlang, 'bor', 2) -> true; -is_guard_bif(erlang, 'bsl', 2) -> true; -is_guard_bif(erlang, 'bsr', 2) -> true; -is_guard_bif(erlang, 'bxor', 2) -> true; -is_guard_bif(erlang, 'div', 2) -> true; -is_guard_bif(erlang, 'not', 1) -> true; -is_guard_bif(erlang, 'or', 2) -> true; -is_guard_bif(erlang, 'rem', 2) -> true; -is_guard_bif(erlang, 'xor', 2) -> true; -is_guard_bif(erlang, abs, 1) -> true; -is_guard_bif(erlang, element, 2) -> true; -is_guard_bif(erlang, error, 1) -> true; % unorthodox -is_guard_bif(erlang, exit, 1) -> true; % unorthodox -is_guard_bif(erlang, fault, 1) -> true; % unorthodox -is_guard_bif(erlang, float, 1) -> true; % (the type coercion function) -is_guard_bif(erlang, hd, 1) -> true; -is_guard_bif(erlang, is_atom, 1) -> true; -is_guard_bif(erlang, is_boolean, 1) -> true; -is_guard_bif(erlang, is_binary, 1) -> true; -is_guard_bif(erlang, is_constant, 1) -> true; -is_guard_bif(erlang, is_float, 1) -> true; -is_guard_bif(erlang, is_function, 1) -> true; -is_guard_bif(erlang, is_integer, 1) -> true; -is_guard_bif(erlang, is_list, 1) -> true; -is_guard_bif(erlang, is_number, 1) -> true; -is_guard_bif(erlang, is_pid, 1) -> true; -is_guard_bif(erlang, is_port, 1) -> true; -is_guard_bif(erlang, is_reference, 1) -> true; -is_guard_bif(erlang, is_tuple, 1) -> true; -is_guard_bif(erlang, length, 1) -> true; -is_guard_bif(erlang, list_to_atom, 1) -> true; % unorthodox -is_guard_bif(erlang, node, 0) -> true; % (not pure) -is_guard_bif(erlang, node, 1) -> true; % (not pure) -is_guard_bif(erlang, round, 1) -> true; -is_guard_bif(erlang, self, 0) -> true; % (not pure) -is_guard_bif(erlang, size, 1) -> true; -is_guard_bif(erlang, throw, 1) -> true; % unorthodox -is_guard_bif(erlang, tl, 1) -> true; -is_guard_bif(erlang, trunc, 1) -> true; -is_guard_bif(math, acos, 1) -> true; % unorthodox -is_guard_bif(math, acosh, 1) -> true; % unorthodox -is_guard_bif(math, asin, 1) -> true; % unorthodox -is_guard_bif(math, asinh, 1) -> true; % unorthodox -is_guard_bif(math, atan, 1) -> true; % unorthodox -is_guard_bif(math, atan2, 2) -> true; % unorthodox -is_guard_bif(math, atanh, 1) -> true; % unorthodox -is_guard_bif(math, cos, 1) -> true; % unorthodox -is_guard_bif(math, cosh, 1) -> true; % unorthodox -is_guard_bif(math, erf, 1) -> true; % unorthodox -is_guard_bif(math, erfc, 1) -> true; % unorthodox -is_guard_bif(math, exp, 1) -> true; % unorthodox -is_guard_bif(math, log, 1) -> true; % unorthodox -is_guard_bif(math, log10, 1) -> true; % unorthodox -is_guard_bif(math, pow, 2) -> true; % unorthodox -is_guard_bif(math, sin, 1) -> true; % unorthodox -is_guard_bif(math, sinh, 1) -> true; % unorthodox -is_guard_bif(math, sqrt, 1) -> true; % unorthodox -is_guard_bif(math, tan, 1) -> true; % unorthodox -is_guard_bif(math, tanh, 1) -> true; % unorthodox -is_guard_bif(_, _, _) -> false. - - -%% ===================================================================== -%% is_pure(Module, Name, Arity) -> boolean() -%% -%% Module = Name = atom() -%% Arity = integer() -%% -%% Returns `true' if the function `Module:Name/Arity' does not -%% affect the state, nor depend on the state, although its -%% evaluation is not guaranteed to complete normally for all input. - -is_pure(erlang, '*', 2) -> true; -is_pure(erlang, '+', 1) -> true; % (even for non-numbers) -is_pure(erlang, '+', 2) -> true; -is_pure(erlang, '++', 2) -> true; -is_pure(erlang, '-', 1) -> true; -is_pure(erlang, '-', 2) -> true; -is_pure(erlang, '--', 2) -> true; -is_pure(erlang, '/', 2) -> true; -is_pure(erlang, '/=', 2) -> true; -is_pure(erlang, '<', 2) -> true; -is_pure(erlang, '=/=', 2) -> true; -is_pure(erlang, '=:=', 2) -> true; -is_pure(erlang, '=<', 2) -> true; -is_pure(erlang, '==', 2) -> true; -is_pure(erlang, '>', 2) -> true; -is_pure(erlang, '>=', 2) -> true; -is_pure(erlang, 'and', 2) -> true; -is_pure(erlang, 'band', 2) -> true; -is_pure(erlang, 'bnot', 1) -> true; -is_pure(erlang, 'bor', 2) -> true; -is_pure(erlang, 'bsl', 2) -> true; -is_pure(erlang, 'bsr', 2) -> true; -is_pure(erlang, 'bxor', 2) -> true; -is_pure(erlang, 'div', 2) -> true; -is_pure(erlang, 'not', 1) -> true; -is_pure(erlang, 'or', 2) -> true; -is_pure(erlang, 'rem', 2) -> true; -is_pure(erlang, 'xor', 2) -> true; -is_pure(erlang, abs, 1) -> true; -is_pure(erlang, atom_to_list, 1) -> true; -is_pure(erlang, binary_to_list, 1) -> true; -is_pure(erlang, binary_to_list, 3) -> true; -is_pure(erlang, concat_binary, 1) -> true; -is_pure(erlang, element, 2) -> true; -is_pure(erlang, float, 1) -> true; -is_pure(erlang, float_to_list, 1) -> true; -is_pure(erlang, hash, 2) -> false; -is_pure(erlang, hd, 1) -> true; -is_pure(erlang, integer_to_list, 1) -> true; -is_pure(erlang, is_atom, 1) -> true; -is_pure(erlang, is_boolean, 1) -> true; -is_pure(erlang, is_binary, 1) -> true; -is_pure(erlang, is_builtin, 3) -> true; -is_pure(erlang, is_constant, 1) -> true; -is_pure(erlang, is_float, 1) -> true; -is_pure(erlang, is_function, 1) -> true; -is_pure(erlang, is_integer, 1) -> true; -is_pure(erlang, is_list, 1) -> true; -is_pure(erlang, is_number, 1) -> true; -is_pure(erlang, is_pid, 1) -> true; -is_pure(erlang, is_port, 1) -> true; -is_pure(erlang, is_record, 3) -> true; -is_pure(erlang, is_reference, 1) -> true; -is_pure(erlang, is_tuple, 1) -> true; -is_pure(erlang, length, 1) -> true; -is_pure(erlang, list_to_atom, 1) -> true; -is_pure(erlang, list_to_binary, 1) -> true; -is_pure(erlang, list_to_float, 1) -> true; -is_pure(erlang, list_to_integer, 1) -> true; -is_pure(erlang, list_to_pid, 1) -> true; -is_pure(erlang, list_to_tuple, 1) -> true; -is_pure(erlang, phash, 2) -> false; -is_pure(erlang, pid_to_list, 1) -> true; -is_pure(erlang, round, 1) -> true; -is_pure(erlang, setelement, 3) -> true; -is_pure(erlang, size, 1) -> true; -is_pure(erlang, split_binary, 2) -> true; -is_pure(erlang, term_to_binary, 1) -> true; -is_pure(erlang, tl, 1) -> true; -is_pure(erlang, trunc, 1) -> true; -is_pure(erlang, tuple_to_list, 1) -> true; -is_pure(lists, append, 2) -> true; -is_pure(lists, subtract, 2) -> true; -is_pure(math, acos, 1) -> true; -is_pure(math, acosh, 1) -> true; -is_pure(math, asin, 1) -> true; -is_pure(math, asinh, 1) -> true; -is_pure(math, atan, 1) -> true; -is_pure(math, atan2, 2) -> true; -is_pure(math, atanh, 1) -> true; -is_pure(math, cos, 1) -> true; -is_pure(math, cosh, 1) -> true; -is_pure(math, erf, 1) -> true; -is_pure(math, erfc, 1) -> true; -is_pure(math, exp, 1) -> true; -is_pure(math, log, 1) -> true; -is_pure(math, log10, 1) -> true; -is_pure(math, pow, 2) -> true; -is_pure(math, sin, 1) -> true; -is_pure(math, sinh, 1) -> true; -is_pure(math, sqrt, 1) -> true; -is_pure(math, tan, 1) -> true; -is_pure(math, tanh, 1) -> true; -is_pure(_, _, _) -> false. - - -%% ===================================================================== -%% is_safe(Module, Name, Arity) -> boolean() -%% -%% Module = Name = atom() -%% Arity = integer() -%% -%% Returns `true' if the function `Module:Name/Arity' is completely -%% effect free, i.e., if its evaluation always completes normally -%% and does not affect the state (although the value it returns -%% might depend on the state). - -is_safe(erlang, '/=', 2) -> true; -is_safe(erlang, '<', 2) -> true; -is_safe(erlang, '=/=', 2) -> true; -is_safe(erlang, '=:=', 2) -> true; -is_safe(erlang, '=<', 2) -> true; -is_safe(erlang, '==', 2) -> true; -is_safe(erlang, '>', 2) -> true; -is_safe(erlang, '>=', 2) -> true; -is_safe(erlang, date, 0) -> true; -is_safe(erlang, get, 0) -> true; -is_safe(erlang, get, 1) -> true; -is_safe(erlang, get_cookie, 0) -> true; -is_safe(erlang, get_keys, 1) -> true; -is_safe(erlang, group_leader, 0) -> true; -is_safe(erlang, is_alive, 0) -> true; -is_safe(erlang, is_atom, 1) -> true; -is_safe(erlang, is_boolean, 1) -> true; -is_safe(erlang, is_binary, 1) -> true; -is_safe(erlang, is_constant, 1) -> true; -is_safe(erlang, is_float, 1) -> true; -is_safe(erlang, is_function, 1) -> true; -is_safe(erlang, is_integer, 1) -> true; -is_safe(erlang, is_list, 1) -> true; -is_safe(erlang, is_number, 1) -> true; -is_safe(erlang, is_pid, 1) -> true; -is_safe(erlang, is_port, 1) -> true; -is_safe(erlang, is_record, 3) -> true; -is_safe(erlang, is_reference, 1) -> true; -is_safe(erlang, is_tuple, 1) -> true; -is_safe(erlang, make_ref, 0) -> true; -is_safe(erlang, node, 0) -> true; -is_safe(erlang, nodes, 0) -> true; -is_safe(erlang, ports, 0) -> true; -is_safe(erlang, pre_loaded, 0) -> true; -is_safe(erlang, processes, 0) -> true; -is_safe(erlang, registered, 0) -> true; -is_safe(erlang, self, 0) -> true; -is_safe(erlang, term_to_binary, 1) -> true; -is_safe(erlang, time, 0) -> true; -is_safe(_, _, _) -> false. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/rec_env.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/rec_env.erl deleted file mode 100644 index 0dd31b71ea..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/rec_env.erl +++ /dev/null @@ -1,611 +0,0 @@ -%% ===================================================================== -%% This library is free software; you can redistribute it and/or modify -%% it under the terms of the GNU Lesser General Public License as -%% published by the Free Software Foundation; either version 2 of the -%% License, or (at your option) any later version. -%% -%% This library is distributed in the hope that it will be useful, but -%% WITHOUT ANY WARRANTY; without even the implied warranty of -%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -%% Lesser General Public License for more details. -%% -%% You should have received a copy of the GNU Lesser General Public -%% License along with this library; if not, write to the Free Software -%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 -%% USA -%% -%% $Id: rec_env.erl,v 1.2 2009/09/17 09:46:19 kostis Exp $ -%% -%% @author Richard Carlsson <[email protected]> -%% @copyright 1999-2004 Richard Carlsson -%% @doc Abstract environments, supporting self-referential bindings and -%% automatic new-key generation. - -%% The current implementation is based on Erlang standard library -%% dictionaries. - -%%% -define(DEBUG, true). - --module(rec_env). - --export([bind/3, bind_list/3, bind_recursive/4, delete/2, empty/0, - get/2, is_defined/2, is_empty/1, keys/1, lookup/2, new_key/1, - new_key/2, new_keys/2, new_keys/3, size/1, to_list/1]). - --ifdef(DEBUG). --export([test/1, test_custom/1, test_custom/2]). --endif. - --ifdef(DEBUG). -%% Code for testing: -%%@hidden -test(N) -> - test_0(integer, N). - -%%@hidden -test_custom(N) -> - F = fun (X) -> list_to_atom("X"++integer_to_list(X)) end, - test_custom(F, N). - -%%@hidden -test_custom(F, N) -> - test_0({custom, F}, N). - -test_0(Type, N) -> - put(new_key_calls, 0), - put(new_key_retries, 0), - put(new_key_max, 0), - Env = test_1(Type, N, empty()), - io:fwrite("\ncalls: ~w.\n", [get(new_key_calls)]), - io:fwrite("\nretries: ~w.\n", [get(new_key_retries)]), - io:fwrite("\nmax: ~w.\n", [get(new_key_max)]), - dict:to_list(element(1,Env)). - -test_1(integer = Type, N, Env) when integer(N), N > 0 -> - Key = new_key(Env), - test_1(Type, N - 1, bind(Key, value, Env)); -test_1({custom, F} = Type, N, Env) when integer(N), N > 0 -> - Key = new_key(F, Env), - test_1(Type, N - 1, bind(Key, value, Env)); -test_1(_,0, Env) -> - Env. --endif. - - -%% Representation: -%% -%% environment() = [Mapping] -%% -%% Mapping = {map, Dict} | {rec, Dict, Dict} -%% Dict = dict:dictionary() -%% -%% An empty environment is a list containing a single `{map, Dict}' -%% element - empty lists are not valid environments. To find a key in an -%% environment, it is searched for in each mapping in the list, in -%% order, until it the key is found in some mapping, or the end of the -%% list is reached. In a 'rec' mapping, we keep the original dictionary -%% together with a version where entries may have been deleted - this -%% makes it possible to garbage collect the entire 'rec' mapping when -%% all its entries are unused (for example, by being shadowed by later -%% definitions). - - - -%% ===================================================================== -%% @type environment(). An abstract environment. - - -%% ===================================================================== -%% @spec empty() -> environment() -%% -%% @doc Returns an empty environment. - -empty() -> - [{map, dict:new()}]. - - -%% ===================================================================== -%% @spec is_empty(Env::environment()) -> boolean() -%% -%% @doc Returns <code>true</code> if the environment is empty, otherwise -%% <code>false</code>. - -is_empty([{map, Dict} | Es]) -> - N = dict:size(Dict), - if N /= 0 -> false; - Es == [] -> true; - true -> is_empty(Es) - end; -is_empty([{rec, Dict, _} | Es]) -> - N = dict:size(Dict), - if N /= 0 -> false; - Es == [] -> true; - true -> is_empty(Es) - end. - - -%% ===================================================================== -%% @spec size(Env::environment()) -> integer() -%% -%% @doc Returns the number of entries in an environment. - -%% (The name 'size' cannot be used in local calls, since there exists a -%% built-in function with the same name.) - -size(Env) -> - env_size(Env). - -env_size([{map, Dict}]) -> - dict:size(Dict); -env_size([{map, Dict} | Env]) -> - dict:size(Dict) + env_size(Env); -env_size([{rec, Dict, _Dict0} | Env]) -> - dict:size(Dict) + env_size(Env). - - -%% ===================================================================== -%% @spec is_defined(Key, Env) -> boolean() -%% -%% Key = term() -%% Env = environment() -%% -%% @doc Returns <code>true</code> if <code>Key</code> is bound in the -%% environment, otherwise <code>false</code>. - -is_defined(Key, [{map, Dict} | Env]) -> - case dict:is_key(Key, Dict) of - true -> - true; - false when Env == [] -> - false; - false -> - is_defined(Key, Env) - end; -is_defined(Key, [{rec, Dict, _Dict0} | Env]) -> - case dict:is_key(Key, Dict) of - true -> - true; - false -> - is_defined(Key, Env) - end. - - -%% ===================================================================== -%% @spec keys(Env::environment()) -> [term()] -%% -%% @doc Returns the ordered list of all keys in the environment. - -keys(Env) -> - lists:sort(keys(Env, [])). - -keys([{map, Dict}], S) -> - dict:fetch_keys(Dict) ++ S; -keys([{map, Dict} | Env], S) -> - keys(Env, dict:fetch_keys(Dict) ++ S); -keys([{rec, Dict, _Dict0} | Env], S) -> - keys(Env, dict:fetch_keys(Dict) ++ S). - - -%% ===================================================================== -%% @spec to_list(Env) -> [{Key, Value}] -%% -%% Env = environment() -%% Key = term() -%% Value = term() -%% -%% @doc Returns an ordered list of <code>{Key, Value}</code> pairs for -%% all keys in <code>Env</code>. <code>Value</code> is the same as that -%% returned by {@link get/2}. - -to_list(Env) -> - lists:sort(to_list(Env, [])). - -to_list([{map, Dict}], S) -> - dict:to_list(Dict) ++ S; -to_list([{map, Dict} | Env], S) -> - to_list(Env, dict:to_list(Dict) ++ S); -to_list([{rec, Dict, _Dict0} | Env], S) -> - to_list(Env, dict:to_list(Dict) ++ S). - - -%% ===================================================================== -%% @spec bind(Key, Value, Env) -> environment() -%% -%% Key = term() -%% Value = term() -%% Env = environment() -%% -%% @doc Make a nonrecursive entry. This binds <code>Key</code> to -%% <code>Value</code>. If the key already existed in the environment, -%% the old entry is replaced. - -%% Note that deletion is done to free old bindings so they can be -%% garbage collected. - -bind(Key, Value, [{map, Dict}]) -> - [{map, dict:store(Key, Value, Dict)}]; -bind(Key, Value, [{map, Dict} | Env]) -> - [{map, dict:store(Key, Value, Dict)} | delete_any(Key, Env)]; -bind(Key, Value, Env) -> - [{map, dict:store(Key, Value, dict:new())} | delete_any(Key, Env)]. - - -%% ===================================================================== -%% @spec bind_list(Keys, Values, Env) -> environment() -%% -%% Keys = [term()] -%% Values = [term()] -%% Env = environment() -%% -%% @doc Make N nonrecursive entries. This binds each key in -%% <code>Keys</code> to the corresponding value in -%% <code>Values</code>. If some key already existed in the environment, -%% the previous entry is replaced. If <code>Keys</code> does not have -%% the same length as <code>Values</code>, an exception is generated. - -bind_list(Ks, Vs, [{map, Dict}]) -> - [{map, store_list(Ks, Vs, Dict)}]; -bind_list(Ks, Vs, [{map, Dict} | Env]) -> - [{map, store_list(Ks, Vs, Dict)} | delete_list(Ks, Env)]; -bind_list(Ks, Vs, Env) -> - [{map, store_list(Ks, Vs, dict:new())} | delete_list(Ks, Env)]. - -store_list([K | Ks], [V | Vs], Dict) -> - store_list(Ks, Vs, dict:store(K, V, Dict)); -store_list([], _, Dict) -> - Dict. - -delete_list([K | Ks], Env) -> - delete_list(Ks, delete_any(K, Env)); -delete_list([], Env) -> - Env. - -%% By not calling `delete' unless we have to, we avoid unnecessary -%% rewriting of the data. - -delete_any(Key, Env) -> - case is_defined(Key, Env) of - true -> - delete(Key, Env); - false -> - Env - end. - -%% ===================================================================== -%% @spec delete(Key, Env) -> environment() -%% -%% Key = term() -%% Env = environment() -%% -%% @doc Delete an entry. This removes <code>Key</code> from the -%% environment. - -delete(Key, [{map, Dict} = E | Env]) -> - case dict:is_key(Key, Dict) of - true -> - [{map, dict:erase(Key, Dict)} | Env]; - false -> - delete_1(Key, Env, E) - end; -delete(Key, [{rec, Dict, Dict0} = E | Env]) -> - case dict:is_key(Key, Dict) of - true -> - %% The Dict0 component must be preserved as it is until all - %% keys in Dict have been deleted. - Dict1 = dict:erase(Key, Dict), - case dict:size(Dict1) of - 0 -> - Env; % the whole {rec,...} is now garbage - _ -> - [{rec, Dict1, Dict0} | Env] - end; - false -> - [E | delete(Key, Env)] - end. - -%% This is just like above, except we pass on the preceding 'map' -%% mapping in the list to enable merging when removing 'rec' mappings. - -delete_1(Key, [{rec, Dict, Dict0} = E | Env], E1) -> - case dict:is_key(Key, Dict) of - true -> - Dict1 = dict:erase(Key, Dict), - case dict:size(Dict1) of - 0 -> - concat(E1, Env); - _ -> - [E1, {rec, Dict1, Dict0} | Env] - end; - false -> - [E1, E | delete(Key, Env)] - end. - -concat({map, D1}, [{map, D2} | Env]) -> - [dict:merge(fun (_K, V1, _V2) -> V1 end, D1, D2) | Env]; -concat(E1, Env) -> - [E1 | Env]. - - -%% ===================================================================== -%% @spec bind_recursive(Keys, Values, Fun, Env) -> NewEnv -%% -%% Keys = [term()] -%% Values = [term()] -%% Fun = (Value, Env) -> term() -%% Env = environment() -%% NewEnv = environment() -%% -%% @doc Make N recursive entries. This binds each key in -%% <code>Keys</code> to the value of <code>Fun(Value, NewEnv)</code> for -%% the corresponding <code>Value</code>. If <code>Keys</code> does not -%% have the same length as <code>Values</code>, an exception is -%% generated. If some key already existed in the environment, the old -%% entry is replaced. -%% -%% <p>Note: the function <code>Fun</code> is evaluated each time one of -%% the stored keys is looked up, but only then.</p> -%% -%% <p>Examples: -%%<pre> -%% NewEnv = bind_recursive([foo, bar], [1, 2], -%% fun (V, E) -> V end, -%% Env)</pre> -%% -%% This does nothing interesting; <code>get(foo, NewEnv)</code> yields -%% <code>1</code> and <code>get(bar, NewEnv)</code> yields -%% <code>2</code>, but there is more overhead than if the {@link -%% bind_list/3} function had been used. -%% -%% <pre> -%% NewEnv = bind_recursive([foo, bar], [1, 2], -%% fun (V, E) -> {V, E} end, -%% Env)</pre> -%% -%% Here, however, <code>get(foo, NewEnv)</code> will yield <code>{1, -%% NewEnv}</code> and <code>get(bar, NewEnv)</code> will yield <code>{2, -%% NewEnv}</code>, i.e., the environment <code>NewEnv</code> contains -%% recursive bindings.</p> - -bind_recursive([], [], _, Env) -> - Env; -bind_recursive(Ks, Vs, F, Env) -> - F1 = fun (V) -> - fun (Dict) -> F(V, [{rec, Dict, Dict} | Env]) end - end, - Dict = bind_recursive_1(Ks, Vs, F1, dict:new()), - [{rec, Dict, Dict} | Env]. - -bind_recursive_1([K | Ks], [V | Vs], F, Dict) -> - bind_recursive_1(Ks, Vs, F, dict:store(K, F(V), Dict)); -bind_recursive_1([], [], _, Dict) -> - Dict. - - -%% ===================================================================== -%% @spec lookup(Key, Env) -> error | {ok, Value} -%% -%% Key = term() -%% Env = environment() -%% Value = term() -%% -%% @doc Returns <code>{ok, Value}</code> if <code>Key</code> is bound to -%% <code>Value</code> in <code>Env</code>, and <code>error</code> -%% otherwise. - -lookup(Key, [{map, Dict} | Env]) -> - case dict:find(Key, Dict) of - {ok, _}=Value -> - Value; - error when Env == [] -> - error; - error -> - lookup(Key, Env) - end; -lookup(Key, [{rec, Dict, Dict0} | Env]) -> - case dict:find(Key, Dict) of - {ok, F} -> - {ok, F(Dict0)}; - error -> - lookup(Key, Env) - end. - - -%% ===================================================================== -%% @spec get(Key, Env) -> Value -%% -%% Key = term() -%% Env = environment() -%% Value = term() -%% -%% @doc Returns the value that <code>Key</code> is bound to in -%% <code>Env</code>. Throws <code>{undefined, Key}</code> if the key -%% does not exist in <code>Env</code>. - -get(Key, Env) -> - case lookup(Key, Env) of - {ok, Value} -> Value; - error -> throw({undefined, Key}) - end. - - -%% ===================================================================== -%% The key-generating algorithm could possibly be further improved. The -%% important thing to keep in mind is, that when we need a new key, we -%% are generally in mid-traversal of a syntax tree, and existing names -%% in the tree may be closely grouped and evenly distributed or even -%% forming a compact range (often having been generated by a "gensym", -%% or by this very algorithm itself). This means that if we generate an -%% identifier whose value is too close to those already seen (i.e., -%% which are in the environment), it is very probable that we will -%% shadow a not-yet-seen identifier further down in the tree, the result -%% being that we induce another later renaming, and end up renaming most -%% of the identifiers, completely contrary to our intention. We need to -%% generate new identifiers in a way that avoids such systematic -%% collisions. -%% -%% One way of getting a new key to try when the previous attempt failed -%% is of course to e.g. add one to the last tried value. However, in -%% general it's a bad idea to try adjacent identifiers: the percentage -%% of retries will typically increase a lot, so you may lose big on the -%% extra lookups while gaining only a little from the quicker -%% computation. -%% -%% We want an initial range that is large enough for most typical cases. -%% If we start with, say, a range of 10, we might quickly use up most of -%% the values in the range 1-10 (or 1-100) for new top-level variables - -%% but as we start traversing the syntax tree, it is quite likely that -%% exactly those variables will be encountered again (this depends on -%% how the names in the tree were created), and will then need to be -%% renamed. If we instead begin with a larger range, it is less likely -%% that any top-level names that we introduce will shadow names that we -%% will find in the tree. Of course we cannot know how large is large -%% enough: for any initial range, there is some syntax tree that uses -%% all the values in that range, and thus any top-level names introduced -%% will shadow names in the tree. The point is to avoid this happening -%% all the time - a range of about 1000 seems enough for most programs. -%% -%% The following values have been shown to work well: - --define(MINIMUM_RANGE, 1000). --define(START_RANGE_FACTOR, 50). --define(MAX_RETRIES, 2). % retries before enlarging range --define(ENLARGE_FACTOR, 10). % range enlargment factor - --ifdef(DEBUG). -%% If you want to use these process dictionary counters, make sure to -%% initialise them to zero before you call any of the key-generating -%% functions. -%% -%% new_key_calls total number of calls -%% new_key_retries failed key generation attempts -%% new_key_max maximum generated integer value -%% --define(measure_calls(), - put(new_key_calls, 1 + get(new_key_calls))). --define(measure_max_key(N), - case N > get(new_key_max) of - true -> - put(new_key_max, N); - false -> - ok - end). --define(measure_retries(N), - put(new_key_retries, get(new_key_retries) + N)). --else. --define(measure_calls(), ok). --define(measure_max_key(N), ok). --define(measure_retries(N), ok). --endif. - - -%% ===================================================================== -%% @spec new_key(Env::environment()) -> integer() -%% -%% @doc Returns an integer which is not already used as key in the -%% environment. New integers are generated using an algorithm which -%% tries to keep the values randomly distributed within a reasonably -%% small range relative to the number of entries in the environment. -%% -%% <p>This function uses the Erlang standard library module -%% <code>random</code> to generate new keys.</p> -%% -%% <p>Note that only the new key is returned; the environment itself is -%% not updated by this function.</p> - -new_key(Env) -> - new_key(fun (X) -> X end, Env). - - -%% ===================================================================== -%% @spec new_key(Function, Env) -> term() -%% -%% Function = (integer()) -> term() -%% Env = environment() -%% -%% @doc Returns a term which is not already used as key in the -%% environment. The term is generated by applying <code>Function</code> -%% to an integer generated as in {@link new_key/1}. -%% -%% <p>Note that only the generated term is returned; the environment -%% itself is not updated by this function.</p> - -new_key(F, Env) -> - ?measure_calls(), - R = start_range(Env), -%%% io:fwrite("Start range: ~w.\n", [R]), - new_key(R, F, Env). - -new_key(R, F, Env) -> - new_key(generate(R, R), R, 0, F, Env). - -new_key(N, R, T, F, Env) when T < ?MAX_RETRIES -> - A = F(N), - case is_defined(A, Env) of - true -> -%%% io:fwrite("CLASH: ~w.\n", [A]), - new_key(generate(N, R), R, T + 1, F, Env); - false -> - ?measure_max_key(N), - ?measure_retries(T), -%%% io:fwrite("New: ~w.\n", [N]), - A - end; -new_key(N, R, _T, F, Env) -> - %% Too many retries - enlarge the range and start over. - ?measure_retries((_T + 1)), - R1 = trunc(R * ?ENLARGE_FACTOR), -%%% io:fwrite("**NEW RANGE**: ~w.\n", [R1]), - new_key(generate(N, R1), R1, 0, F, Env). - -start_range(Env) -> - max(env_size(Env) * ?START_RANGE_FACTOR, ?MINIMUM_RANGE). - -max(X, Y) when X > Y -> X; -max(_, Y) -> Y. - -%% The previous key might or might not be used to compute the next key -%% to be tried. It is currently not used. -%% -%% In order to avoid causing cascading renamings, it is important that -%% this function does not generate values in order, but -%% (pseudo-)randomly distributed over the range. - -generate(_N, Range) -> - random:uniform(Range). % works well - - -%% ===================================================================== -%% @spec new_keys(N, Env) -> [integer()] -%% -%% N = integer() -%% Env = environment() -%% -%% @doc Returns a list of <code>N</code> distinct integers that are not -%% already used as keys in the environment. See {@link new_key/1} for -%% details. - -new_keys(N, Env) when integer(N) -> - new_keys(N, fun (X) -> X end, Env). - - -%% ===================================================================== -%% @spec new_keys(N, Function, Env) -> [term()] -%% -%% N = integer() -%% Function = (integer()) -> term() -%% Env = environment() -%% -%% @doc Returns a list of <code>N</code> distinct terms that are not -%% already used as keys in the environment. See {@link new_key/3} for -%% details. - -new_keys(N, F, Env) when integer(N) -> - R = start_range(Env), - new_keys(N, [], R, F, Env). - -new_keys(N, Ks, R, F, Env) when N > 0 -> - Key = new_key(R, F, Env), - Env1 = bind(Key, true, Env), % dummy binding - new_keys(N - 1, [Key | Ks], R, F, Env1); -new_keys(0, Ks, _, _, _) -> - Ks. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/sys_expand_pmod.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/sys_expand_pmod.erl deleted file mode 100644 index c5052b0e51..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/sys_expand_pmod.erl +++ /dev/null @@ -1,425 +0,0 @@ -%% ``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 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. -%% -%% 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: sys_expand_pmod.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $ -%% --module(sys_expand_pmod). - -%% Expand function definition forms of parameterized module. We assume -%% all record definitions, imports, queries, etc., have been expanded -%% away. Any calls on the form 'foo(...)' must be calls to local -%% functions. Auto-generated functions (module_info,...) have not yet -%% been added to the function definitions, but are listed in 'defined' -%% and 'exports'. The 'new/N' function is neither added to the -%% definitions nor to the 'exports'/'defines' lists yet. - --export([forms/4]). - --record(pmod, {parameters, exports, defined, predef}). - -%% TODO: more abstract handling of predefined/static functions. - -forms(Fs0, Ps, Es0, Ds0) -> - PreDef = [{module_info,0},{module_info,1}], - forms(Fs0, Ps, Es0, Ds0, PreDef). - -forms(Fs0, Ps, Es0, Ds0, PreDef) -> - St0 = #pmod{parameters=Ps,exports=Es0,defined=Ds0, predef=PreDef}, - {Fs1, St1} = forms(Fs0, St0), - Es1 = update_function_names(Es0, St1), - Ds1 = update_function_names(Ds0, St1), - Fs2 = update_forms(Fs1, St1), - {Fs2,Es1,Ds1}. - -%% This is extremely simplistic for now; all functions get an extra -%% parameter, whether they need it or not, except for static functions. - -update_function_names(Es, St) -> - [update_function_name(E, St) || E <- Es]. - -update_function_name(E={F,A}, St) -> - case ordsets:is_element(E, St#pmod.predef) of - true -> E; - false -> {F, A + 1} - end. - -update_forms([{function,L,N,A,Cs}|Fs],St) -> - [{function,L,N,A+1,Cs}|update_forms(Fs,St)]; -update_forms([F|Fs],St) -> - [F|update_forms(Fs,St)]; -update_forms([],_St) -> - []. - -%% Process the program forms. - -forms([F0|Fs0],St0) -> - {F1,St1} = form(F0,St0), - {Fs1,St2} = forms(Fs0,St1), - {[F1|Fs1],St2}; -forms([], St0) -> - {[], St0}. - -%% Only function definitions are of interest here. State is not updated. -form({function,Line,Name0,Arity0,Clauses0},St) -> - {Name,Arity,Clauses} = function(Name0, Arity0, Clauses0, St), - {{function,Line,Name,Arity,Clauses},St}; -%% Pass anything else through -form(F,St) -> {F,St}. - -function(Name, Arity, Clauses0, St) -> - Clauses1 = clauses(Clauses0,St), - {Name,Arity,Clauses1}. - -clauses([C|Cs],St) -> - {clause,L,H,G,B} = clause(C,St), - T = {tuple,L,[{var,L,V} || V <- ['_'|St#pmod.parameters]]}, - [{clause,L,H++[{match,L,T,{var,L,'THIS'}}],G,B}|clauses(Cs,St)]; -clauses([],_St) -> []. - -clause({clause,Line,H0,G0,B0},St) -> - H1 = head(H0,St), - G1 = guard(G0,St), - B1 = exprs(B0,St), - {clause,Line,H1,G1,B1}. - -head(Ps,St) -> patterns(Ps,St). - -patterns([P0|Ps],St) -> - P1 = pattern(P0,St), - [P1|patterns(Ps,St)]; -patterns([],_St) -> []. - -string_to_conses([], _Line, Tail) -> - Tail; -string_to_conses([E|Rest], Line, Tail) -> - {cons, Line, {integer, Line, E}, string_to_conses(Rest, Line, Tail)}. - -pattern({var,Line,V},_St) -> {var,Line,V}; -pattern({match,Line,L0,R0},St) -> - L1 = pattern(L0,St), - R1 = pattern(R0,St), - {match,Line,L1,R1}; -pattern({integer,Line,I},_St) -> {integer,Line,I}; -pattern({char,Line,C},_St) -> {char,Line,C}; -pattern({float,Line,F},_St) -> {float,Line,F}; -pattern({atom,Line,A},_St) -> {atom,Line,A}; -pattern({string,Line,S},_St) -> {string,Line,S}; -pattern({nil,Line},_St) -> {nil,Line}; -pattern({cons,Line,H0,T0},St) -> - H1 = pattern(H0,St), - T1 = pattern(T0,St), - {cons,Line,H1,T1}; -pattern({tuple,Line,Ps0},St) -> - Ps1 = pattern_list(Ps0,St), - {tuple,Line,Ps1}; -pattern({bin,Line,Fs},St) -> - Fs2 = pattern_grp(Fs,St), - {bin,Line,Fs2}; -pattern({op,_Line,'++',{nil,_},R},St) -> - pattern(R,St); -pattern({op,_Line,'++',{cons,Li,{char,C2,I},T},R},St) -> - pattern({cons,Li,{char,C2,I},{op,Li,'++',T,R}},St); -pattern({op,_Line,'++',{cons,Li,{integer,L2,I},T},R},St) -> - pattern({cons,Li,{integer,L2,I},{op,Li,'++',T,R}},St); -pattern({op,_Line,'++',{string,Li,L},R},St) -> - pattern(string_to_conses(L, Li, R),St); -pattern({op,Line,Op,A},_St) -> - {op,Line,Op,A}; -pattern({op,Line,Op,L,R},_St) -> - {op,Line,Op,L,R}. - -pattern_grp([{bin_element,L1,E1,S1,T1} | Fs],St) -> - S2 = case S1 of - default -> - default; - _ -> - expr(S1,St) - end, - T2 = case T1 of - default -> - default; - _ -> - bit_types(T1) - end, - [{bin_element,L1,expr(E1,St),S2,T2} | pattern_grp(Fs,St)]; -pattern_grp([],_St) -> - []. - -bit_types([]) -> - []; -bit_types([Atom | Rest]) when atom(Atom) -> - [Atom | bit_types(Rest)]; -bit_types([{Atom, Integer} | Rest]) when atom(Atom), integer(Integer) -> - [{Atom, Integer} | bit_types(Rest)]. - -pattern_list([P0|Ps],St) -> - P1 = pattern(P0,St), - [P1|pattern_list(Ps,St)]; -pattern_list([],_St) -> []. - -guard([G0|Gs],St) when list(G0) -> - [guard0(G0,St) | guard(Gs,St)]; -guard(L,St) -> - guard0(L,St). - -guard0([G0|Gs],St) -> - G1 = guard_test(G0,St), - [G1|guard0(Gs,St)]; -guard0([],_St) -> []. - -guard_test(Expr={call,Line,{atom,La,F},As0},St) -> - case erl_internal:type_test(F, length(As0)) of - true -> - As1 = gexpr_list(As0,St), - {call,Line,{atom,La,F},As1}; - _ -> - gexpr(Expr,St) - end; -guard_test(Any,St) -> - gexpr(Any,St). - -gexpr({var,L,V},_St) -> - {var,L,V}; -% %% alternative implementation of accessing module parameters -% case index(V,St#pmod.parameters) of -% N when N > 0 -> -% {call,L,{remote,L,{atom,L,erlang},{atom,L,element}}, -% [{integer,L,N+1},{var,L,'THIS'}]}; -% _ -> -% {var,L,V} -% end; -gexpr({integer,Line,I},_St) -> {integer,Line,I}; -gexpr({char,Line,C},_St) -> {char,Line,C}; -gexpr({float,Line,F},_St) -> {float,Line,F}; -gexpr({atom,Line,A},_St) -> {atom,Line,A}; -gexpr({string,Line,S},_St) -> {string,Line,S}; -gexpr({nil,Line},_St) -> {nil,Line}; -gexpr({cons,Line,H0,T0},St) -> - H1 = gexpr(H0,St), - T1 = gexpr(T0,St), - {cons,Line,H1,T1}; -gexpr({tuple,Line,Es0},St) -> - Es1 = gexpr_list(Es0,St), - {tuple,Line,Es1}; -gexpr({call,Line,{atom,La,F},As0},St) -> - case erl_internal:guard_bif(F, length(As0)) of - true -> As1 = gexpr_list(As0,St), - {call,Line,{atom,La,F},As1} - end; -% Pre-expansion generated calls to erlang:is_record/3 must also be handled -gexpr({call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,is_record}},As0},St) - when length(As0) == 3 -> - As1 = gexpr_list(As0,St), - {call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,is_record}},As1}; -% Guard bif's can be remote, but only in the module erlang... -gexpr({call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,F}},As0},St) -> - case erl_internal:guard_bif(F, length(As0)) or - erl_internal:arith_op(F, length(As0)) or - erl_internal:comp_op(F, length(As0)) or - erl_internal:bool_op(F, length(As0)) of - true -> As1 = gexpr_list(As0,St), - {call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,F}},As1} - end; -% Unfortunately, writing calls as {M,F}(...) is also allowed. -gexpr({call,Line,{tuple,La,[{atom,Lb,erlang},{atom,Lc,F}]},As0},St) -> - case erl_internal:guard_bif(F, length(As0)) or - erl_internal:arith_op(F, length(As0)) or - erl_internal:comp_op(F, length(As0)) or - erl_internal:bool_op(F, length(As0)) of - true -> As1 = gexpr_list(As0,St), - {call,Line,{tuple,La,[{atom,Lb,erlang},{atom,Lc,F}]},As1} - end; -gexpr({bin,Line,Fs},St) -> - Fs2 = pattern_grp(Fs,St), - {bin,Line,Fs2}; -gexpr({op,Line,Op,A0},St) -> - case erl_internal:arith_op(Op, 1) or - erl_internal:bool_op(Op, 1) of - true -> A1 = gexpr(A0,St), - {op,Line,Op,A1} - end; -gexpr({op,Line,Op,L0,R0},St) -> - case erl_internal:arith_op(Op, 2) or - erl_internal:bool_op(Op, 2) or - erl_internal:comp_op(Op, 2) of - true -> - L1 = gexpr(L0,St), - R1 = gexpr(R0,St), - {op,Line,Op,L1,R1} - end. - -gexpr_list([E0|Es],St) -> - E1 = gexpr(E0,St), - [E1|gexpr_list(Es,St)]; -gexpr_list([],_St) -> []. - -exprs([E0|Es],St) -> - E1 = expr(E0,St), - [E1|exprs(Es,St)]; -exprs([],_St) -> []. - -expr({var,L,V},_St) -> - {var,L,V}; -% case index(V,St#pmod.parameters) of -% N when N > 0 -> -% {call,L,{remote,L,{atom,L,erlang},{atom,L,element}}, -% [{integer,L,N+1},{var,L,'THIS'}]}; -% _ -> -% {var,L,V} -% end; -expr({integer,Line,I},_St) -> {integer,Line,I}; -expr({float,Line,F},_St) -> {float,Line,F}; -expr({atom,Line,A},_St) -> {atom,Line,A}; -expr({string,Line,S},_St) -> {string,Line,S}; -expr({char,Line,C},_St) -> {char,Line,C}; -expr({nil,Line},_St) -> {nil,Line}; -expr({cons,Line,H0,T0},St) -> - H1 = expr(H0,St), - T1 = expr(T0,St), - {cons,Line,H1,T1}; -expr({lc,Line,E0,Qs0},St) -> - Qs1 = lc_quals(Qs0,St), - E1 = expr(E0,St), - {lc,Line,E1,Qs1}; -expr({tuple,Line,Es0},St) -> - Es1 = expr_list(Es0,St), - {tuple,Line,Es1}; -expr({block,Line,Es0},St) -> - Es1 = exprs(Es0,St), - {block,Line,Es1}; -expr({'if',Line,Cs0},St) -> - Cs1 = icr_clauses(Cs0,St), - {'if',Line,Cs1}; -expr({'case',Line,E0,Cs0},St) -> - E1 = expr(E0,St), - Cs1 = icr_clauses(Cs0,St), - {'case',Line,E1,Cs1}; -expr({'receive',Line,Cs0},St) -> - Cs1 = icr_clauses(Cs0,St), - {'receive',Line,Cs1}; -expr({'receive',Line,Cs0,To0,ToEs0},St) -> - To1 = expr(To0,St), - ToEs1 = exprs(ToEs0,St), - Cs1 = icr_clauses(Cs0,St), - {'receive',Line,Cs1,To1,ToEs1}; -expr({'try',Line,Es0,Scs0,Ccs0,As0},St) -> - Es1 = exprs(Es0,St), - Scs1 = icr_clauses(Scs0,St), - Ccs1 = icr_clauses(Ccs0,St), - As1 = exprs(As0,St), - {'try',Line,Es1,Scs1,Ccs1,As1}; -expr({'fun',Line,Body,Info},St) -> - case Body of - {clauses,Cs0} -> - Cs1 = fun_clauses(Cs0,St), - {'fun',Line,{clauses,Cs1},Info}; - {function,F,A} -> - {F1,A1} = update_function_name({F,A},St), - if A1 == A -> - {'fun',Line,{function,F,A},Info}; - true -> - %% Must rewrite local fun-name to a fun that does a - %% call with the extra THIS parameter. - As = make_vars(A, Line), - As1 = As ++ [{var,Line,'THIS'}], - Call = {call,Line,{atom,Line,F1},As1}, - Cs = [{clause,Line,As,[],[Call]}], - {'fun',Line,{clauses,Cs},Info} - end; - {function,M,F,A} -> %This is an error in lint! - {'fun',Line,{function,M,F,A},Info} - end; -expr({call,Lc,{atom,_,new}=Name,As0},#pmod{parameters=Ps}=St) - when length(As0) =:= length(Ps) -> - %% The new() function does not take a 'THIS' argument (it's static). - As1 = expr_list(As0,St), - {call,Lc,Name,As1}; -expr({call,Lc,{atom,_,module_info}=Name,As0},St) - when length(As0) == 0; length(As0) == 1 -> - %% The module_info/0 and module_info/1 functions are also static. - As1 = expr_list(As0,St), - {call,Lc,Name,As1}; -expr({call,Lc,{atom,Lf,F},As0},St) -> - %% Local function call - needs THIS parameter. - As1 = expr_list(As0,St), - {call,Lc,{atom,Lf,F},As1 ++ [{var,0,'THIS'}]}; -expr({call,Line,F0,As0},St) -> - %% Other function call - F1 = expr(F0,St), - As1 = expr_list(As0,St), - {call,Line,F1,As1}; -expr({'catch',Line,E0},St) -> - E1 = expr(E0,St), - {'catch',Line,E1}; -expr({match,Line,P0,E0},St) -> - E1 = expr(E0,St), - P1 = pattern(P0,St), - {match,Line,P1,E1}; -expr({bin,Line,Fs},St) -> - Fs2 = pattern_grp(Fs,St), - {bin,Line,Fs2}; -expr({op,Line,Op,A0},St) -> - A1 = expr(A0,St), - {op,Line,Op,A1}; -expr({op,Line,Op,L0,R0},St) -> - L1 = expr(L0,St), - R1 = expr(R0,St), - {op,Line,Op,L1,R1}; -%% The following are not allowed to occur anywhere! -expr({remote,Line,M0,F0},St) -> - M1 = expr(M0,St), - F1 = expr(F0,St), - {remote,Line,M1,F1}. - -expr_list([E0|Es],St) -> - E1 = expr(E0,St), - [E1|expr_list(Es,St)]; -expr_list([],_St) -> []. - -icr_clauses([C0|Cs],St) -> - C1 = clause(C0,St), - [C1|icr_clauses(Cs,St)]; -icr_clauses([],_St) -> []. - -lc_quals([{generate,Line,P0,E0}|Qs],St) -> - E1 = expr(E0,St), - P1 = pattern(P0,St), - [{generate,Line,P1,E1}|lc_quals(Qs,St)]; -lc_quals([E0|Qs],St) -> - E1 = expr(E0,St), - [E1|lc_quals(Qs,St)]; -lc_quals([],_St) -> []. - -fun_clauses([C0|Cs],St) -> - C1 = clause(C0,St), - [C1|fun_clauses(Cs,St)]; -fun_clauses([],_St) -> []. - -% %% Return index from 1 upwards, or 0 if not in the list. -% -% index(X,Ys) -> index(X,Ys,1). -% -% index(X,[X|Ys],A) -> A; -% index(X,[Y|Ys],A) -> index(X,Ys,A+1); -% index(X,[],A) -> 0. - -make_vars(N, L) -> - make_vars(1, N, L). - -make_vars(N, M, L) when N =< M -> - V = list_to_atom("X"++integer_to_list(N)), - [{var,L,V} | make_vars(N + 1, M, L)]; -make_vars(_, _, _) -> - []. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/sys_pre_attributes.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/sys_pre_attributes.erl deleted file mode 100644 index 6e68611c66..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/sys_pre_attributes.erl +++ /dev/null @@ -1,212 +0,0 @@ -%% ``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 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. -%% -%% 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: sys_pre_attributes.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $ -%% -%% Purpose : Transform Erlang compiler attributes - --module(sys_pre_attributes). - --export([parse_transform/2]). - --define(OPTION_TAG, attributes). - --record(state, {forms, - pre_ops = [], - post_ops = [], - options}). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Inserts, deletes and replaces Erlang compiler attributes. -%% -%% Valid options are: -%% -%% {attribute, insert, AttrName, NewAttrVal} -%% {attribute, replace, AttrName, NewAttrVal} % replace first occurrence -%% {attribute, delete, AttrName} -%% -%% The transformation is performed in two passes: -%% -%% pre_transform -%% ------------- -%% Searches for attributes in the list of Forms in order to -%% delete or replace them. 'delete' will delete all occurrences -%% of attributes with the given name. 'replace' will replace the -%% first occurrence of the attribute. This pass is will only be -%% performed if there are replace or delete operations stated -%% as options. -%% -%% post_transform -%% ------------- -%% Looks up the module attribute and inserts the new attributes -%% directly after. This pass will only be performed if there are -%% any attributes left to be inserted after pre_transform. The left -%% overs will be those replace operations that not has been performed -%% due to that the pre_transform pass did not find the attribute plus -%% all insert operations. - -parse_transform(Forms, Options) -> - S = #state{forms = Forms, options = Options}, - S2 = init_transform(S), - report_verbose("Pre options: ~p~n", [S2#state.pre_ops], S2), - report_verbose("Post options: ~p~n", [S2#state.post_ops], S2), - S3 = pre_transform(S2), - S4 = post_transform(S3), - S4#state.forms. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Computes the lists of pre_ops and post_ops that are -%% used in the real transformation. -init_transform(S) -> - case S#state.options of - Options when list(Options) -> - init_transform(Options, S); - Option -> - init_transform([Option], S) - end. - -init_transform([{attribute, insert, Name, Val} | Tail], S) -> - Op = {insert, Name, Val}, - PostOps = [Op | S#state.post_ops], - init_transform(Tail, S#state{post_ops = PostOps}); -init_transform([{attribute, replace, Name, Val} | Tail], S) -> - Op = {replace, Name, Val}, - PreOps = [Op | S#state.pre_ops], - PostOps = [Op | S#state.post_ops], - init_transform(Tail, S#state{pre_ops = PreOps, post_ops = PostOps}); -init_transform([{attribute, delete, Name} | Tail], S) -> - Op = {delete, Name}, - PreOps = [Op | S#state.pre_ops], - init_transform(Tail, S#state{pre_ops = PreOps}); -init_transform([], S) -> - S; -init_transform([_ | T], S) -> - init_transform(T, S); -init_transform(BadOpt, S) -> - report_error("Illegal option (ignored): ~p~n", [BadOpt], S), - S. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Handle delete and perhaps replace - -pre_transform(S) when S#state.pre_ops == [] -> - S; -pre_transform(S) -> - pre_transform(S#state.forms, [], S). - -pre_transform([H | T], Acc, S) -> - case H of - {attribute, Line, Name, Val} -> - case lists:keysearch(Name, 2, S#state.pre_ops) of - false -> - pre_transform(T, [H | Acc], S); - - {value, {replace, Name, NewVal}} -> - report_warning("Replace attribute ~p: ~p -> ~p~n", - [Name, Val, NewVal], - S), - New = {attribute, Line, Name, NewVal}, - Pre = lists:keydelete(Name, 2, S#state.pre_ops), - Post = lists:keydelete(Name, 2, S#state.post_ops), - S2 = S#state{pre_ops = Pre, post_ops = Post}, - if - Pre == [] -> - %% No need to search the rest of the Forms - Forms = lists:reverse(Acc, [New | T]), - S2#state{forms = Forms}; - true -> - pre_transform(T, [New | Acc], S2) - end; - - {value, {delete, Name}} -> - report_warning("Delete attribute ~p: ~p~n", - [Name, Val], - S), - pre_transform(T, Acc, S) - end; - _Any -> - pre_transform(T, [H | Acc], S) - end; -pre_transform([], Acc, S) -> - S#state{forms = lists:reverse(Acc)}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Handle insert and perhaps replace - -post_transform(S) when S#state.post_ops == [] -> - S; -post_transform(S) -> - post_transform(S#state.forms, [], S). - -post_transform([H | T], Acc, S) -> - case H of - {attribute, Line, module, Val} -> - Acc2 = lists:reverse([{attribute, Line, module, Val} | Acc]), - Forms = Acc2 ++ attrs(S#state.post_ops, Line, S) ++ T, - S#state{forms = Forms, post_ops = []}; - _Any -> - post_transform(T, [H | Acc], S) - end; -post_transform([], Acc, S) -> - S#state{forms = lists:reverse(Acc)}. - -attrs([{replace, Name, NewVal} | T], Line, S) -> - report_verbose("Insert attribute ~p: ~p~n", [Name, NewVal], S), - [{attribute, Line, Name, NewVal} | attrs(T, Line, S)]; -attrs([{insert, Name, NewVal} | T], Line, S) -> - report_verbose("Insert attribute ~p: ~p~n", [Name, NewVal], S), - [{attribute, Line, Name, NewVal} | attrs(T, Line, S)]; -attrs([], _, _) -> - []. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Report functions. -%% -%% Errors messages are controlled with the 'report_errors' compiler option -%% Warning messages are controlled with the 'report_warnings' compiler option -%% Verbose messages are controlled with the 'verbose' compiler option - -report_error(Format, Args, S) -> - case is_error(S) of - true -> - io:format("~p: * ERROR * " ++ Format, [?MODULE | Args]); - false -> - ok - end. - -report_warning(Format, Args, S) -> - case is_warning(S) of - true -> - io:format("~p: * WARNING * " ++ Format, [?MODULE | Args]); - false -> - ok - end. - -report_verbose(Format, Args, S) -> - case is_verbose(S) of - true -> - io:format("~p: " ++ Format, [?MODULE | Args]); - false -> - ok - end. - -is_error(S) -> - lists:member(report_errors, S#state.options) or is_verbose(S). - -is_warning(S) -> - lists:member(report_warnings, S#state.options) or is_verbose(S). - -is_verbose(S) -> - lists:member(verbose, S#state.options). diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/sys_pre_expand.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/sys_pre_expand.erl deleted file mode 100644 index 5e7c1c8bbd..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/sys_pre_expand.erl +++ /dev/null @@ -1,1026 +0,0 @@ -%% ``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 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. -%% -%% 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: sys_pre_expand.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $ -%% -%% 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/1,union/2,intersection/1,intersection/2,subtract/2]). --import(lists, [member/2,map/2,foldl/3,foldr/3,sort/1,reverse/1,duplicate/2]). - --include("../my_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 - records=dict:new(), %Record definitions - 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} -%% Expand the forms in one module. N.B.: the lists of predefined -%% exports and imports are really ordsets! - -module(Fs, Opts) -> - %% 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, foldl(fun define_function/2, St0, Fs)), - {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}. - -expand_pmod(Fs0, St) -> - case St#expand.parameters of - undefined -> - {Fs0,St}; - Ps -> - {Fs1,Xs,Ds} = sys_expand_pmod:forms(Fs0, Ps, - St#expand.exports, - St#expand.defined), - A = length(Ps), - Vs = [{var,0,V} || V <- Ps], - N = {atom,0,St#expand.module}, - B = [{tuple,0,[N|Vs]}], - F = {function,0,new,A,[{clause,0,Vs,[],B}]}, - As = St#expand.attributes, - {[F|Fs1],St#expand{exports=add_element({new,A}, Xs), - defined=add_element({new,A}, Ds), - attributes = [{abstract, true} | As]}} - end. - -%% -type define_function(Form, State) -> State. -%% Add function to defined if form a function. - -define_function({function,_,N,A,_Cs}, St) -> - St#expand{defined=add_element({N,A}, St#expand.defined)}; -define_function(_, St) -> St. - -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,_,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}. - -%% -type 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 list(C) -> - St#expand{compile=St#expand.compile ++ C}; -attribute(compile, C, St) -> - St#expand{compile=St#expand.compile ++ [C]}; -attribute(record, {Name,Defs}, St) -> - St#expand{records=dict:store(Name, normalise_fields(Defs), - St#expand.records)}; -attribute(file, _File, St) -> St; %This is ignored -attribute(Name, Val, St) when 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}. - -%% -type clauses([Clause], State) -> -%% {[TransformedClause],State}. -%% Expand function clauses. - -clauses([{clause,Line,H0,G0,B0}|Cs0], St0) -> - {H,Hvs,_Hus,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), - {[{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,Variables,UsedVariables,State'} -%% BITS: added used variables for bit patterns with varaible length -%% - -pattern({var,_,'_'}=Var, St) -> %Ignore anonymous variable. - {Var,[],[],St}; -pattern({var,_,V}=Var, St) -> - {Var,[V],[],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,THvs,Hus,St1} = pattern(H, St0), - {TT,TTvs,Tus,St2} = pattern(T, St1), - {{cons,Line,TH,TT},union(THvs, TTvs),union(Hus,Tus),St2}; -pattern({tuple,Line,Ps}, St0) -> - {TPs,TPsvs,Tus,St1} = pattern_list(Ps, St0), - {{tuple,Line,TPs},TPsvs,Tus,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({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,Us,St1} = pattern_list(pattern_fields(Fs, Pfs), St0), - {{tuple,Line,[{atom,Line,Name}|TMs]},TMsvs,Us,St1}; -pattern({bin,Line,Es0}, St0) -> - {Es1,Esvs,Esus,St1} = pattern_bin(Es0, St0), - {{bin,Line,Es1},Esvs,Esus,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,Hvt,Hus,St1} = pattern(Pat2, St0), - {TT,Tvt,Tus,St2} = pattern(Pat1, St1), - {{match,Line,TT,TH}, union(Hvt,Tvt), union(Hus,Tus), 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,Pvs,Pus,St1} = pattern(P0, St0), - {Ps,Psvs,Psus,St2} = pattern_list(Ps0, St1), - {[P|Ps],union(Pvs, Psvs),union(Pus, Psus),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([], _, St) -> {[],[],[],St}. - -guard_tests([Gt0|Gts0], Vs, St0) -> - {Gt1,Gvs,Gus,St1} = guard_test(Gt0, Vs, St0), - {Gts1,Gsvs,Gsus,St2} = guard_tests(Gts0, union(Gvs, Vs), St1), - {[Gt1|Gts1],union(Gvs, Gsvs),union(Gus, Gsus),St2}; -guard_tests([], _, St) -> {[],[],[],St}. - -guard_test({call,Line,{atom,_,record},[A,{atom,_,Name}]}, Vs, St) -> - record_test_in_guard(Line, A, Name, Vs, St); -guard_test({call,Line,{atom,Lt,Tname},As}, Vs, St) -> - %% XXX This is ugly. We can remove this workaround if/when - %% we'll allow 'andalso' in guards. For now, we must have - %% different code in guards and in bodies. - Test = {remote,Lt, - {atom,Lt,erlang}, - {atom,Lt,normalise_test(Tname, length(As))}}, - put(sys_pre_expand_in_guard, yes), - R = expr({call,Line,Test,As}, Vs, St), - erase(sys_pre_expand_in_guard), - R; -guard_test(Test, Vs, St) -> - %% XXX See the previous clause. - put(sys_pre_expand_in_guard, yes), - R = expr(Test, Vs, St), - erase(sys_pre_expand_in_guard), - R. - -%% record_test(Line, Term, Name, Vs, St) -> TransformedExpr -%% Generate code for is_record/1. - -record_test(Line, Term, Name, Vs, St) -> - case get(sys_pre_expand_in_guard) of - undefined -> - record_test_in_body(Line, Term, Name, Vs, St); - yes -> - record_test_in_guard(Line, Term, Name, Vs, St) - end. - -record_test_in_guard(Line, Term, Name, Vs, St) -> - %% Notes: (1) To keep is_record/3 properly atomic (e.g. when inverted - %% using 'not'), we cannot convert it to an instruction - %% sequence here. It must remain a single call. - %% (2) Later passes assume that the last argument (the size) - %% is a literal. - %% (3) We don't want calls to erlang:is_record/3 (in the source code) - %% confused we the internal instruction. (Reason: (2) above + - %% code bloat.) - %% (4) Xref may be run on the abstract code, so the name in the - %% abstract code must be erlang:is_record/3. - %% (5) To achive both (3) and (4) at the same time, set the name - %% here to erlang:is_record/3, but mark it as compiler-generated. - %% The v3_core pass will change the name to erlang:internal_is_record/3. - Fs = record_fields(Name, St), - expr({call,-Line,{remote,-Line,{atom,-Line,erlang},{atom,-Line,is_record}}, - [Term,{atom,Line,Name},{integer,Line,length(Fs)+1}]}, - Vs, St). - -record_test_in_body(Line, Expr, Name, Vs, St0) -> - %% As Expr may have side effects, we must evaluate it - %% first and bind the value to a new variable. - %% We must use also handle the case that Expr does not - %% evaluate to a tuple properly. - Fs = record_fields(Name, St0), - {Var,St} = new_var(Line, St0), - - expr({block,Line, - [{match,Line,Var,Expr}, - {op,Line, - 'andalso', - {call,Line,{atom,Line,is_tuple},[Var]}, - {op,Line,'andalso', - {op,Line,'=:=', - {call,Line,{atom,Line,size},[Var]}, - {integer,Line,length(Fs)+1}}, - {op,Line,'=:=', - {call,Line,{atom,Line,element},[{integer,Line,1},Var]}, - {atom,Line,Name}}}}]}, Vs, St). - -normalise_test(atom, 1) -> is_atom; -normalise_test(binary, 1) -> is_binary; -normalise_test(constant, 1) -> is_constant; -normalise_test(float, 1) -> is_float; -normalise_test(function, 1) -> is_function; -normalise_test(integer, 1) -> is_integer; -normalise_test(list, 1) -> is_list; -normalise_test(number, 1) -> is_number; -normalise_test(pid, 1) -> is_pid; -normalise_test(port, 1) -> is_port; -normalise_test(reference, 1) -> is_reference; -normalise_test(tuple, 1) -> is_tuple; -normalise_test(Name, _) -> Name. - -%% 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([], _, St) -> {[],[],[],St}. - -%% expr(Expression, VisibleVariables, State) -> -%% {TransformedExpression,NewVariables,UsedVariables,State'} - -expr({var,_,V}=Var, _Vs, St) -> - {Var,[],[V],St}; -expr({char,_,_}=Char, _Vs, St) -> - {Char,[],[],St}; -expr({integer,_,_}=Int, _Vs, St) -> - {Int,[],[],St}; -expr({float,_,_}=Float, _Vs, St) -> - {Float,[],[],St}; -expr({atom,_,_}=Atom, _Vs, St) -> - {Atom,[],[],St}; -expr({string,_,_}=String, _Vs, St) -> - {String,[],[],St}; -expr({nil,_}=Nil, _Vs, St) -> - {Nil,[],[],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,E0,Qs0}, Vs, St0) -> - {E1,Qs1,_,Lvs,Lus,St1} = lc_tq(Line, E0, Qs0, {nil,Line}, Vs, St0), - {{lc,Line,E1,Qs1},Lvs,Lus,St1}; -expr({tuple,Line,Es0}, Vs, St0) -> - {Es1,Esvs,Esus,St1} = expr_list(Es0, Vs, St0), - {{tuple,Line,Es1},Esvs,Esus,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, _Vs, St) -> - {expand_package(M, St), [], [], St}; % must be a package name -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) -> - expr({tuple,Line,[{atom,Line,Name}| - 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,_,R,Name,Us}, Vs, St0) -> - {Ue,St1} = record_update(R, Name, record_fields(Name, St0), Us, St0), - expr(Ue, Vs, St1); -expr({bin,Line,Es0}, Vs, St0) -> - {Es1,Esvs,Esus,St1} = expr_bin(Es0, Vs, St0), - {{bin,Line,Es1},Esvs,Esus,St1}; -expr({block,Line,Es0}, Vs, St0) -> - {Es,Esvs,Esus,St1} = exprs(Es0, Vs, St0), - {{block,Line,Es},Esvs,Esus,St1}; -expr({'if',Line,Cs0}, Vs, St0) -> - {Cs,Csvss,Csuss,St1} = icr_clauses(Cs0, Vs, St0), - All = new_in_all(Vs, Csvss), - {{'if',Line,Cs},All,union(Csuss),St1}; -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 = new_in_all(Vs, Csvss), - {{'case',Line,E,Cs},union(Evs, All),union([Eus|Csuss]),St2}; -expr({'cond',Line,Cs}, Vs, St0) -> - {V,St1} = new_var(Line,St0), - expr(cond_clauses(Cs,V), Vs, St1); -expr({'receive',Line,Cs0}, Vs, St0) -> - {Cs,Csvss,Csuss,St1} = icr_clauses(Cs0, Vs, St0), - All = new_in_all(Vs, Csvss), - {{'receive',Line,Cs},All,union(Csuss),St1}; -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 = new_in_all(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,_,{atom,La,this_module},[]}, _Vs, St) -> -%%% {{atom,La,St#expand.module}, [], [], St}; -%%% expr({call,_,{atom,La,this_package},[]}, _Vs, St) -> -%%% {{atom,La,list_to_atom(St#expand.package)}, [], [], St}; -%%% expr({call,_,{atom,La,this_package},[{atom,_,Name}]}, _Vs, St) -> -%%% M = packages:concat(St#expand.package,Name), -%%% {{atom,La,list_to_atom(M)}, [], [], St}; -%%% expr({call,Line,{atom,La,this_package},[A]}, Vs, St) -> -%%% M = {call,Line,{remote,La,{atom,La,packages},{atom,La,concat}}, -%%% [{string,La,St#expand.package}, A]}, -%%% expr({call,Line,{atom,Line,list_to_atom},[M]}, Vs, St); -expr({call,Line,{atom,_,is_record},[A,{atom,_,Name}]}, Vs, St) -> - record_test(Line, A, Name, Vs, St); -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,is_record}}, - [A,{atom,_,Name}]}, Vs, St) -> - record_test(Line, A, Name, Vs, St); -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 -> - {{call,Line,{remote,La,{atom,La,erlang},{atom,La,N}},As}, - Asvs,Asus,St1}; - false -> - case imported(N, Ar, St1) of - {yes,Mod} -> - {{call,Line,{remote,La,{atom,La,Mod},{atom,La,N}},As}, - Asvs,Asus,St1}; - no -> - case {N,Ar} of - {record_info,2} -> - record_info_call(Line, As, St1); - _ -> - {{call,Line,{atom,La,N},As},Asvs,Asus,St1} - end - end - end; -expr({call,Line,{record_field,_,_,_}=M,As0}, Vs, St0) -> - expr({call,Line,expand_package(M, St0),As0}, Vs, St0); -expr({call,Line,{remote,Lr,M,F},As0}, Vs, St0) -> - M1 = expand_package(M, St0), - {[M2,F1|As1],Asvs,Asus,St1} = expr_list([M1,F|As0], Vs, St0), - {{call,Line,{remote,Lr,M2,F1},As1},Asvs,Asus,St1}; -expr({call,Line,{tuple,_,[{atom,_,_}=M,{atom,_,_}=F]},As}, Vs, St) -> - %% Rewrite {Mod,Function}(Args...) to Mod:Function(Args...). - expr({call,Line,{remote,Line,M,F},As}, Vs, St); -expr({call,Line,F,As0}, Vs, St0) -> - {[Fun1|As1],Asvs,Asus,St1} = expr_list([F|As0], Vs, St0), - {{call,Line,Fun1,As1},Asvs,Asus,St1}; -expr({'try',Line,Es0,Scs0,Ccs0,As0}, Vs, St0) -> - {Es1,Esvs,Esus,St1} = exprs(Es0, Vs, St0), - Cvs = union(Esvs, Vs), - {Scs1,Scsvss,Scsuss,St2} = icr_clauses(Scs0, Cvs, St1), - {Ccs1,Ccsvss,Ccsuss,St3} = icr_clauses(Ccs0, Cvs, St2), - Csvss = Scsvss ++ Ccsvss, - Csuss = Scsuss ++ Ccsuss, - All = new_in_all(Vs, Csvss), - {As1,Asvs,Asus,St4} = exprs(As0, Cvs, St3), - {{'try',Line,Es1,Scs1,Ccs1,As1}, union([Asvs,Esvs,All]), - union([Esus,Asus|Csuss]), St4}; -expr({'catch',Line,E0}, Vs, St0) -> - %% Catch exports no new variables. - {E,_Evs,Eus,St1} = expr(E0, Vs, St0), - {{'catch',Line,E},[],Eus,St1}; -expr({match,Line,P0,E0}, Vs, St0) -> - {E,Evs,Eus,St1} = expr(E0, Vs, St0), - {P,Pvs,Pus,St2} = pattern(P0, St1), - {{match,Line,P,E}, - union(subtract(Pvs, Vs), Evs), - union(intersection(Pvs, Vs), union(Eus,Pus)),St2}; -expr({op,L,'andalso',E1,E2}, Vs, St0) -> - {V,St1} = new_var(L,St0), - E = make_bool_switch(L,E1,V, - make_bool_switch(L,E2,V,{atom,L,true}, - {atom,L,false}), - {atom,L,false}), - expr(E, Vs, St1); -expr({op,L,'orelse',E1,E2}, Vs, St0) -> - {V,St1} = new_var(L,St0), - E = make_bool_switch(L,E1,V,{atom,L,true}, - make_bool_switch(L,E2,V,{atom,L,true}, - {atom,L,false})), - expr(E, Vs, St1); -expr({op,Line,'++',{lc,Ll,E0,Qs0},M0}, Vs, St0) -> - {E1,Qs1,M1,Lvs,Lus,St1} = lc_tq(Ll, E0, Qs0, M0, Vs, St0), - {{op,Line,'++',{lc,Ll,E1,Qs1},M1},Lvs,Lus,St1}; -expr({op,_,'++',{string,L1,S1},{string,_,S2}}, _Vs, St) -> - {{string,L1,S1 ++ S2},[],[],St}; -expr({op,Ll,'++',{string,L1,S1}=Str,R0}, Vs, St0) -> - {R1,Rvs,Rus,St1} = expr(R0, Vs, St0), - E = case R1 of - {string,_,S2} -> {string,L1,S1 ++ S2}; - _Other when length(S1) < 8 -> string_to_conses(L1, S1, R1); - _Other -> {op,Ll,'++',Str,R1} - end, - {E,Rvs,Rus,St1}; -expr({op,Ll,'++',{cons,Lc,H,T},L2}, Vs, St) -> - expr({cons,Ll,H,{op,Lc,'++',T,L2}}, Vs, St); -expr({op,_,'++',{nil,_},L2}, Vs, St) -> - expr(L2, Vs, St); -expr({op,Line,Op,A0}, Vs, St0) -> - {A,Avs,Aus,St1} = expr(A0, Vs, St0), - {{op,Line,Op,A},Avs,Aus,St1}; -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([], _, St) -> - {[],[],[],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([], _, St) -> - {[],[[]],[],St}; -icr_clauses(Clauses, Vs, St) -> - icr_clauses2(Clauses, Vs, St). - -icr_clauses2([{clause,Line,H0,G0,B0}|Cs0], Vs, St0) -> - {H,Hvs,Hus,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,Hus,Gus,Bus]), Vs), %Really used - {Cs,Csvs,Csus,St4} = icr_clauses2(Cs0, Vs, St3), - {[{clause,Line,H,G,B}|Cs],[New|Csvs],[Used|Csus],St4}; -icr_clauses2([], _, St) -> - {[],[],[],St}. - -%% lc_tq(Line, Expr, Qualifiers, More, [VisibleVar], State) -> -%% {TransExpr,[TransQual],TransMore,[NewVar],[UsedVar],State'} - -lc_tq(Line, E0, [{generate,Lg,P0,G0}|Qs0], M0, Vs, St0) -> - {G1,Gvs,Gus,St1} = expr(G0, Vs, St0), - {P1,Pvs,Pus,St2} = pattern(P0, St1), - {E1,Qs1,M1,Lvs,Lus,St3} = lc_tq(Line, E0, Qs0, M0, union(Pvs, Vs), St2), - {E1,[{generate,Lg,P1,G1}|Qs1],M1, - union(Gvs, Lvs),union([Gus,Pus,Lus]),St3}; -lc_tq(Line, E0, [F0|Qs0], M0, Vs, St0) -> - %% Allow record/2 and expand out as guard test. - case erl_lint:is_guard_test(F0) of - true -> - {F1,Fvs,_Fus,St1} = guard_tests([F0], Vs, St0), - {E1,Qs1,M1,Lvs,Lus,St2} = lc_tq(Line, E0, Qs0, M0, union(Fvs, Vs), St1), - {E1,F1++Qs1,M1,Lvs,Lus,St2}; - false -> - {F1,Fvs,_Fus,St1} = expr(F0, Vs, St0), - {E1,Qs1,M1,Lvs,Lus,St2} = lc_tq(Line, E0, Qs0, M0, union(Fvs, Vs), St1), - {E1,[F1|Qs1],M1,Lvs,Lus,St2} - end; -lc_tq(_Line, E0, [], M0, Vs, St0) -> - {E1,Evs,Eus,St1} = expr(E0, Vs, St0), - {M1,Mvs,Mus,St2} = expr(M0, Vs, St1), - {E1,[],M1,union(Evs, Mvs),union(Eus, Mus),St2}. - -%% fun_tq(Line, Body, VisibleVariables, State) -> -%% {Fun,NewVariables,UsedVariables,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}, Vs, 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}, Vs, St1); - false -> - Index = St0#expand.fun_index, - Uniq = erlang:hash(Cs, (1 bsl 27)-1), - {Fname,St2} = new_fun_name(St1), - {{'fun',Lf,{function,F,A},{Index,Uniq,Fname}},[],[], - St2#expand{fun_index=Index+1}} - end; -fun_tq(Lf, {clauses,Cs0}, Vs, St0) -> - Uniq = erlang:hash(Cs0, (1 bsl 27)-1), - {Cs1,_Hvss,Frees,St1} = fun_clauses(Cs0, Vs, St0), - Ufrees = union(Frees), - Index = St1#expand.fun_index, - {Fname,St2} = new_fun_name(St1), - {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},[],Ufrees, - St2#expand{fun_index=Index+1}}. - -fun_clauses([{clause,L,H0,G0,B0}|Cs0], Vs, St0) -> - {H,Hvs,Hus,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,Hus,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), - {[{clause,L,H,G,B}|Cs],[Hvs|Hvss],[Free|Frees],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}}. - - -%% 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}) -> - {record_field,Lf,Field,{atom,Lf,undefined}}; - (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,_,{atom,_,F},Val}|_]) -> {ok,Val}; -find_field(F, [_|Fs]) -> find_field(F, Fs); -find_field(_, []) -> error. - -%% field_names(RecFields) -> [Name]. -%% Return a list of the field names structures. - -field_names(Fs) -> - map(fun ({record_field,_,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,_,F}, _Name, Fs) -> - {integer,Line,index_expr(F, Fs, 2)}. - -index_expr(F, [{record_field,_,{atom,_,F},_}|_], 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) -> - Wildcard = record_wildcard_init(Ms), - map(fun ({record_field,L,{atom,_,F},_}) -> - case find_field(F, Ms) of - {ok,Match} -> Match; - error when Wildcard =:= none -> {var,L,'_'}; - error -> Wildcard - end end, - Fs). - -%% 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) -> - WildcardInit = record_wildcard_init(Is), - map(fun ({record_field,_,{atom,_,F},D}) -> - case find_field(F, Is) of - {ok,Init} -> Init; - error when WildcardInit =:= none -> D; - error -> WildcardInit - end end, - Fs). - -record_wildcard_init([{record_field,_,{var,_,'_'},D}|_]) -> D; -record_wildcard_init([_|Is]) -> record_wildcard_init(Is); -record_wildcard_init([]) -> none. - -%% 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, Us0, St0) -> - Line = element(2, R), - {Pre,Us,St1} = record_exprs(Us0, St0), - Nf = length(Fs), %# of record fields - Nu = length(Us), %# of update fields - Nc = Nf - Nu, %# of copy fields - - %% We need a new variable for the record expression - %% to guarantee that it is only evaluated once. - {Var,St2} = new_var(Line, St1), - - %% Try to be intelligent about which method of updating record to use. - {Update,St} = - if - Nu == 0 -> {R,St2}; %No fields updated - Nu =< Nc -> %Few fields updated - {record_setel(Var, Name, Fs, Us), St2}; - true -> %The wide area inbetween - record_match(Var, Name, Fs, Us, St2) - end, - {{block,element(2, R),Pre ++ [{match,Line,Var,R},Update]},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)), - {{'case',Lr,R, - [{clause,Lr,[{tuple,Lr,[{atom,Lr,Name}|Ps]}],[], - [{tuple,Lr,[{atom,Lr,Name}|News]}]}, - {clause,Lr,[{var,Lr,'_'}],[], - [call_error(Lr, {tuple,Lr,[{atom,Lr,badrecord},{atom,Lr,Name}]})]} - ]}, - St1}. - -record_upd_fs([{record_field,Lf,{atom,_La,F},_Val}|Fs], Us, St0) -> - {P,St1} = new_var(Lf, St0), - {Ps,News,St2} = record_upd_fs(Fs, Us, St1), - case find_field(F, Us) of - {ok,New} -> {[P|Ps],[New|News],St2}; - error -> {[P|Ps],[P|News],St2} - end; -record_upd_fs([], _, St) -> {[],[],St}. - -%% record_setel(Record, RecordName, [RecDefField], [Update]) -%% Build a nested chain of setelement calls to build the -%% updated record tuple. - -record_setel(R, Name, Fs, Us0) -> - Us1 = foldl(fun ({record_field,Lf,Field,Val}, Acc) -> - I = index_expr(Lf, Field, Name, Fs), - [{I,Lf,Val}|Acc] - end, [], Us0), - Us = sort(Us1), - Lr = element(2, hd(Us)), - Wildcards = duplicate(length(Fs), {var,Lr,'_'}), - {'case',Lr,R, - [{clause,Lr,[{tuple,Lr,[{atom,Lr,Name}|Wildcards]}],[], - [foldr(fun ({I,Lf,Val}, Acc) -> - {call,Lf,{atom,Lf,setelement},[I,Acc,Val]} end, - R, Us)]}, - {clause,Lr,[{var,Lr,'_'}],[], - [call_error(Lr, {tuple,Lr,[{atom,Lr,badrecord},{atom,Lr,Name}]})]}]}. - -%% Expand a call to record_info/2. We have checked that it is not -%% shadowed by an import. - -record_info_call(Line, [{atom,_Li,Info},{atom,_Ln,Name}], St) -> - case Info of - size -> - {{integer,Line,1+length(record_fields(Name, St))},[],[],St}; - fields -> - {make_list(field_names(record_fields(Name, St)), Line), - [],[],St} - end. - -%% Break out expressions from an record update list and bind to new -%% variables. The idea is that we will evaluate all update expressions -%% before starting to update the record. - -record_exprs(Us, St) -> - record_exprs(Us, St, [], []). - -record_exprs([{record_field,Lf,{atom,_La,_F}=Name,Val}=Field0|Us], St0, Pre, Fs) -> - case is_simple_val(Val) of - true -> - record_exprs(Us, St0, Pre, [Field0|Fs]); - false -> - {Var,St} = new_var(Lf, St0), - Bind = {match,Lf,Var,Val}, - Field = {record_field,Lf,Name,Var}, - record_exprs(Us, St, [Bind|Pre], [Field|Fs]) - end; -record_exprs([], St, Pre, Fs) -> - {reverse(Pre),Fs,St}. - -is_simple_val({var,_,_}) -> true; -is_simple_val({atom,_,_}) -> true; -is_simple_val({integer,_,_}) -> true; -is_simple_val({float,_,_}) -> true; -is_simple_val({nil,_}) -> true; -is_simple_val(_) -> false. - -%% 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,Expr,Size,Type}, {Es,Esvs,Esus,St0}) -> - {Expr1,Vs1,Us1,St1} = pattern(Expr, St0), - {Size1,Vs2,Us2,St2} = pat_bit_size(Size, St1), - {Size2,Type1} = make_bit_type(Line, Size1,Type), - {[{bin_element,Line,Expr1,Size2,Type1}|Es], - union([Vs1,Vs2,Esvs]),union([Us1,Us2,Esus]),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,[],[V],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,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)}. - -%% expr_bin([Element], [VisibleVar], State) -> -%% {[Element],[NewVar],[UsedVar],State}. - -expr_bin(Es0, Vs, St) -> - Es1 = bin_expand_strings(Es0), - foldr(fun (E, Acc) -> bin_element(E, Vs, Acc) end, {[],[],[],St}, Es1). - -bin_element({bin_element,Line,Expr,Size,Type}, Vs, {Es,Esvs,Esus,St0}) -> - {Expr1,Vs1,Us1,St1} = expr(Expr, Vs, St0), - {Size1,Vs2,Us2,St2} = if Size == default -> {default,[],[],St1}; - true -> expr(Size, Vs, St1) - end, - {Size2,Type1} = make_bit_type(Line, Size1, Type), - {[{bin_element,Line,Expr1,Size2,Type1}|Es], - union([Vs1,Vs2,Esvs]),union([Us1,Us2,Esus]),St2}. - -bin_expand_strings(Es) -> - foldr(fun ({bin_element,Line,{string,_,S},default,default}, Es1) -> - foldr(fun (C, Es2) -> - [{bin_element,Line,{char,Line,C},default,default}|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}. - -%% make_list(TermList, Line) -> ConsTerm. - -make_list(Ts, Line) -> - foldr(fun (H, T) -> {cons,Line,H,T} end, {nil,Line}, Ts). - -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 atom(A) -> atom_to_list(A); -package_to_string(L) when 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. - -%% Create a case-switch on true/false, generating badarg for all other -%% values. - -make_bool_switch(L, E, V, T, F) -> - make_bool_switch_1(L, E, V, [T], [F]). - -make_bool_switch_1(L, E, V, T, F) -> - case get(sys_pre_expand_in_guard) of - undefined -> make_bool_switch_body(L, E, V, T, F); - yes -> make_bool_switch_guard(L, E, V, T, F) - end. - -make_bool_switch_guard(_, E, _, [{atom,_,true}], [{atom,_,false}]) -> E; -make_bool_switch_guard(L, E, V, T, F) -> - NegL = -abs(L), - {'case',NegL,E, - [{clause,NegL,[{atom,NegL,true}],[],T}, - {clause,NegL,[{atom,NegL,false}],[],F}, - {clause,NegL,[V],[],[V]} - ]}. - -make_bool_switch_body(L, E, V, T, F) -> - NegL = -abs(L), - {'case',NegL,E, - [{clause,NegL,[{atom,NegL,true}],[],T}, - {clause,NegL,[{atom,NegL,false}],[],F}, - {clause,NegL,[V],[], - [call_error(NegL,{tuple,NegL,[{atom,NegL,badarg},V]})]} - ]}. - -%% Expand a list of cond-clauses to a sequence of case-switches. - -cond_clauses([{clause,L,[],[[E]],B}],V) -> - make_bool_switch_1(L,E,V,B,[call_error(L,{atom,L,cond_clause})]); -cond_clauses([{clause,L,[],[[E]],B} | Cs],V) -> - make_bool_switch_1(L,E,V,B,[cond_clauses(Cs,V)]). - -%% call_error(Line, Reason) -> Expr. -%% Build a call to erlang:error/1 with reason Reason. - -call_error(L, R) -> - {call,L,{remote,L,{atom,L,erlang},{atom,L,error}},[R]}. - -%% new_in_all(Before, RegionList) -> NewInAll -%% Return the variables new in all clauses. - -new_in_all(Before, Region) -> - InAll = intersection(Region), - subtract(InAll, Before). - -%% 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({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. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_codegen.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_codegen.erl deleted file mode 100644 index 2af4d94655..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_codegen.erl +++ /dev/null @@ -1,1755 +0,0 @@ -%% ``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 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. -%% -%% 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: v3_codegen.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $ -%% -%% Purpose : Code generator for Beam. - -%% The following assumptions have been made: -%% -%% 1. Matches, i.e. things with {match,M,Ret} wrappers, only return -%% values; no variables are exported. If the match would have returned -%% extra variables then these have been transformed to multiple return -%% values. -%% -%% 2. All BIF's called in guards are gc-safe so there is no need to -%% put thing on the stack in the guard. While this would in principle -%% work it would be difficult to keep track of the stack depth when -%% trimming. -%% -%% The code generation uses variable lifetime information added by -%% the v3_life module to save variables, allocate registers and -%% move registers to the stack when necessary. -%% -%% We try to use a consistent variable name scheme throughout. The -%% StackReg record is always called Bef,Int<n>,Aft. - --module(v3_codegen). - -%% The main interface. --export([module/2]). - --import(lists, [member/2,keymember/3,keysort/2,keysearch/3,append/1, - map/2,flatmap/2,foldl/3,foldr/3,mapfoldl/3, - sort/1,reverse/1,reverse/2]). --import(v3_life, [vdb_find/2]). - -%%-compile([export_all]). - --include("v3_life.hrl"). - -%% Main codegen structure. --record(cg, {lcount=1, %Label counter - mod, %Current module - func, %Current function - finfo, %Function info label - fcode, %Function code label - btype, %Type of bif used. - bfail, %Fail label of bif - break, %Break label - recv, %Receive label - is_top_block, %Boolean: top block or not - functable = [], %Table of local functions: - %[{{Name, Arity}, Label}...] - in_catch=false, %Inside a catch or not. - need_frame, %Need a stack frame. - new_funs=true}). %Generate new fun instructions. - -%% Stack/register state record. --record(sr, {reg=[], %Register table - stk=[], %Stack table - res=[]}). %Reserved regs: [{reserved,I,V}] - -module({Mod,Exp,Attr,Forms}, Options) -> - NewFunsFlag = not member(no_new_funs, Options), - {Fs,St} = functions(Forms, #cg{mod=Mod,new_funs=NewFunsFlag}), - {ok,{Mod,Exp,Attr,Fs,St#cg.lcount}}. - -functions(Forms, St0) -> - mapfoldl(fun (F, St) -> function(F, St) end, St0#cg{lcount=1}, Forms). - -function({function,Name,Arity,As0,Vb,Vdb}, St0) -> - %%ok = io:fwrite("cg ~w:~p~n", [?LINE,{Name,Arity}]), - St1 = St0#cg{func={Name,Arity}}, - {Fun,St2} = cg_fun(Vb, As0, Vdb, St1), - Func0 = {function,Name,Arity,St2#cg.fcode,Fun}, - Func = bs_function(Func0), - {Func,St2}. - -%% cg_fun([Lkexpr], [HeadVar], Vdb, State) -> {[Ainstr],State} - -cg_fun(Les, Hvs, Vdb, St0) -> - {Name,Arity} = St0#cg.func, - {Fi,St1} = new_label(St0), %FuncInfo label - {Fl,St2} = local_func_label(Name, Arity, St1), - %% Create initial stack/register state, clear unused arguments. - Bef = clear_dead(#sr{reg=foldl(fun ({var,V}, Reg) -> - put_reg(V, Reg) - end, [], Hvs), - stk=[]}, 0, Vdb), - {B2,_Aft,St3} = cg_list(Les, 0, Vdb, Bef, St2#cg{btype=exit, - bfail=Fi, - finfo=Fi, - fcode=Fl, - is_top_block=true}), - A = [{label,Fi},{func_info,{atom,St3#cg.mod},{atom,Name},Arity}, - {label,Fl}|B2], - {A,St3}. - -%% cg(Lkexpr, Vdb, StackReg, State) -> {[Ainstr],StackReg,State}. -%% Generate code for a kexpr. -%% Split function into two steps for clarity, not efficiency. - -cg(Le, Vdb, Bef, St) -> - cg(Le#l.ke, Le, Vdb, Bef, St). - -cg({block,Es}, Le, Vdb, Bef, St) -> - block_cg(Es, Le, Vdb, Bef, St); -cg({match,M,Rs}, Le, Vdb, Bef, St) -> - match_cg(M, Rs, Le, Vdb, Bef, St); -cg({match_fail,F}, Le, Vdb, Bef, St) -> - match_fail_cg(F, Le, Vdb, Bef, St); -cg({call,Func,As,Rs}, Le, Vdb, Bef, St) -> - call_cg(Func, As, Rs, Le, Vdb, Bef, St); -cg({enter,Func,As}, Le, Vdb, Bef, St) -> - enter_cg(Func, As, Le, Vdb, Bef, St); -cg({bif,Bif,As,Rs}, Le, Vdb, Bef, St) -> - bif_cg(Bif, As, Rs, Le, Vdb, Bef, St); -cg({receive_loop,Te,Rvar,Rm,Tes,Rs}, Le, Vdb, Bef, St) -> - recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St); -cg(receive_next, Le, Vdb, Bef, St) -> - recv_next_cg(Le, Vdb, Bef, St); -cg(receive_accept, _Le, _Vdb, Bef, St) -> {[remove_message],Bef,St}; -cg({'try',Ta,Vs,Tb,Evs,Th,Rs}, Le, Vdb, Bef, St) -> - try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St); -cg({'catch',Cb,R}, Le, Vdb, Bef, St) -> - catch_cg(Cb, R, Le, Vdb, Bef, St); -cg({set,Var,Con}, Le, Vdb, Bef, St) -> set_cg(Var, Con, Le, Vdb, Bef, St); -cg({return,Rs}, Le, Vdb, Bef, St) -> return_cg(Rs, Le, Vdb, Bef, St); -cg({break,Bs}, Le, Vdb, Bef, St) -> break_cg(Bs, Le, Vdb, Bef, St); -cg({need_heap,0}, _Le, _Vdb, Bef, St) -> - {[],Bef,St}; -cg({need_heap,H}, _Le, _Vdb, Bef, St) -> - {[{test_heap,H,max_reg(Bef#sr.reg)}],Bef,St}. - -%% cg_list([Kexpr], FirstI, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}. - -cg_list(Kes, I, Vdb, Bef, St0) -> - {Keis,{Aft,St1}} = - flatmapfoldl(fun (Ke, {Inta,Sta}) -> -% ok = io:fwrite(" %% ~p\n", [Inta]), -% ok = io:fwrite("cgl:~p\n", [Ke]), - {Keis,Intb,Stb} = cg(Ke, Vdb, Inta, Sta), -% ok = io:fwrite(" ~p\n", [Keis]), -% ok = io:fwrite(" %% ~p\n", [Intb]), - {comment(Inta) ++ Keis,{Intb,Stb}} - end, {Bef,St0}, need_heap(Kes, I)), - {Keis,Aft,St1}. - -%% need_heap([Lkexpr], I, BifType) -> [Lkexpr]. -%% Insert need_heap instructions in Kexpr list. Try to be smart and -%% collect them together as much as possible. - -need_heap(Kes0, I) -> - {Kes1,{H,F}} = flatmapfoldr(fun (Ke, {H0,F0}) -> - {Ns,H1,F1} = need_heap_1(Ke, H0, F0), - {[Ke|Ns],{H1,F1}} - end, {0,false}, Kes0), - %% Prepend need_heap if necessary. - Kes2 = need_heap_need(I, H, F) ++ Kes1, -% ok = io:fwrite("need_heap: ~p~n", -% [{{H,F}, -% map(fun (#l{ke={match,M,Rs}}) -> match; -% (Lke) -> Lke#l.ke end, Kes2)}]), - Kes2. - -need_heap_1(#l{ke={set,_,{binary,_}},i=I}, H, F) -> - {need_heap_need(I, H, F),0,false}; -need_heap_1(#l{ke={set,_,Val}}, H, F) -> - %% Just pass through adding to needed heap. - {[],H + case Val of - {cons,_} -> 2; - {tuple,Es} -> 1 + length(Es); - {string,S} -> 2 * length(S); - _Other -> 0 - end,F}; -need_heap_1(#l{ke={call,_Func,_As,_Rs},i=I}, H, F) -> - %% Calls generate a need if necessary and also force one. - {need_heap_need(I, H, F),0,true}; -need_heap_1(#l{ke={bif,dsetelement,_As,_Rs},i=I}, H, F) -> - {need_heap_need(I, H, F),0,true}; -need_heap_1(#l{ke={bif,{make_fun,_,_,_,_},_As,_Rs},i=I}, H, F) -> - {need_heap_need(I, H, F),0,true}; -need_heap_1(#l{ke={bif,_Bif,_As,_Rs}}, H, F) -> - {[],H,F}; -need_heap_1(#l{i=I}, H, F) -> - %% Others kexprs generate a need if necessary but don't force. - {need_heap_need(I, H, F),0,false}. - -need_heap_need(_I, 0, false) -> []; -need_heap_need(I, H, _F) -> [#l{ke={need_heap,H},i=I}]. - - -%% match_cg(Match, [Ret], Le, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. -%% Generate code for a match. First save all variables on the stack -%% that are to survive after the match. We leave saved variables in -%% their registers as they might actually be in the right place. -%% Should test this. - -match_cg(M, Rs, Le, Vdb, Bef, St0) -> - I = Le#l.i, - {Sis,Int0} = adjust_stack(Bef, I, I+1, Vdb), - {B,St1} = new_label(St0), - {Mis,Int1,St2} = match_cg(M, none, Int0, St1#cg{break=B}), - %% Put return values in registers. - Reg = load_vars(Rs, Int1#sr.reg), - {Sis ++ Mis ++ [{label,B}], - clear_dead(Int1#sr{reg=Reg}, I, Vdb), - St2#cg{break=St1#cg.break}}. - -%% match_cg(Match, Fail, StackReg, State) -> {[Ainstr],StackReg,State}. -%% Generate code for a match tree. N.B. there is no need pass Vdb -%% down as each level which uses this takes its own internal Vdb not -%% the outer one. - -match_cg(Le, Fail, Bef, St) -> - match_cg(Le#l.ke, Le, Fail, Bef, St). - -match_cg({alt,F,S}, _Le, Fail, Bef, St0) -> - {Tf,St1} = new_label(St0), - {Fis,Faft,St2} = match_cg(F, Tf, Bef, St1), - {Sis,Saft,St3} = match_cg(S, Fail, Bef, St2), - Aft = sr_merge(Faft, Saft), - {Fis ++ [{label,Tf}] ++ Sis,Aft,St3}; -match_cg({select,V,Scs}, _Va, Fail, Bef, St) -> - match_fmf(fun (S, F, Sta) -> - select_cg(S, V, F, Fail, Bef, Sta) end, - Fail, St, Scs); -match_cg({guard,Gcs}, _Le, Fail, Bef, St) -> - match_fmf(fun (G, F, Sta) -> guard_clause_cg(G, F, Bef, Sta) end, - Fail, St, Gcs); -match_cg({block,Es}, Le, _Fail, Bef, St) -> - %% Must clear registers and stack of dead variables. - Int = clear_dead(Bef, Le#l.i, Le#l.vdb), - block_cg(Es, Le, Int, St). - -%% match_fail_cg(FailReason, Le, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. -%% Generate code for the match_fail "call". N.B. there is no generic -%% case for when the fail value has been created elsewhere. - -match_fail_cg({function_clause,As}, Le, Vdb, Bef, St) -> - %% Must have the args in {x,0}, {x,1},... - {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), - {Sis ++ [{jump,{f,St#cg.finfo}}], - Int#sr{reg=clear_regs(Int#sr.reg)},St}; -match_fail_cg({badmatch,Term}, Le, Vdb, Bef, St) -> - R = cg_reg_arg(Term, Bef), - Int0 = clear_dead(Bef, Le#l.i, Vdb), - {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis ++ [{badmatch,R}], - Int#sr{reg=clear_regs(Int0#sr.reg)},St}; -match_fail_cg({case_clause,Reason}, Le, Vdb, Bef, St) -> - R = cg_reg_arg(Reason, Bef), - Int0 = clear_dead(Bef, Le#l.i, Vdb), - {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis++[{case_end,R}], - Int#sr{reg=clear_regs(Bef#sr.reg)},St}; -match_fail_cg(if_clause, Le, Vdb, Bef, St) -> - Int0 = clear_dead(Bef, Le#l.i, Vdb), - {Sis,Int1} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis++[if_end],Int1#sr{reg=clear_regs(Int1#sr.reg)},St}; -match_fail_cg({try_clause,Reason}, Le, Vdb, Bef, St) -> - R = cg_reg_arg(Reason, Bef), - Int0 = clear_dead(Bef, Le#l.i, Vdb), - {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis ++ [{try_case_end,R}], - Int#sr{reg=clear_regs(Int0#sr.reg)},St}. - - -%% block_cg([Kexpr], Le, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}. -%% block_cg([Kexpr], Le, StackReg, St) -> {[Ainstr],StackReg,St}. - -block_cg(Es, Le, _Vdb, Bef, St) -> - block_cg(Es, Le, Bef, St). - -block_cg(Es, Le, Bef, St0) -> - case St0#cg.is_top_block of - false -> - cg_block(Es, Le#l.i, Le#l.vdb, Bef, St0); - true -> - {Keis,Aft,St1} = cg_block(Es, Le#l.i, Le#l.vdb, Bef, - St0#cg{is_top_block=false, - need_frame=false}), - top_level_block(Keis, Aft, max_reg(Bef#sr.reg), St1) - end. - -cg_block([], _I, _Vdb, Bef, St0) -> - {[],Bef,St0}; -cg_block(Kes0, I, Vdb, Bef, St0) -> - {Kes2,Int1,St1} = - case basic_block(Kes0) of - {Kes1,LastI,Args,Rest} -> - Ke = hd(Kes1), - Fb = Ke#l.i, - cg_basic_block(Kes1, Fb, LastI, Args, Vdb, Bef, St0); - {Kes1,Rest} -> - cg_list(Kes1, I, Vdb, Bef, St0) - end, - {Kes3,Int2,St2} = cg_block(Rest, I, Vdb, Int1, St1), - {Kes2 ++ Kes3,Int2,St2}. - -basic_block(Kes) -> basic_block(Kes, []). - -basic_block([], Acc) -> {reverse(Acc),[]}; -basic_block([Le|Les], Acc) -> - case collect_block(Le#l.ke) of - include -> basic_block(Les, [Le|Acc]); - {block_end,As} -> {reverse(Acc, [Le]),Le#l.i,As,Les}; - no_block -> {reverse(Acc, [Le]),Les} - end. - -collect_block({set,_,{binary,_}}) -> no_block; -collect_block({set,_,_}) -> include; -collect_block({call,{var,_}=Var,As,_Rs}) -> {block_end,As++[Var]}; -collect_block({call,Func,As,_Rs}) -> {block_end,As++func_vars(Func)}; -collect_block({enter,{var,_}=Var,As})-> {block_end,As++[Var]}; -collect_block({enter,Func,As}) -> {block_end,As++func_vars(Func)}; -collect_block({return,Rs}) -> {block_end,Rs}; -collect_block({break,Bs}) -> {block_end,Bs}; -collect_block({bif,_Bif,_As,_Rs}) -> include; -collect_block(_) -> no_block. - -func_vars({remote,M,F}) when element(1, M) == var; - element(1, F) == var -> - [M,F]; -func_vars(_) -> []. - -%% cg_basic_block([Kexpr], FirstI, LastI, As, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. - -cg_basic_block(Kes, Fb, Lf, As, Vdb, Bef, St0) -> - Res = make_reservation(As, 0), - Regs0 = reserve(Res, Bef#sr.reg, Bef#sr.stk), - Stk = extend_stack(Bef, Lf, Lf+1, Vdb), - Int0 = Bef#sr{reg=Regs0,stk=Stk,res=Res}, - X0_v0 = x0_vars(As, Fb, Lf, Vdb), - {Keis,{Aft,_,St1}} = - flatmapfoldl(fun(Ke, St) -> cg_basic_block(Ke, St, Lf, Vdb) end, - {Int0,X0_v0,St0}, need_heap(Kes, Fb)), - {Keis,Aft,St1}. - -cg_basic_block(Ke, {Inta,X0v,Sta}, _Lf, Vdb) when element(1, Ke#l.ke) =:= need_heap -> - {Keis,Intb,Stb} = cg(Ke, Vdb, Inta, Sta), - {comment(Inta) ++ Keis, {Intb,X0v,Stb}}; -cg_basic_block(Ke, {Inta,X0_v1,Sta}, Lf, Vdb) -> - {Sis,Intb} = save_carefully(Inta, Ke#l.i, Lf+1, Vdb), - {X0_v2,Intc} = allocate_x0(X0_v1, Ke#l.i, Intb), - Intd = reserve(Intc), - {Keis,Inte,Stb} = cg(Ke, Vdb, Intd, Sta), - {comment(Inta) ++ Sis ++ Keis, {Inte,X0_v2,Stb}}. - -make_reservation([], _) -> []; -make_reservation([{var,V}|As], I) -> [{I,V}|make_reservation(As, I+1)]; -make_reservation([A|As], I) -> [{I,A}|make_reservation(As, I+1)]. - -reserve(Sr) -> Sr#sr{reg=reserve(Sr#sr.res, Sr#sr.reg, Sr#sr.stk)}. - -reserve([{I,V}|Rs], [free|Regs], Stk) -> [{reserved,I,V}|reserve(Rs, Regs, Stk)]; -reserve([{I,V}|Rs], [{I,V}|Regs], Stk) -> [{I,V}|reserve(Rs, Regs, Stk)]; -reserve([{I,V}|Rs], [{I,Var}|Regs], Stk) -> - case on_stack(Var, Stk) of - true -> [{reserved,I,V}|reserve(Rs, Regs, Stk)]; - false -> [{I,Var}|reserve(Rs, Regs, Stk)] - end; -reserve([{I,V}|Rs], [{reserved,I,_}|Regs], Stk) -> - [{reserved,I,V}|reserve(Rs, Regs, Stk)]; -%reserve([{I,V}|Rs], [Other|Regs], Stk) -> [Other|reserve(Rs, Regs, Stk)]; -reserve([{I,V}|Rs], [], Stk) -> [{reserved,I,V}|reserve(Rs, [], Stk)]; -reserve([], Regs, _) -> Regs. - -extend_stack(Bef, Fb, Lf, Vdb) -> - Stk0 = clear_dead_stk(Bef#sr.stk, Fb, Vdb), - Saves = [V || {V,F,L} <- Vdb, - F < Fb, - L >= Lf, - not on_stack(V, Stk0)], - Stk1 = foldl(fun (V, Stk) -> put_stack(V, Stk) end, Stk0, Saves), - Bef#sr.stk ++ lists:duplicate(length(Stk1) - length(Bef#sr.stk), free). - -save_carefully(Bef, Fb, Lf, Vdb) -> - Stk = Bef#sr.stk, - %% New variables that are in use but not on stack. - New = [ {V,F,L} || {V,F,L} <- Vdb, - F < Fb, - L >= Lf, - not on_stack(V, Stk) ], - Saves = [ V || {V,_,_} <- keysort(2, New) ], - save_carefully(Saves, Bef, []). - -save_carefully([], Bef, Acc) -> {reverse(Acc),Bef}; -save_carefully([V|Vs], Bef, Acc) -> - case put_stack_carefully(V, Bef#sr.stk) of - error -> {reverse(Acc),Bef}; - Stk1 -> - SrcReg = fetch_reg(V, Bef#sr.reg), - Move = {move,SrcReg,fetch_stack(V, Stk1)}, - {x,_} = SrcReg, %Assertion - must be X register. - save_carefully(Vs, Bef#sr{stk=Stk1}, [Move|Acc]) - end. - -x0_vars([], _Fb, _Lf, _Vdb) -> []; -x0_vars([{var,V}|_], Fb, _Lf, Vdb) -> - {V,F,_L} = VFL = vdb_find(V, Vdb), - x0_vars1([VFL], Fb, F, Vdb); -x0_vars([X0|_], Fb, Lf, Vdb) -> - x0_vars1([{X0,Lf,Lf}], Fb, Lf, Vdb). - -x0_vars1(X0, Fb, Xf, Vdb) -> - Vs0 = [VFL || {_V,F,L}=VFL <- Vdb, - F >= Fb, - L < Xf], - Vs1 = keysort(3, Vs0), - keysort(2, X0++Vs1). - -allocate_x0([], _, Bef) -> {[],Bef#sr{res=[]}}; -allocate_x0([{_,_,L}|Vs], I, Bef) when L =< I -> - allocate_x0(Vs, I, Bef); -allocate_x0([{V,_F,_L}=VFL|Vs], _, Bef) -> - {[VFL|Vs],Bef#sr{res=reserve_x0(V, Bef#sr.res)}}. - -reserve_x0(V, [_|Res]) -> [{0,V}|Res]; -reserve_x0(V, []) -> [{0,V}]. - -top_level_block(Keis, Bef, _MaxRegs, St0) when St0#cg.need_frame =:= false, - length(Bef#sr.stk) =:= 0 -> - %% This block need no stack frame. However, we still need to turn the - %% stack frame upside down. - MaxY = length(Bef#sr.stk)-1, - Keis1 = flatmap(fun (Tuple) when tuple(Tuple) -> - [turn_yregs(size(Tuple), Tuple, MaxY)]; - (Other) -> - [Other] - end, Keis), - {Keis1, Bef, St0#cg{is_top_block=true}}; -top_level_block(Keis, Bef, MaxRegs, St0) -> - %% This top block needs an allocate instruction before it, and a - %% deallocate instruction before each return. - FrameSz = length(Bef#sr.stk), - MaxY = FrameSz-1, - Keis1 = flatmap(fun ({call_only,Arity,Func}) -> - [{call_last,Arity,Func,FrameSz}]; - ({call_ext_only,Arity,Func}) -> - [{call_ext_last,Arity,Func,FrameSz}]; - ({apply_only,Arity}) -> - [{apply_last,Arity,FrameSz}]; - (return) -> - [{deallocate,FrameSz}, return]; - (Tuple) when tuple(Tuple) -> - [turn_yregs(size(Tuple), Tuple, MaxY)]; - (Other) -> - [Other] - end, Keis), - {[{allocate_zero,FrameSz,MaxRegs}|Keis1], Bef, St0#cg{is_top_block=true}}. - -%% turn_yregs(Size, Tuple, MaxY) -> Tuple' -%% Renumber y register so that {y, 0} becomes {y, FrameSize-1}, -%% {y, FrameSize-1} becomes {y, 0} and so on. This is to make nested -%% catches work. The code generation algorithm gives a lower register -%% number to the outer catch, which is wrong. - -turn_yregs(0, Tp, _) -> Tp; -turn_yregs(El, Tp, MaxY) when element(1, element(El, Tp)) == yy -> - turn_yregs(El-1, setelement(El, Tp, {y,MaxY-element(2, element(El, Tp))}), MaxY); -turn_yregs(El, Tp, MaxY) when list(element(El, Tp)) -> - New = map(fun ({yy,YY}) -> {y,MaxY-YY}; - (Other) -> Other end, element(El, Tp)), - turn_yregs(El-1, setelement(El, Tp, New), MaxY); -turn_yregs(El, Tp, MaxY) -> - turn_yregs(El-1, Tp, MaxY). - -%% select_cg(Sclause, V, TypeFail, ValueFail, StackReg, State) -> -%% {Is,StackReg,State}. -%% Selecting type and value needs two failure labels, TypeFail is the -%% label to jump to of the next type test when this type fails, and -%% ValueFail is the label when this type is correct but the value is -%% wrong. These are different as in the second case there is no need -%% to try the next type, it will always fail. - -select_cg(#l{ke={type_clause,cons,[S]}}, {var,V}, Tf, Vf, Bef, St) -> - select_cons(S, V, Tf, Vf, Bef, St); -select_cg(#l{ke={type_clause,nil,[S]}}, {var,V}, Tf, Vf, Bef, St) -> - select_nil(S, V, Tf, Vf, Bef, St); -select_cg(#l{ke={type_clause,binary,[S]}}, {var,V}, Tf, Vf, Bef, St) -> - select_binary(S, V, Tf, Vf, Bef, St); -select_cg(#l{ke={type_clause,bin_seg,S}}, {var,V}, Tf, Vf, Bef, St) -> - select_bin_segs(S, V, Tf, Vf, Bef, St); -select_cg(#l{ke={type_clause,bin_end,[S]}}, {var,V}, Tf, Vf, Bef, St) -> - select_bin_end(S, V, Tf, Vf, Bef, St); -select_cg(#l{ke={type_clause,Type,Scs}}, {var,V}, Tf, Vf, Bef, St0) -> - {Vis,{Aft,St1}} = - mapfoldl(fun (S, {Int,Sta}) -> - {Val,Is,Inta,Stb} = select_val(S, V, Vf, Bef, Sta), - {{Is,[Val]},{sr_merge(Int, Inta),Stb}} - end, {void,St0}, Scs), - OptVls = combine(lists:sort(combine(Vis))), - {Vls,Sis,St2} = select_labels(OptVls, St1, [], []), - {select_val_cg(Type, fetch_var(V, Bef), Vls, Tf, Vf, Sis), Aft, St2}. - -select_val_cg(tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> - [{test,is_tuple,{f,Tf},[R]},{test,test_arity,{f,Vf},[R,Arity]}|Sis]; -select_val_cg(tuple, R, Vls, Tf, Vf, Sis) -> - [{test,is_tuple,{f,Tf},[R]},{select_tuple_arity,R,{f,Vf},{list,Vls}}|Sis]; -select_val_cg(Type, R, [Val, {f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) -> - [{test,is_eq_exact,{f,Fail},[R,{Type,Val}]}|Sis]; -select_val_cg(Type, R, [Val, {f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> - [{test,select_type_test(Type),{f,Tf},[R]}, - {test,is_eq_exact,{f,Vf},[R,{Type,Val}]}|Sis]; -select_val_cg(Type, R, Vls0, Tf, Vf, Sis) -> - Vls1 = map(fun ({f,Lbl}) -> {f,Lbl}; - (Value) -> {Type,Value} - end, Vls0), - [{test,select_type_test(Type),{f,Tf},[R]}, {select_val,R,{f,Vf},{list,Vls1}}|Sis]. - -select_type_test(tuple) -> is_tuple; -select_type_test(integer) -> is_integer; -select_type_test(atom) -> is_atom; -select_type_test(float) -> is_float. - -combine([{Is,Vs1}, {Is,Vs2}|Vis]) -> combine([{Is,Vs1 ++ Vs2}|Vis]); -combine([V|Vis]) -> [V|combine(Vis)]; -combine([]) -> []. - -select_labels([{Is,Vs}|Vis], St0, Vls, Sis) -> - {Lbl,St1} = new_label(St0), - select_labels(Vis, St1, add_vls(Vs, Lbl, Vls), [[{label,Lbl}|Is]|Sis]); -select_labels([], St, Vls, Sis) -> - {Vls,append(Sis),St}. - -add_vls([V|Vs], Lbl, Acc) -> - add_vls(Vs, Lbl, [V, {f,Lbl}|Acc]); -add_vls([], _, Acc) -> Acc. - -select_cons(#l{ke={val_clause,{cons,Es},B},i=I,vdb=Vdb}, V, Tf, Vf, Bef, St0) -> - {Eis,Int,St1} = select_extract_cons(V, Es, I, Vdb, Bef, St0), - {Bis,Aft,St2} = match_cg(B, Vf, Int, St1), - {[{test,is_nonempty_list,{f,Tf},[fetch_var(V, Bef)]}] ++ Eis ++ Bis,Aft,St2}. - -select_nil(#l{ke={val_clause,nil,B}}, V, Tf, Vf, Bef, St0) -> - {Bis,Aft,St1} = match_cg(B, Vf, Bef, St0), - {[{test,is_nil,{f,Tf},[fetch_var(V, Bef)]}] ++ Bis,Aft,St1}. - -select_binary(#l{ke={val_clause,{old_binary,Var},B}}=L, - V, Tf, Vf, Bef, St) -> - %% Currently handled in the same way as new binaries. - select_binary(L#l{ke={val_clause,{binary,Var},B}}, V, Tf, Vf, Bef, St); -select_binary(#l{ke={val_clause,{binary,{var,Ivar}},B},i=I,vdb=Vdb}, - V, Tf, Vf, Bef, St0) -> - Int0 = clear_dead(Bef, I, Vdb), - {Bis,Aft,St1} = match_cg(B, Vf, Int0, St0), - {[{test,bs_start_match,{f,Tf},[fetch_var(V, Bef)]},{bs_save,Ivar}|Bis], - Aft,St1}. - -select_bin_segs(Scs, Ivar, Tf, _Vf, Bef, St) -> - match_fmf(fun(S, Fail, Sta) -> - select_bin_seg(S, Ivar, Fail, Bef, Sta) end, - Tf, St, Scs). - -select_bin_seg(#l{ke={val_clause,{bin_seg,Size,U,T,Fs,Es},B},i=I,vdb=Vdb}, - Ivar, Fail, Bef, St0) -> - {Mis,Int,St1} = select_extract_bin(Es, Size, U, T, Fs, Fail, - I, Vdb, Bef, St0), - {Bis,Aft,St2} = match_cg(B, Fail, Int, St1), - {[{bs_restore,Ivar}|Mis] ++ Bis,Aft,St2}. - -select_extract_bin([{var,Hd},{var,Tl}], Size0, Unit, Type, Flags, Vf, - I, Vdb, Bef, St) -> - SizeReg = get_bin_size_reg(Size0, Bef), - {Es,Aft} = - case vdb_find(Hd, Vdb) of - {_,_,Lhd} when Lhd =< I -> - {[{test,bs_skip_bits,{f,Vf},[SizeReg,Unit,{field_flags,Flags}]}, - {bs_save,Tl}],Bef}; - {_,_,_} -> - Reg0 = put_reg(Hd, Bef#sr.reg), - Int1 = Bef#sr{reg=Reg0}, - Rhd = fetch_reg(Hd, Reg0), - Name = get_bits_instr(Type), - {[{test,Name,{f,Vf},[SizeReg,Unit,{field_flags,Flags},Rhd]}, - {bs_save,Tl}],Int1} - end, - {Es,clear_dead(Aft, I, Vdb),St}. - -get_bin_size_reg({var,V}, Bef) -> - fetch_var(V, Bef); -get_bin_size_reg(Literal, _Bef) -> - Literal. - -select_bin_end(#l{ke={val_clause,bin_end,B}}, - Ivar, Tf, Vf, Bef, St0) -> - {Bis,Aft,St2} = match_cg(B, Vf, Bef, St0), - {[{bs_restore,Ivar},{test,bs_test_tail,{f,Tf},[0]}|Bis],Aft,St2}. - -get_bits_instr(integer) -> bs_get_integer; -get_bits_instr(float) -> bs_get_float; -get_bits_instr(binary) -> bs_get_binary. - -select_val(#l{ke={val_clause,{tuple,Es},B},i=I,vdb=Vdb}, V, Vf, Bef, St0) -> - {Eis,Int,St1} = select_extract_tuple(V, Es, I, Vdb, Bef, St0), - {Bis,Aft,St2} = match_cg(B, Vf, Int, St1), - {length(Es),Eis ++ Bis,Aft,St2}; -select_val(#l{ke={val_clause,{_,Val},B}}, _V, Vf, Bef, St0) -> - {Bis,Aft,St1} = match_cg(B, Vf, Bef, St0), - {Val,Bis,Aft,St1}. - -%% select_extract_tuple(Src, [V], I, Vdb, StackReg, State) -> -%% {[E],StackReg,State}. -%% Extract tuple elements, but only if they do not immediately die. - -select_extract_tuple(Src, Vs, I, Vdb, Bef, St) -> - F = fun ({var,V}, {Int0,Elem}) -> - case vdb_find(V, Vdb) of - {V,_,L} when L =< I -> {[], {Int0,Elem+1}}; - _Other -> - Reg1 = put_reg(V, Int0#sr.reg), - Int1 = Int0#sr{reg=Reg1}, - Rsrc = fetch_var(Src, Int1), - {[{get_tuple_element,Rsrc,Elem,fetch_reg(V, Reg1)}], - {Int1,Elem+1}} - end - end, - {Es,{Aft,_}} = flatmapfoldl(F, {Bef,0}, Vs), - {Es,Aft,St}. - -select_extract_cons(Src, [{var,Hd}, {var,Tl}], I, Vdb, Bef, St) -> - {Es,Aft} = case {vdb_find(Hd, Vdb), vdb_find(Tl, Vdb)} of - {{_,_,Lhd}, {_,_,Ltl}} when Lhd =< I, Ltl =< I -> - %% Both head and tail are dead. No need to generate - %% any instruction. - {[], Bef}; - _ -> - %% At least one of head and tail will be used, - %% but we must always fetch both. We will call - %% clear_dead/2 to allow reuse of the register - %% in case only of them is used. - - Reg0 = put_reg(Tl, put_reg(Hd, Bef#sr.reg)), - Int0 = Bef#sr{reg=Reg0}, - Rsrc = fetch_var(Src, Int0), - Rhd = fetch_reg(Hd, Reg0), - Rtl = fetch_reg(Tl, Reg0), - Int1 = clear_dead(Int0, I, Vdb), - {[{get_list,Rsrc,Rhd,Rtl}], Int1} - end, - {Es,Aft,St}. - - -guard_clause_cg(#l{ke={guard_clause,G,B},vdb=Vdb}, Fail, Bef, St0) -> - {Gis,Int,St1} = guard_cg(G, Fail, Vdb, Bef, St0), - {Bis,Aft,St2} = match_cg(B, Fail, Int, St1), - {Gis ++ Bis,Aft,St2}. - -%% guard_cg(Guard, Fail, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. -%% A guard is a boolean expression of tests. Tests return true or -%% false. A fault in a test causes the test to return false. Tests -%% never return the boolean, instead we generate jump code to go to -%% the correct exit point. Primops and tests all go to the next -%% instruction on success or jump to a failure label. - -guard_cg(#l{ke={protected,Ts,Rs},i=I,vdb=Pdb}, Fail, _Vdb, Bef, St) -> - protected_cg(Ts, Rs, Fail, I, Pdb, Bef, St); -guard_cg(#l{ke={block,Ts},i=I,vdb=Bdb}, Fail, _Vdb, Bef, St) -> - guard_cg_list(Ts, Fail, I, Bdb, Bef, St); -guard_cg(#l{ke={test,Test,As},i=I,vdb=_Tdb}, Fail, Vdb, Bef, St) -> - test_cg(Test, As, Fail, I, Vdb, Bef, St); -guard_cg(G, _Fail, Vdb, Bef, St) -> - %%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{G,Fail,Vdb,Bef}]), - {Gis,Aft,St1} = cg(G, Vdb, Bef, St), - %%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{Aft}]), - {Gis,Aft,St1}. - -%% protected_cg([Kexpr], [Ret], Fail, I, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% Do a protected. Protecteds without return values are just done -%% for effect, the return value is not checked, success passes on to -%% the next instruction and failure jumps to Fail. If there are -%% return values then these must be set to 'false' on failure, -%% control always passes to the next instruction. - -protected_cg(Ts, [], Fail, I, Vdb, Bef, St0) -> - %% Protect these calls, revert when done. - {Tis,Aft,St1} = guard_cg_list(Ts, Fail, I, Vdb, Bef, - St0#cg{btype=fail,bfail=Fail}), - {Tis,Aft,St1#cg{btype=St0#cg.btype,bfail=St0#cg.bfail}}; -protected_cg(Ts, Rs, _Fail, I, Vdb, Bef, St0) -> - {Pfail,St1} = new_label(St0), - {Psucc,St2} = new_label(St1), - {Tis,Aft,St3} = guard_cg_list(Ts, Pfail, I, Vdb, Bef, - St2#cg{btype=fail,bfail=Pfail}), - %%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{Rs,I,Vdb,Aft}]), - %% Set return values to false. - Mis = map(fun ({var,V}) -> {move,{atom,false},fetch_var(V, Aft)} end, Rs), - Live = {'%live',max_reg(Aft#sr.reg)}, - {Tis ++ [Live,{jump,{f,Psucc}}, - {label,Pfail}] ++ Mis ++ [Live,{label,Psucc}], - Aft,St3#cg{btype=St0#cg.btype,bfail=St0#cg.bfail}}. - -%% test_cg(TestName, Args, Fail, I, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% Generate test instruction. Use explicit fail label here. - -test_cg(Test, As, Fail, I, Vdb, Bef, St) -> - case test_type(Test, length(As)) of - {cond_op,Op} -> - Ars = cg_reg_args(As, Bef), - Int = clear_dead(Bef, I, Vdb), - {[{test,Op,{f,Fail},Ars}], - clear_dead(Int, I, Vdb), - St}; - {rev_cond_op,Op} -> - [S1,S2] = cg_reg_args(As, Bef), - Int = clear_dead(Bef, I, Vdb), - {[{test,Op,{f,Fail},[S2,S1]}], - clear_dead(Int, I, Vdb), - St} - end. - -test_type(is_atom, 1) -> {cond_op,is_atom}; -test_type(is_boolean, 1) -> {cond_op,is_boolean}; -test_type(is_binary, 1) -> {cond_op,is_binary}; -test_type(is_constant, 1) -> {cond_op,is_constant}; -test_type(is_float, 1) -> {cond_op,is_float}; -test_type(is_function, 1) -> {cond_op,is_function}; -test_type(is_integer, 1) -> {cond_op,is_integer}; -test_type(is_list, 1) -> {cond_op,is_list}; -test_type(is_number, 1) -> {cond_op,is_number}; -test_type(is_pid, 1) -> {cond_op,is_pid}; -test_type(is_port, 1) -> {cond_op,is_port}; -test_type(is_reference, 1) -> {cond_op,is_reference}; -test_type(is_tuple, 1) -> {cond_op,is_tuple}; -test_type('=<', 2) -> {rev_cond_op,is_ge}; -test_type('>', 2) -> {rev_cond_op,is_lt}; -test_type('<', 2) -> {cond_op,is_lt}; -test_type('>=', 2) -> {cond_op,is_ge}; -test_type('==', 2) -> {cond_op,is_eq}; -test_type('/=', 2) -> {cond_op,is_ne}; -test_type('=:=', 2) -> {cond_op,is_eq_exact}; -test_type('=/=', 2) -> {cond_op,is_ne_exact}; -test_type(internal_is_record, 3) -> {cond_op,internal_is_record}. - -%% guard_cg_list([Kexpr], Fail, I, Vdb, StackReg, St) -> -%% {[Ainstr],StackReg,St}. - -guard_cg_list(Kes, Fail, I, Vdb, Bef, St0) -> - {Keis,{Aft,St1}} = - flatmapfoldl(fun (Ke, {Inta,Sta}) -> - {Keis,Intb,Stb} = - guard_cg(Ke, Fail, Vdb, Inta, Sta), - {comment(Inta) ++ Keis,{Intb,Stb}} - end, {Bef,St0}, need_heap(Kes, I)), - {Keis,Aft,St1}. - -%% match_fmf(Fun, LastFail, State, [Clause]) -> {Is,Aft,State}. -%% This is a special flatmapfoldl for match code gen where we -%% generate a "failure" label for each clause. The last clause uses -%% an externally generated failure label, LastFail. N.B. We do not -%% know or care how the failure labels are used. - -match_fmf(F, LastFail, St, [H]) -> - F(H, LastFail, St); -match_fmf(F, LastFail, St0, [H|T]) -> - {Fail,St1} = new_label(St0), - {R,Aft1,St2} = F(H, Fail, St1), - {Rs,Aft2,St3} = match_fmf(F, LastFail, St2, T), - {R ++ [{label,Fail}] ++ Rs,sr_merge(Aft1, Aft2),St3}; -match_fmf(_, _, St, []) -> {[],void,St}. - -%% call_cg(Func, [Arg], [Ret], Le, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. -%% enter_cg(Func, [Arg], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% Call and enter first put the arguments into registers and save any -%% other registers, then clean up and compress the stack and set the -%% frame size. Finally the actual call is made. Call then needs the -%% return values filled in. - -call_cg({var,V}, As, Rs, Le, Vdb, Bef, St0) -> - {Sis,Int} = cg_setup_call(As++[{var,V}], Bef, Le#l.i, Vdb), - %% Put return values in registers. - Reg = load_vars(Rs, clear_regs(Int#sr.reg)), - %% Build complete code and final stack/register state. - Arity = length(As), - {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {comment({call_fun,{var,V},As}) ++ Sis ++ Frees ++ [{call_fun,Arity}], - Aft,need_stack_frame(St0)}; -call_cg({remote,Mod,Name}, As, Rs, Le, Vdb, Bef, St0) - when element(1, Mod) == var; - element(1, Name) == var -> - {Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb), - %% Put return values in registers. - Reg = load_vars(Rs, clear_regs(Int#sr.reg)), - %% Build complete code and final stack/register state. - Arity = length(As), - Call = {apply,Arity}, - St = need_stack_frame(St0), - %%{Call,St1} = build_call(Func, Arity, St0), - {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {Sis ++ Frees ++ [Call],Aft,St}; -call_cg(Func, As, Rs, Le, Vdb, Bef, St0) -> - {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), - %% Put return values in registers. - Reg = load_vars(Rs, clear_regs(Int#sr.reg)), - %% Build complete code and final stack/register state. - Arity = length(As), - {Call,St1} = build_call(Func, Arity, St0), - {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {comment({call,Func,As}) ++ Sis ++ Frees ++ Call,Aft,St1}. - -build_call({remote,{atom,erlang},{atom,'!'}}, 2, St0) -> - {[send],need_stack_frame(St0)}; -build_call({remote,{atom,Mod},{atom,Name}}, Arity, St0) -> - {[{call_ext,Arity,{extfunc,Mod,Name,Arity}}],need_stack_frame(St0)}; -build_call(Name, Arity, St0) when atom(Name) -> - {Lbl,St1} = local_func_label(Name, Arity, need_stack_frame(St0)), - {[{call,Arity,{f,Lbl}}],St1}. - -free_dead(#sr{stk=Stk0}=Aft) -> - {Instr,Stk} = free_dead(Stk0, 0, [], []), - {Instr,Aft#sr{stk=Stk}}. - -free_dead([dead|Stk], Y, Instr, StkAcc) -> - %% Note: kill/1 is equivalent to init/1 (translated by beam_asm). - %% We use kill/1 to help further optimisation passes. - free_dead(Stk, Y+1, [{kill,{yy,Y}}|Instr], [free|StkAcc]); -free_dead([Any|Stk], Y, Instr, StkAcc) -> - free_dead(Stk, Y+1, Instr, [Any|StkAcc]); -free_dead([], _, Instr, StkAcc) -> {Instr,reverse(StkAcc)}. - -enter_cg({var,V}, As, Le, Vdb, Bef, St0) -> - {Sis,Int} = cg_setup_call(As++[{var,V}], Bef, Le#l.i, Vdb), - %% Build complete code and final stack/register state. - Arity = length(As), - {comment({call_fun,{var,V},As}) ++ Sis ++ [{call_fun,Arity},return], - clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), - need_stack_frame(St0)}; -enter_cg({remote,Mod,Name}=Func, As, Le, Vdb, Bef, St0) - when element(1, Mod) == var; - element(1, Name) == var -> - {Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb), - %% Build complete code and final stack/register state. - Arity = length(As), - Call = {apply_only,Arity}, - St = need_stack_frame(St0), - {comment({enter,Func,As}) ++ Sis ++ [Call], - clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), - St}; -enter_cg(Func, As, Le, Vdb, Bef, St0) -> - {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), - %% Build complete code and final stack/register state. - Arity = length(As), - {Call,St1} = build_enter(Func, Arity, St0), - {comment({enter,Func,As}) ++ Sis ++ Call, - clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), - St1}. - -build_enter({remote,{atom,erlang},{atom,'!'}}, 2, St0) -> - {[send,return],need_stack_frame(St0)}; -build_enter({remote,{atom,Mod},{atom,Name}}, Arity, St0) -> - St1 = case trap_bif(Mod, Name, Arity) of - true -> need_stack_frame(St0); - false -> St0 - end, - {[{call_ext_only,Arity,{extfunc,Mod,Name,Arity}}],St1}; -build_enter(Name, Arity, St0) when is_atom(Name) -> - {Lbl,St1} = local_func_label(Name, Arity, St0), - {[{call_only,Arity,{f,Lbl}}],St1}. - -%% local_func_label(Name, Arity, State) -> {Label,State'} -%% Get the function entry label for a local function. - -local_func_label(Name, Arity, St0) -> - Key = {Name,Arity}, - case keysearch(Key, 1, St0#cg.functable) of - {value,{Key,Label}} -> - {Label,St0}; - false -> - {Label,St1} = new_label(St0), - {Label,St1#cg{functable=[{Key,Label}|St1#cg.functable]}} - end. - -%% need_stack_frame(State) -> State' -%% Make a note in the state that this function will need a stack frame. - -need_stack_frame(#cg{need_frame=true}=St) -> St; -need_stack_frame(St) -> St#cg{need_frame=true}. - -%% trap_bif(Mod, Name, Arity) -> true|false -%% Trap bifs that need a stack frame. - -trap_bif(erlang, '!', 2) -> true; -trap_bif(erlang, link, 1) -> true; -trap_bif(erlang, unlink, 1) -> true; -trap_bif(erlang, monitor_node, 2) -> true; -trap_bif(erlang, group_leader, 2) -> true; -trap_bif(erlang, exit, 2) -> true; -trap_bif(_, _, _) -> false. - -%% bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. - -bif_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) -> - [New,Tuple,{integer,Index1}] = cg_reg_args([New0,Tuple0,Index0], Bef), - Index = Index1-1, - {[{set_tuple_element,New,Tuple,Index}], - clear_dead(Bef, Le#l.i, Vdb), St0}; -bif_cg({make_fun,Func,Arity,Index,Uniq}, As, Rs, Le, Vdb, Bef, St0) -> - %% This behaves more like a function call. - {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), - Reg = load_vars(Rs, clear_regs(Int#sr.reg)), - {FuncLbl,St1} = local_func_label(Func, Arity, St0), - MakeFun = case St0#cg.new_funs of - true -> {make_fun2,{f,FuncLbl},Index,Uniq,length(As)}; - false -> {make_fun,{f,FuncLbl},Uniq,length(As)} - end, - {comment({make_fun,{Func,Arity,Uniq},As}) ++ Sis ++ - [MakeFun], - clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb), - St1}; -bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> - Ars = cg_reg_args(As, Bef), - - %% If we are inside a catch, we must save everything that will - %% be alive after the catch (because the BIF might fail and there - %% will be a jump to the code after the catch). - %% Currently, we are somewhat pessimistic in - %% that we save any variable that will be live after this BIF call. - - {Sis,Int0} = - case St0#cg.in_catch of - true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Bef} - end, - - Int1 = clear_dead(Int0, Le#l.i, Vdb), - Reg = put_reg(V, Int1#sr.reg), - Int = Int1#sr{reg=Reg}, - Dst = fetch_reg(V, Reg), - {Sis ++ [{bif,Bif,bif_fail(St0#cg.btype, St0#cg.bfail, length(Ars)),Ars,Dst}], - clear_dead(Int, Le#l.i, Vdb), St0}. - -bif_fail(_, _, 0) -> nofail; -bif_fail(exit, _, _) -> {f,0}; -bif_fail(fail, Fail, _) -> {f,Fail}. - -%% recv_loop_cg(TimeOut, ReceiveVar, ReceiveMatch, TimeOutExprs, -%% [Ret], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. - -recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St0) -> - {Sis,Int0} = adjust_stack(Bef, Le#l.i, Le#l.i, Vdb), - Int1 = Int0#sr{reg=clear_regs(Int0#sr.reg)}, - %% Get labels. - {Rl,St1} = new_label(St0), - {Tl,St2} = new_label(St1), - {Bl,St3} = new_label(St2), - St4 = St3#cg{break=Bl,recv=Rl}, %Set correct receive labels - {Ris,Raft,St5} = cg_recv_mesg(Rvar, Rm, Tl, Int1, St4), - {Wis,Taft,St6} = cg_recv_wait(Te, Tes, Le#l.i, Int1, St5), - Int2 = sr_merge(Raft, Taft), %Merge stack/registers - Reg = load_vars(Rs, Int2#sr.reg), - {Sis ++ Ris ++ [{label,Tl}] ++ Wis ++ [{label,Bl}], - clear_dead(Int2#sr{reg=Reg}, Le#l.i, Vdb), - St6#cg{break=St0#cg.break,recv=St0#cg.recv}}. - -%% cg_recv_mesg( ) -> {[Ainstr],Aft,St}. - -cg_recv_mesg({var,R}, Rm, Tl, Bef, St0) -> - Int0 = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, - Ret = fetch_reg(R, Int0#sr.reg), - %% Int1 = clear_dead(Int0, I, Rm#l.vdb), - Int1 = Int0, - {Mis,Int2,St1} = match_cg(Rm, none, Int1, St0), - {[{'%live',0},{label,St1#cg.recv},{loop_rec,{f,Tl},Ret}|Mis],Int2,St1}. - -%% cg_recv_wait(Te, Tes, I, Vdb, Int2, St3) -> {[Ainstr],Aft,St}. - -cg_recv_wait({atom,infinity}, Tes, I, Bef, St0) -> - %% We know that the 'after' body will never be executed. - %% But to keep the stack and register information up to date, - %% we will generate the code for the 'after' body, and then discard it. - Int1 = clear_dead(Bef, I, Tes#l.vdb), - {_,Int2,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb, - Int1#sr{reg=clear_regs(Int1#sr.reg)}, St0), - {[{wait,{f,St1#cg.recv}}],Int2,St1}; -cg_recv_wait({integer,0}, Tes, _I, Bef, St0) -> - {Tis,Int,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb, Bef, St0), - {[timeout|Tis],Int,St1}; -cg_recv_wait(Te, Tes, I, Bef, St0) -> - Reg = cg_reg_arg(Te, Bef), - %% Must have empty registers here! Bug if anything in registers. - Int0 = clear_dead(Bef, I, Tes#l.vdb), - {Tis,Int,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb, - Int0#sr{reg=clear_regs(Int0#sr.reg)}, St0), - {[{wait_timeout,{f,St1#cg.recv},Reg},timeout] ++ Tis,Int,St1}. - -%% recv_next_cg(Le, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}. -%% Use adjust stack to clear stack, but only need it for Aft. - -recv_next_cg(Le, Vdb, Bef, St) -> - {Sis,Aft} = adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb), - {[{loop_rec_end,{f,St#cg.recv}}] ++ Sis,Aft,St}. %Joke - -%% try_cg(TryBlock, [BodyVar], TryBody, [ExcpVar], TryHandler, [Ret], -%% Le, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}. - -try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St0) -> - {B,St1} = new_label(St0), %Body label - {H,St2} = new_label(St1), %Handler label - {E,St3} = new_label(St2), %End label - TryTag = Ta#l.i, - Int1 = Bef#sr{stk=put_catch(TryTag, Bef#sr.stk)}, - TryReg = fetch_stack({catch_tag,TryTag}, Int1#sr.stk), - {Ais,Int2,St4} = cg(Ta, Vdb, Int1, St3#cg{break=B,in_catch=true}), - Int3 = Int2#sr{stk=drop_catch(TryTag, Int2#sr.stk)}, - St5 = St4#cg{break=E,in_catch=St3#cg.in_catch}, - {Bis,Baft,St6} = cg(Tb, Vdb, Int3#sr{reg=load_vars(Vs, Int3#sr.reg)}, St5), - {His,Haft,St7} = cg(Th, Vdb, Int3#sr{reg=load_vars(Evs, Int3#sr.reg)}, St6), - Int4 = sr_merge(Baft, Haft), %Merge stack/registers - Aft = Int4#sr{reg=load_vars(Rs, Int4#sr.reg)}, - {[{'try',TryReg,{f,H}}] ++ Ais ++ - [{label,B},{try_end,TryReg}] ++ Bis ++ - [{label,H},{try_case,TryReg}] ++ His ++ - [{label,E}], - clear_dead(Aft, Le#l.i, Vdb), - St7#cg{break=St0#cg.break}}. - -%% catch_cg(CatchBlock, Ret, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. - -catch_cg(C, {var,R}, Le, Vdb, Bef, St0) -> - {B,St1} = new_label(St0), - CatchTag = Le#l.i, - Int1 = Bef#sr{stk=put_catch(CatchTag, Bef#sr.stk)}, - CatchReg = fetch_stack({catch_tag,CatchTag}, Int1#sr.stk), - {Cis,Int2,St2} = cg_block(C, Le#l.i, Le#l.vdb, Int1, - St1#cg{break=B,in_catch=true}), - Aft = Int2#sr{reg=load_reg(R, 0, Int2#sr.reg), - stk=drop_catch(CatchTag, Int2#sr.stk)}, - {[{'catch',CatchReg,{f,B}}] ++ Cis ++ - [{label,B},{catch_end,CatchReg}], - clear_dead(Aft, Le#l.i, Vdb), - St2#cg{break=St1#cg.break,in_catch=St1#cg.in_catch}}. - -%% set_cg([Var], Constr, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% We have to be careful how a 'set' works. First the structure is -%% built, then it is filled and finally things can be cleared. The -%% annotation must reflect this and make sure that the return -%% variable is allocated first. -%% -%% put_list for constructing a cons is an atomic instruction -%% which can safely resuse one of the source registers as target. -%% Also binaries can reuse a source register as target. - -set_cg([{var,R}], {cons,Es}, Le, Vdb, Bef, St) -> - [S1,S2] = map(fun ({var,V}) -> fetch_var(V, Bef); - (Other) -> Other - end, Es), - Int0 = clear_dead(Bef, Le#l.i, Vdb), - Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)}, - Ret = fetch_reg(R, Int1#sr.reg), - {[{put_list,S1,S2,Ret}], Int1, St}; -set_cg([{var,R}], {old_binary,Segs}, Le, Vdb, Bef, St) -> - Fail = bif_fail(St#cg.btype, St#cg.bfail, 42), - PutCode = cg_bin_put(Segs, Fail, Bef), - Code = cg_binary_old(PutCode), - Int0 = clear_dead(Bef, Le#l.i, Vdb), - Aft = Int0#sr{reg=put_reg(R, Int0#sr.reg)}, - Ret = fetch_reg(R, Aft#sr.reg), - {Code ++ [{bs_final,Fail,Ret}],Aft,St}; -set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, #cg{in_catch=InCatch}=St) -> - Int0 = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, - Target = fetch_reg(R, Int0#sr.reg), - Fail = bif_fail(St#cg.btype, St#cg.bfail, 42), - Temp = find_scratch_reg(Int0#sr.reg), - PutCode = cg_bin_put(Segs, Fail, Bef), - {Sis,Int1} = - case InCatch of - true -> adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Int0} - end, - Aft = clear_dead(Int1, Le#l.i, Vdb), - Code = cg_binary(PutCode, Target, Temp, Fail, Aft), - {Sis++Code,Aft,St}; -set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> - %% Find a place for the return register first. - Int = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, - Ret = fetch_reg(R, Int#sr.reg), - Ais = case Con of - {tuple,Es} -> - [{put_tuple,length(Es),Ret}] ++ cg_build_args(Es, Bef); - {var,V} -> % Normally removed by kernel optimizer. - [{move,fetch_var(V, Int),Ret}]; - {string,Str} -> - [{put_string,length(Str),{string,Str},Ret}]; - Other -> - [{move,Other,Ret}] - end, - {Ais,clear_dead(Int, Le#l.i, Vdb),St}; -set_cg([], {binary,Segs}, Le, Vdb, Bef, St) -> - Fail = bif_fail(St#cg.btype, St#cg.bfail, 42), - Target = find_scratch_reg(Bef#sr.reg), - Temp = find_scratch_reg(put_reg(Target, Bef#sr.reg)), - PutCode = cg_bin_put(Segs, Fail, Bef), - Code = cg_binary(PutCode, Target, Temp, Fail, Bef), - Aft = clear_dead(Bef, Le#l.i, Vdb), - {Code,Aft,St}; -set_cg([], {old_binary,Segs}, Le, Vdb, Bef, St) -> - Fail = bif_fail(St#cg.btype, St#cg.bfail, 42), - PutCode = cg_bin_put(Segs, Fail, Bef), - Ais0 = cg_binary_old(PutCode), - Ret = find_scratch_reg(Bef#sr.reg), - Ais = Ais0 ++ [{bs_final,Fail,Ret}], - {Ais,clear_dead(Bef, Le#l.i, Vdb),St}; -set_cg([], _, Le, Vdb, Bef, St) -> - %% This should have been stripped by compiler, just cleanup. - {[],clear_dead(Bef, Le#l.i, Vdb), St}. - - -%%% -%%% Code generation for constructing binaries. -%%% - -cg_binary(PutCode, Target, Temp, Fail, Bef) -> - SzCode = cg_binary_size(PutCode, Target, Temp, Fail), - MaxRegs = max_reg(Bef#sr.reg), - Code = SzCode ++ [{bs_init2,Fail,Target,MaxRegs,{field_flags,[]},Target}|PutCode], - cg_bin_opt(Code). - -cg_binary_size(PutCode, Target, Temp, Fail) -> - Szs = cg_binary_size_1(PutCode, 0, []), - cg_binary_size_expr(Szs, Target, Temp, Fail). - -cg_binary_size_1([{_Put,_Fail,S,U,_Flags,Src}|T], Bits, Acc) -> - cg_binary_size_2(S, U, Src, T, Bits, Acc); -cg_binary_size_1([], Bits, Acc) -> - Bytes = Bits div 8, - RemBits = Bits rem 8, - Res = sort([{1,{integer,RemBits}},{8,{integer,Bytes}}|Acc]), - cg_binary_size_3(Res). - -cg_binary_size_2({integer,N}, U, _, Next, Bits, Acc) -> - cg_binary_size_1(Next, Bits+N*U, Acc); -cg_binary_size_2({atom,all}, 8, E, Next, Bits, Acc) -> - cg_binary_size_1(Next, Bits, [{8,{size,E}}|Acc]); -cg_binary_size_2(Reg, 1, _, Next, Bits, Acc) -> - cg_binary_size_1(Next, Bits, [{1,Reg}|Acc]); -cg_binary_size_2(Reg, 8, _, Next, Bits, Acc) -> - cg_binary_size_1(Next, Bits, [{8,Reg}|Acc]); -cg_binary_size_2(Reg, U, _, Next, Bits, Acc) -> - cg_binary_size_1(Next, Bits, [{1,{'*',Reg,U}}|Acc]). - -cg_binary_size_3([{_,{integer,0}}|T]) -> - cg_binary_size_3(T); -cg_binary_size_3([{U,S1},{U,S2}|T]) -> - {L0,Rest} = cg_binary_size_4(T, U, []), - L = [S1,S2|L0], - [{U,L}|cg_binary_size_3(Rest)]; -cg_binary_size_3([{U,S}|T]) -> - [{U,[S]}|cg_binary_size_3(T)]; -cg_binary_size_3([]) -> []. - -cg_binary_size_4([{U,S}|T], U, Acc) -> - cg_binary_size_4(T, U, [S|Acc]); -cg_binary_size_4(T, _, Acc) -> - {Acc,T}. - -%% cg_binary_size_expr/4 -%% Generate code for calculating the resulting size of a binary. -cg_binary_size_expr(Sizes, Target, Temp, Fail) -> - cg_binary_size_expr_1(Sizes, Target, Temp, Fail, - [{move,{integer,0},Target}]). - -cg_binary_size_expr_1([{1,E0}|T], Target, Temp, Fail, Acc) -> - E1 = cg_gen_binsize(E0, Target, Temp, Fail, Acc), - E = [{bs_bits_to_bytes,Fail,Target,Target}|E1], - cg_binary_size_expr_1(T, Target, Temp, Fail, E); -cg_binary_size_expr_1([{8,E0}], Target, Temp, Fail, Acc) -> - E = cg_gen_binsize(E0, Target, Temp, Fail, Acc), - reverse(E); -cg_binary_size_expr_1([], _, _, _, Acc) -> reverse(Acc). - -cg_gen_binsize([{'*',A,B}|T], Target, Temp, Fail, Acc) -> - cg_gen_binsize(T, Target, Temp, Fail, - [{bs_add,Fail,[Target,A,B],Target}|Acc]); -cg_gen_binsize([{size,B}|T], Target, Temp, Fail, Acc) -> - cg_gen_binsize([Temp|T], Target, Temp, Fail, - [{bif,size,Fail,[B],Temp}|Acc]); -cg_gen_binsize([E0|T], Target, Temp, Fail, Acc) -> - cg_gen_binsize(T, Target, Temp, Fail, - [{bs_add,Fail,[Target,E0,1],Target}|Acc]); -cg_gen_binsize([], _, _, _, Acc) -> Acc. - -%% cg_bin_opt(Code0) -> Code -%% Optimize the size calculations for binary construction. - -cg_bin_opt([{move,{integer,0},D},{bs_add,_,[D,{integer,_}=S,1],Dst}|Is]) -> - cg_bin_opt([{move,S,Dst}|Is]); -cg_bin_opt([{move,{integer,0},D},{bs_add,Fail,[D,S,U],Dst}|Is]) -> - cg_bin_opt([{bs_add,Fail,[{integer,0},S,U],Dst}|Is]); -cg_bin_opt([{move,{integer,Bytes},D},{bs_init2,Fail,D,Regs0,Flags,D}|Is]) -> - Regs = cg_bo_newregs(Regs0, D), - cg_bin_opt([{bs_init2,Fail,Bytes,Regs,Flags,D}|Is]); -cg_bin_opt([{move,Src,D},{bs_init2,Fail,D,Regs0,Flags,D}|Is]) -> - Regs = cg_bo_newregs(Regs0, D), - cg_bin_opt([{bs_init2,Fail,Src,Regs,Flags,D}|Is]); -cg_bin_opt([{move,Src,Dst},{bs_bits_to_bytes,Fail,Dst,Dst}|Is]) -> - cg_bin_opt([{bs_bits_to_bytes,Fail,Src,Dst}|Is]); -cg_bin_opt([{move,Src1,Dst},{bs_add,Fail,[Dst,Src2,U],Dst}|Is]) -> - cg_bin_opt([{bs_add,Fail,[Src1,Src2,U],Dst}|Is]); -cg_bin_opt([{bs_bits_to_bytes,Fail,{integer,N},_}|Is0]) when N rem 8 =/= 0 -> - case Fail of - {f,0} -> - Is = [{move,{atom,badarg},{x,0}}, - {call_ext_only,1,{extfunc,erlang,error,1}}|Is0], - cg_bin_opt(Is); - _ -> - cg_bin_opt([{jump,Fail}|Is0]) - end; -cg_bin_opt([I|Is]) -> - [I|cg_bin_opt(Is)]; -cg_bin_opt([]) -> []. - -cg_bo_newregs(R, {x,X}) when R-1 =:= X -> R-1; -cg_bo_newregs(R, _) -> R. - -%% Common for new and old binary code generation. - -cg_bin_put({bin_seg,S0,U,T,Fs,[E0,Next]}, Fail, Bef) -> - S1 = case S0 of - {var,Sv} -> fetch_var(Sv, Bef); - _ -> S0 - end, - E1 = case E0 of - {var,V} -> fetch_var(V, Bef); - Other -> Other - end, - Op = case T of - integer -> bs_put_integer; - binary -> bs_put_binary; - float -> bs_put_float - end, - [{Op,Fail,S1,U,{field_flags,Fs},E1}|cg_bin_put(Next, Fail, Bef)]; -cg_bin_put(bin_end, _, _) -> []. - -%% Old style. - -cg_binary_old(PutCode) -> - [cg_bs_init(PutCode)] ++ need_bin_buf(PutCode). - -cg_bs_init(Code) -> - {Size,Fs} = foldl(fun ({_,_,{integer,N},U,_,_}, {S,Fs}) -> - {S + N*U,Fs}; - (_, {S,_}) -> - {S,[]} - end, {0,[exact]}, Code), - {bs_init,(Size+7) div 8,{field_flags,Fs}}. - -need_bin_buf(Code0) -> - {Code1,F,H} = foldr(fun ({_,_,{integer,N},U,_,_}=Bs, {Code,F,H}) -> - {[Bs|Code],F,H + N*U}; - ({_,_,_,_,_,_}=Bs, {Code,F,H}) -> - {[Bs|need_bin_buf_need(H, F, Code)],true,0} - end, {[],false,0}, Code0), - need_bin_buf_need(H, F, Code1). - -need_bin_buf_need(0, false, Rest) -> Rest; -need_bin_buf_need(H, _, Rest) -> [{bs_need_buf,H}|Rest]. - -cg_build_args(As, Bef) -> - map(fun ({var,V}) -> {put,fetch_var(V, Bef)}; - (Other) -> {put,Other} - end, As). - -%% return_cg([Val], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% break_cg([Val], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% These are very simple, just put return/break values in registers -%% from 0, then return/break. Use the call setup to clean up stack, -%% but must clear registers to ensure sr_merge works correctly. - -return_cg(Rs, Le, Vdb, Bef, St) -> - {Ms,Int} = cg_setup_call(Rs, Bef, Le#l.i, Vdb), - {comment({return,Rs}) ++ Ms ++ [return], - Int#sr{reg=clear_regs(Int#sr.reg)},St}. - -break_cg(Bs, Le, Vdb, Bef, St) -> - {Ms,Int} = cg_setup_call(Bs, Bef, Le#l.i, Vdb), - {comment({break,Bs}) ++ Ms ++ [{jump,{f,St#cg.break}}], - Int#sr{reg=clear_regs(Int#sr.reg)},St}. - -%% cg_reg_arg(Arg0, Info) -> Arg -%% cg_reg_args([Arg0], Info) -> [Arg] -%% Convert argument[s] into registers. Literal values are returned unchanged. - -cg_reg_args(As, Bef) -> [cg_reg_arg(A, Bef) || A <- As]. - -cg_reg_arg({var,V}, Bef) -> fetch_var(V, Bef); -cg_reg_arg(Literal, _) -> Literal. - -%% cg_setup_call([Arg], Bef, Cur, Vdb) -> {[Instr],Aft}. -%% Do the complete setup for a call/enter. - -cg_setup_call(As, Bef, I, Vdb) -> - {Ms,Int0} = cg_call_args(As, Bef, I, Vdb), - %% Have set up arguments, can now clean up, compress and save to stack. - Int1 = Int0#sr{stk=clear_dead_stk(Int0#sr.stk, I, Vdb),res=[]}, - {Sis,Int2} = adjust_stack(Int1, I, I+1, Vdb), - {Ms ++ Sis ++ [{'%live',length(As)}],Int2}. - -%% cg_call_args([Arg], SrState) -> {[Instr],SrState}. -%% Setup the arguments to a call/enter/bif. Put the arguments into -%% consecutive registers starting at {x,0} moving any data which -%% needs to be saved. Return a modified SrState structure with the -%% new register contents. N.B. the resultant register info will -%% contain non-variable values when there are non-variable values. -%% -%% This routine is complicated by unsaved values in x registers. -%% We'll move away any unsaved values that are in the registers -%% to be overwritten by the arguments. - -cg_call_args(As, Bef, I, Vdb) -> - Regs0 = load_arg_regs(Bef#sr.reg, As), - Unsaved = unsaved_registers(Regs0, Bef#sr.stk, I, I+1, Vdb), - {UnsavedMoves,Regs} = move_unsaved(Unsaved, Bef#sr.reg, Regs0), - Moves0 = gen_moves(As, Bef), - Moves = order_moves(Moves0, find_scratch_reg(Regs)), - {UnsavedMoves ++ Moves,Bef#sr{reg=Regs}}. - -%% load_arg_regs([Reg], Arguments) -> [Reg] -%% Update the register descriptor to include the arguments (from {x,0} -%% and upwards). Values in argument register are overwritten. -%% Values in x registers above the arguments are preserved. - -load_arg_regs(Regs, As) -> load_arg_regs(Regs, As, 0). - -load_arg_regs([_|Rs], [{var,V}|As], I) -> [{I,V}|load_arg_regs(Rs, As, I+1)]; -load_arg_regs([_|Rs], [A|As], I) -> [{I,A}|load_arg_regs(Rs, As, I+1)]; -load_arg_regs([], [{var,V}|As], I) -> [{I,V}|load_arg_regs([], As, I+1)]; -load_arg_regs([], [A|As], I) -> [{I,A}|load_arg_regs([], As, I+1)]; -load_arg_regs(Rs, [], _) -> Rs. - -%% Returns the variables must be saved and are currently in the -%% x registers that are about to be overwritten by the arguments. - -unsaved_registers(Regs, Stk, Fb, Lf, Vdb) -> - [V || {V,F,L} <- Vdb, - F < Fb, - L >= Lf, - not on_stack(V, Stk), - not in_reg(V, Regs)]. - -in_reg(V, Regs) -> keymember(V, 2, Regs). - -%% Move away unsaved variables from the registers that are to be -%% overwritten by the arguments. -move_unsaved(Vs, OrigRegs, NewRegs) -> - move_unsaved(Vs, OrigRegs, NewRegs, []). - -move_unsaved([V|Vs], OrigRegs, NewRegs0, Acc) -> - NewRegs = put_reg(V, NewRegs0), - Src = fetch_reg(V, OrigRegs), - Dst = fetch_reg(V, NewRegs), - move_unsaved(Vs, OrigRegs, NewRegs, [{move,Src,Dst}|Acc]); -move_unsaved([], _, Regs, Acc) -> {Acc,Regs}. - -%% gen_moves(As, Sr) -%% Generate the basic move instruction to move the arguments -%% to their proper registers. The list will be sorted on -%% destinations. (I.e. the move to {x,0} will be first -- -%% see the comment to order_moves/2.) - -gen_moves(As, Sr) -> gen_moves(As, Sr, 0, []). - -gen_moves([{var,V}|As], Sr, I, Acc) -> - case fetch_var(V, Sr) of - {x,I} -> gen_moves(As, Sr, I+1, Acc); - Reg -> gen_moves(As, Sr, I+1, [{move,Reg,{x,I}}|Acc]) - end; -gen_moves([A|As], Sr, I, Acc) -> - gen_moves(As, Sr, I+1, [{move,A,{x,I}}|Acc]); -gen_moves([], _, _, Acc) -> lists:keysort(3, Acc). - -%% order_moves([Move], ScratchReg) -> [Move] -%% Orders move instruction so that source registers are not -%% destroyed before they are used. If there are cycles -%% (such as {move,{x,0},{x,1}}, {move,{x,1},{x,1}}), -%% the scratch register is used to break up the cycle. -%% If possible, the first move of the input list is placed -%% last in the result list (to make the move to {x,0} occur -%% just before the call to allow the Beam loader to coalesce -%% the instructions). - -order_moves(Ms, Scr) -> order_moves(Ms, Scr, []). - -order_moves([{move,_,_}=M|Ms0], ScrReg, Acc0) -> - {Chain,Ms} = collect_chain(Ms0, [M], ScrReg), - Acc = reverse(Chain, Acc0), - order_moves(Ms, ScrReg, Acc); -order_moves([], _, Acc) -> Acc. - -collect_chain(Ms, Path, ScrReg) -> - collect_chain(Ms, Path, [], ScrReg). - -collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others, ScrReg) -> - case keysearch(Src, 3, Path) of - {value,_} -> %We have a cycle. - {break_up_cycle(M, Path, ScrReg),reverse(Others, Ms0)}; - false -> - collect_chain(reverse(Others, Ms0), [M|Path], [], ScrReg) - end; -collect_chain([M|Ms], Path, Others, ScrReg) -> - collect_chain(Ms, Path, [M|Others], ScrReg); -collect_chain([], Path, Others, _) -> - {Path,Others}. - -break_up_cycle({move,Src,_}=M, Path, ScrReg) -> - [{move,ScrReg,Src},M|break_up_cycle1(Src, Path, ScrReg)]. - -break_up_cycle1(Dst, [{move,Src,Dst}|Path], ScrReg) -> - [{move,Src,ScrReg}|Path]; -break_up_cycle1(Dst, [M|Path], LastMove) -> - [M|break_up_cycle1(Dst, Path, LastMove)]. - -%% clear_dead(Sr, Until, Vdb) -> Aft. -%% Remove all variables in Sr which have died AT ALL so far. - -clear_dead(Sr, Until, Vdb) -> - Sr#sr{reg=clear_dead_reg(Sr, Until, Vdb), - stk=clear_dead_stk(Sr#sr.stk, Until, Vdb)}. - -clear_dead_reg(Sr, Until, Vdb) -> - Reg = map(fun ({I,V}) -> - case vdb_find(V, Vdb) of - {V,_,L} when L > Until -> {I,V}; - _ -> free %Remove anything else - end; - ({reserved,I,V}) -> {reserved,I,V}; - (free) -> free - end, Sr#sr.reg), - reserve(Sr#sr.res, Reg, Sr#sr.stk). - -clear_dead_stk(Stk, Until, Vdb) -> - map(fun ({V}) -> - case vdb_find(V, Vdb) of - {V,_,L} when L > Until -> {V}; - _ -> dead %Remove anything else - end; - (free) -> free; - (dead) -> dead - end, Stk). - -%% sr_merge(Sr1, Sr2) -> Sr. -%% Merge two stack/register states keeping the longest of both stack -%% and register. Perform consistency check on both, elements must be -%% the same. Allow frame size 'void' to make easy creation of -%% "empty" frame. - -sr_merge(#sr{reg=R1,stk=S1,res=[]}, #sr{reg=R2,stk=S2,res=[]}) -> - #sr{reg=longest(R1, R2),stk=longest(S1, S2),res=[]}; -sr_merge(void, S2) -> S2#sr{res=[]}; -sr_merge(S1, void) -> S1#sr{res=[]}. - -longest([H|T1], [H|T2]) -> [H|longest(T1, T2)]; -longest([dead|T1], [free|T2]) -> [dead|longest(T1, T2)]; -longest([free|T1], [dead|T2]) -> [dead|longest(T1, T2)]; -longest([dead|T1], []) -> [dead|T1]; -longest([], [dead|T2]) -> [dead|T2]; -longest([free|T1], []) -> [free|T1]; -longest([], [free|T2]) -> [free|T2]; -longest([], []) -> []. - -%% adjust_stack(Bef, FirstBefore, LastFrom, Vdb) -> {[Ainstr],Aft}. -%% Do complete stack adjustment by compressing stack and adding -%% variables to be saved. Try to optimise ordering on stack by -%% having reverse order to their lifetimes. -%% -%% In Beam, there is a fixed stack frame and no need to do stack compression. - -adjust_stack(Bef, Fb, Lf, Vdb) -> - Stk0 = Bef#sr.stk, - {Stk1,Saves} = save_stack(Stk0, Fb, Lf, Vdb), - {saves(Saves, Bef#sr.reg, Stk1), - Bef#sr{stk=Stk1}}. - -%% save_stack(Stack, FirstBefore, LastFrom, Vdb) -> {[SaveVar],NewStack}. -%% Save variables which are used past current point and which are not -%% already on the stack. - -save_stack(Stk0, Fb, Lf, Vdb) -> - %% New variables that are in use but not on stack. - New = [ {V,F,L} || {V,F,L} <- Vdb, - F < Fb, - L >= Lf, - not on_stack(V, Stk0) ], - %% Add new variables that are not just dropped immediately. - %% N.B. foldr works backwards from the end!! - Saves = [ V || {V,_,_} <- keysort(3, New) ], - Stk1 = foldr(fun (V, Stk) -> put_stack(V, Stk) end, Stk0, Saves), - {Stk1,Saves}. - -%% saves([SaveVar], Reg, Stk) -> [{move,Reg,Stk}]. -%% Generate move instructions to save variables onto stack. The -%% stack/reg info used is that after the new stack has been made. - -saves(Ss, Reg, Stk) -> - Res = map(fun (V) -> - {move,fetch_reg(V, Reg),fetch_stack(V, Stk)} - end, Ss), - Res. - -%% comment(C) -> ['%'{C}]. - -%comment(C) -> [{'%',C}]. -comment(_) -> []. - -%% fetch_var(VarName, StkReg) -> r{R} | sp{Sp}. -%% find_var(VarName, StkReg) -> ok{r{R} | sp{Sp}} | error. -%% Fetch/find a variable in either the registers or on the -%% stack. Fetch KNOWS it's there. - -fetch_var(V, Sr) -> - case find_reg(V, Sr#sr.reg) of - {ok,R} -> R; - error -> fetch_stack(V, Sr#sr.stk) - end. - -% find_var(V, Sr) -> -% case find_reg(V, Sr#sr.reg) of -% {ok,R} -> {ok,R}; -% error -> -% case find_stack(V, Sr#sr.stk) of -% {ok,S} -> {ok,S}; -% error -> error -% end -% end. - -load_vars(Vs, Regs) -> - foldl(fun ({var,V}, Rs) -> put_reg(V, Rs) end, Regs, Vs). - -%% put_reg(Val, Regs) -> Regs. -%% load_reg(Val, Reg, Regs) -> Regs. -%% free_reg(Val, Regs) -> Regs. -%% find_reg(Val, Regs) -> ok{r{R}} | error. -%% fetch_reg(Val, Regs) -> r{R}. -%% Functions to interface the registers. -%% put_reg puts a value into a free register, -%% load_reg loads a value into a fixed register -%% free_reg frees a register containing a specific value. - -% put_regs(Vs, Rs) -> foldl(fun put_reg/2, Rs, Vs). - -put_reg(V, Rs) -> put_reg_1(V, Rs, 0). - -put_reg_1(V, [free|Rs], I) -> [{I,V}|Rs]; -put_reg_1(V, [{reserved,I,V}|Rs], I) -> [{I,V}|Rs]; -put_reg_1(V, [R|Rs], I) -> [R|put_reg_1(V, Rs, I+1)]; -put_reg_1(V, [], I) -> [{I,V}]. - -load_reg(V, R, Rs) -> load_reg_1(V, R, Rs, 0). - -load_reg_1(V, I, [_|Rs], I) -> [{I,V}|Rs]; -load_reg_1(V, I, [R|Rs], C) -> [R|load_reg_1(V, I, Rs, C+1)]; -load_reg_1(V, I, [], I) -> [{I,V}]; -load_reg_1(V, I, [], C) -> [free|load_reg_1(V, I, [], C+1)]. - -% free_reg(V, [{I,V}|Rs]) -> [free|Rs]; -% free_reg(V, [R|Rs]) -> [R|free_reg(V, Rs)]; -% free_reg(V, []) -> []. - -fetch_reg(V, [{I,V}|_]) -> {x,I}; -fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). - -find_reg(V, [{I,V}|_]) -> {ok,{x,I}}; -find_reg(V, [_|SRs]) -> find_reg(V, SRs); -find_reg(_, []) -> error. - -%% For the bit syntax, we need a scratch register if we are constructing -%% a binary that will not be used. - -find_scratch_reg(Rs) -> find_scratch_reg(Rs, 0). - -find_scratch_reg([free|_], I) -> {x,I}; -find_scratch_reg([_|Rs], I) -> find_scratch_reg(Rs, I+1); -find_scratch_reg([], I) -> {x,I}. - -%%copy_reg(Val, R, Regs) -> load_reg(Val, R, Regs). -%%move_reg(Val, R, Regs) -> load_reg(Val, R, free_reg(Val, Regs)). - -%%clear_regs(Regs) -> map(fun (R) -> free end, Regs). -clear_regs(_) -> []. - -max_reg(Regs) -> - foldl(fun ({I,_}, _) -> I; - (_, Max) -> Max end, - -1, Regs) + 1. - -%% put_stack(Val, [{Val}]) -> [{Val}]. -%% fetch_stack(Var, Stk) -> sp{S}. -%% find_stack(Var, Stk) -> ok{sp{S}} | error. -%% Functions to interface the stack. - -put_stack(Val, []) -> [{Val}]; -put_stack(Val, [dead|Stk]) -> [{Val}|Stk]; -put_stack(Val, [free|Stk]) -> [{Val}|Stk]; -put_stack(Val, [NotFree|Stk]) -> [NotFree|put_stack(Val, Stk)]. - -put_stack_carefully(Val, Stk0) -> - case catch put_stack_carefully1(Val, Stk0) of - error -> error; - Stk1 when list(Stk1) -> Stk1 - end. - -put_stack_carefully1(_, []) -> throw(error); -put_stack_carefully1(Val, [dead|Stk]) -> [{Val}|Stk]; -put_stack_carefully1(Val, [free|Stk]) -> [{Val}|Stk]; -put_stack_carefully1(Val, [NotFree|Stk]) -> - [NotFree|put_stack_carefully1(Val, Stk)]. - -fetch_stack(Var, Stk) -> fetch_stack(Var, Stk, 0). - -fetch_stack(V, [{V}|_], I) -> {yy,I}; -fetch_stack(V, [_|Stk], I) -> fetch_stack(V, Stk, I+1). - -% find_stack(Var, Stk) -> find_stack(Var, Stk, 0). - -% find_stack(V, [{V}|Stk], I) -> {ok,{yy,I}}; -% find_stack(V, [O|Stk], I) -> find_stack(V, Stk, I+1); -% find_stack(V, [], I) -> error. - -on_stack(V, Stk) -> keymember(V, 1, Stk). - -%% put_catch(CatchTag, Stack) -> Stack' -%% drop_catch(CatchTag, Stack) -> Stack' -%% Special interface for putting and removing catch tags, to ensure that -%% catches nest properly. Also used for try tags. - -put_catch(Tag, Stk0) -> put_catch(Tag, reverse(Stk0), []). - -put_catch(Tag, [], Stk) -> - put_stack({catch_tag,Tag}, Stk); -put_catch(Tag, [{{catch_tag,_}}|_]=RevStk, Stk) -> - reverse(RevStk, put_stack({catch_tag,Tag}, Stk)); -put_catch(Tag, [Other|Stk], Acc) -> - put_catch(Tag, Stk, [Other|Acc]). - -drop_catch(Tag, [{{catch_tag,Tag}}|Stk]) -> [free|Stk]; -drop_catch(Tag, [Other|Stk]) -> [Other|drop_catch(Tag, Stk)]. - -%%% -%%% Finish the code generation for the bit syntax matching. -%%% - -bs_function({function,Name,Arity,CLabel,Asm0}=Func) -> - case bs_needed(Asm0, 0, false, []) of - {false,[]} -> Func; - {true,Dict} -> - Asm = bs_replace(Asm0, Dict, []), - {function,Name,Arity,CLabel,Asm} - end. - -%%% -%%% Pass 1: Found out which bs_restore's that are needed. For now we assume -%%% that a bs_restore is needed unless it is directly preceeded by a bs_save. -%%% - -bs_needed([{bs_save,Name},{bs_restore,Name}|T], N, _BsUsed, Dict) -> - bs_needed(T, N, true, Dict); -bs_needed([{bs_save,_Name}|T], N, _BsUsed, Dict) -> - bs_needed(T, N, true, Dict); -bs_needed([{bs_restore,Name}|T], N, _BsUsed, Dict) -> - case keysearch(Name, 1, Dict) of - {value,{Name,_}} -> bs_needed(T, N, true, Dict); - false -> bs_needed(T, N+1, true, [{Name,N}|Dict]) - end; -bs_needed([{bs_init,_,_}|T], N, _, Dict) -> - bs_needed(T, N, true, Dict); -bs_needed([{bs_init2,_,_,_,_,_}|T], N, _, Dict) -> - bs_needed(T, N, true, Dict); -bs_needed([{bs_start_match,_,_}|T], N, _, Dict) -> - bs_needed(T, N, true, Dict); -bs_needed([_|T], N, BsUsed, Dict) -> - bs_needed(T, N, BsUsed, Dict); -bs_needed([], _, BsUsed, Dict) -> {BsUsed,Dict}. - -%%% -%%% Pass 2: Only needed if there were some bs_* instructions found. -%%% -%%% Remove any bs_save with a name that never were found to be restored -%%% in the first pass. -%%% - -bs_replace([{bs_save,Name}=Save,{bs_restore,Name}|T], Dict, Acc) -> - bs_replace([Save|T], Dict, Acc); -bs_replace([{bs_save,Name}|T], Dict, Acc) -> - case keysearch(Name, 1, Dict) of - {value,{Name,N}} -> - bs_replace(T, Dict, [{bs_save,N}|Acc]); - false -> - bs_replace(T, Dict, Acc) - end; -bs_replace([{bs_restore,Name}|T], Dict, Acc) -> - case keysearch(Name, 1, Dict) of - {value,{Name,N}} -> - bs_replace(T, Dict, [{bs_restore,N}|Acc]); - false -> - bs_replace(T, Dict, Acc) - end; -bs_replace([{bs_init2,Fail,Bytes,Regs,Flags,Dst}|T0], Dict, Acc) -> - case bs_find_test_heap(T0) of - none -> - bs_replace(T0, Dict, [{bs_init2,Fail,Bytes,0,Regs,Flags,Dst}|Acc]); - {T,Words} -> - bs_replace(T, Dict, [{bs_init2,Fail,Bytes,Words,Regs,Flags,Dst}|Acc]) - end; -bs_replace([H|T], Dict, Acc) -> - bs_replace(T, Dict, [H|Acc]); -bs_replace([], _, Acc) -> reverse(Acc). - -bs_find_test_heap(Is) -> - bs_find_test_heap_1(Is, []). - -bs_find_test_heap_1([{bs_put_integer,_,_,_,_,_}=I|Is], Acc) -> - bs_find_test_heap_1(Is, [I|Acc]); -bs_find_test_heap_1([{bs_put_float,_,_,_,_,_}=I|Is], Acc) -> - bs_find_test_heap_1(Is, [I|Acc]); -bs_find_test_heap_1([{bs_put_binary,_,_,_,_,_}=I|Is], Acc) -> - bs_find_test_heap_1(Is, [I|Acc]); -bs_find_test_heap_1([{test_heap,Words,_}|Is], Acc) -> - {reverse(Acc, Is),Words}; -bs_find_test_heap_1(_, _) -> none. - -%% new_label(St) -> {L,St}. - -new_label(St) -> - L = St#cg.lcount, - {L,St#cg{lcount=L+1}}. - -flatmapfoldl(F, Accu0, [Hd|Tail]) -> - {R,Accu1} = F(Hd, Accu0), - {Rs,Accu2} = flatmapfoldl(F, Accu1, Tail), - {R++Rs,Accu2}; -flatmapfoldl(_, Accu, []) -> {[],Accu}. - -flatmapfoldr(F, Accu0, [Hd|Tail]) -> - {Rs,Accu1} = flatmapfoldr(F, Accu0, Tail), - {R,Accu2} = F(Hd, Accu1), - {R++Rs,Accu2}; -flatmapfoldr(_, Accu, []) -> {[],Accu}. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_core.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_core.erl deleted file mode 100644 index b561182932..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_core.erl +++ /dev/null @@ -1,1320 +0,0 @@ -%% ``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 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. -%% -%% 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: v3_core.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $ -%% -%% Purpose : Transform normal Erlang to Core Erlang - -%% At this stage all preprocessing has been done. All that is left are -%% "pure" Erlang functions. -%% -%% Core transformation is done in three stages: -%% -%% 1. Flatten expressions into an internal core form without doing -%% matching. -%% -%% 2. Step "forwards" over the icore code annotating each "top-level" -%% thing with variable usage. Detect bound variables in matching -%% and replace with explicit guard test. Annotate "internal-core" -%% expressions with variables they use and create. Convert matches -%% to cases when not pure assignments. -%% -%% 3. Step "backwards" over icore code using variable usage -%% annotations to change implicit exported variables to explicit -%% returns. -%% -%% To ensure the evaluation order we ensure that all arguments are -%% safe. A "safe" is basically a core_lib simple with VERY restricted -%% binaries. -%% -%% We have to be very careful with matches as these create variables. -%% While we try not to flatten things more than necessary we must make -%% sure that all matches are at the top level. For this we use the -%% type "novars" which are non-match expressions. Cases and receives -%% can also create problems due to exports variables so they are not -%% "novars" either. I.e. a novars will not export variables. -%% -%% Annotations in the #iset, #iletrec, and all other internal records -%% is kept in a record, #a, not in a list as in proper core. This is -%% easier and faster and creates no problems as we have complete control -%% over all annotations. -%% -%% On output, the annotation for most Core Erlang terms will contain -%% the source line number. A few terms will be marked with the atom -%% atom 'compiler_generated', to indicate that the compiler has generated -%% them and that no warning should be generated if they are optimized -%% away. -%% -%% -%% In this translation: -%% -%% call ops are safes -%% call arguments are safes -%% match arguments are novars -%% case arguments are novars -%% receive timeouts are novars -%% let/set arguments are expressions -%% fun is not a safe - --module(v3_core). - --export([module/2,format_error/1]). - --import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2]). --import(ordsets, [add_element/2,del_element/2,is_element/2, - union/1,union/2,intersection/2,subtract/2]). - --include("core_parse.hrl"). - --record(a, {us=[],ns=[],anno=[]}). %Internal annotation - -%% Internal core expressions and help functions. -%% N.B. annotations fields in place as normal Core expressions. - --record(iset, {anno=#a{},var,arg}). --record(iletrec, {anno=#a{},defs,body}). --record(imatch, {anno=#a{},pat,guard=[],arg,fc}). --record(icase, {anno=#a{},args,clauses,fc}). --record(iclause, {anno=#a{},pats,pguard=[],guard,body}). --record(ifun, {anno=#a{},id,vars,clauses,fc}). --record(iapply, {anno=#a{},op,args}). --record(icall, {anno=#a{},module,name,args}). --record(iprimop, {anno=#a{},name,args}). --record(itry, {anno=#a{},args,vars,body,evars,handler}). --record(icatch, {anno=#a{},body}). --record(ireceive1, {anno=#a{},clauses}). --record(ireceive2, {anno=#a{},clauses,timeout,action}). --record(iprotect, {anno=#a{},body}). --record(ibinary, {anno=#a{},segments}). %Not used in patterns. - --record(core, {vcount=0, %Variable counter - fcount=0, %Function counter - ws=[]}). %Warnings. - -module({Mod,Exp,Forms}, _Opts) -> - Cexp = map(fun ({N,A}) -> #c_fname{id=N,arity=A} end, Exp), - {Kfs,As,Ws} = foldr(fun form/2, {[],[],[]}, Forms), - {ok,#c_module{name=#c_atom{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws}. - -form({function,_,_,_,_}=F0, {Fs,As,Ws0}) -> - {F,Ws} = function(F0, Ws0), - {[F|Fs],As,Ws}; -form({attribute,_,_,_}=F, {Fs,As,Ws}) -> - {Fs,[attribute(F)|As],Ws}. - -attribute({attribute,_,Name,Val}) -> - #c_def{name=core_lib:make_literal(Name), - val=core_lib:make_literal(Val)}. - -function({function,_,Name,Arity,Cs0}, Ws0) -> - %%ok = io:fwrite("~p - ", [{Name,Arity}]), - St0 = #core{vcount=0,ws=Ws0}, - {B0,St1} = body(Cs0, Arity, St0), - %%ok = io:fwrite("1", []), - %%ok = io:fwrite("~w:~p~n", [?LINE,B0]), - {B1,St2} = ubody(B0, St1), - %%ok = io:fwrite("2", []), - %%ok = io:fwrite("~w:~p~n", [?LINE,B1]), - {B2,#core{ws=Ws}} = cbody(B1, St2), - %%ok = io:fwrite("3~n", []), - {#c_def{name=#c_fname{id=Name,arity=Arity},val=B2},Ws}. - -body(Cs0, Arity, St0) -> - Anno = [element(2, hd(Cs0))], - {Args,St1} = new_vars(Anno, Arity, St0), - {Cs1,St2} = clauses(Cs0, St1), - {Ps,St3} = new_vars(Arity, St2), %Need new variables here - Fc = fail_clause(Ps, #c_tuple{es=[#c_atom{val=function_clause}|Ps]}), - {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}. - -%% clause(Clause, State) -> {Cclause,State} | noclause. -%% clauses([Clause], State) -> {[Cclause],State}. -%% Convert clauses. Trap bad pattern aliases and remove clause from -%% clause list. - -clauses([C0|Cs0], St0) -> - case clause(C0, St0) of - {noclause,St} -> clauses(Cs0, St); - {C,St1} -> - {Cs,St2} = clauses(Cs0, St1), - {[C|Cs],St2} - end; -clauses([], St) -> {[],St}. - -clause({clause,Lc,H0,G0,B0}, St0) -> - case catch head(H0) of - {'EXIT',_}=Exit -> exit(Exit); %Propagate error - nomatch -> - St = add_warning(Lc, nomatch, St0), - {noclause,St}; %Bad pattern - H1 -> - {G1,St1} = guard(G0, St0), - {B1,St2} = exprs(B0, St1), - {#iclause{anno=#a{anno=[Lc]},pats=H1,guard=G1,body=B1},St2} - end. - -%% head([P]) -> [P]. - -head(Ps) -> pattern_list(Ps). - -%% guard([Expr], State) -> {[Cexpr],State}. -%% Build an explict and/or tree of guard alternatives, then traverse -%% top-level and/or tree and "protect" inner tests. - -guard([], St) -> {[],St}; -guard(Gs0, St) -> - Gs = foldr(fun (Gt0, Rhs) -> - Gt1 = guard_tests(Gt0), - L = element(2, Gt1), - {op,L,'or',Gt1,Rhs} - end, guard_tests(last(Gs0)), first(Gs0)), - gexpr_top(Gs, St). - -guard_tests([]) -> []; -guard_tests(Gs) -> - L = element(2, hd(Gs)), - {protect,L,foldr(fun (G, Rhs) -> {op,L,'and',G,Rhs} end, last(Gs), first(Gs))}. - -%% gexpr_top(Expr, State) -> {Cexpr,State}. -%% Generate an internal core expression of a guard test. Explicitly -%% handle outer boolean expressions and "protect" inner tests in a -%% reasonably smart way. - -gexpr_top(E0, St0) -> - {E1,Eps0,Bools,St1} = gexpr(E0, [], St0), - {E,Eps,St} = force_booleans(Bools, E1, Eps0, St1), - {Eps++[E],St}. - -%% gexpr(Expr, Bools, State) -> {Cexpr,[PreExp],Bools,State}. -%% Generate an internal core expression of a guard test. - -gexpr({protect,Line,Arg}, Bools0, St0) -> - case gexpr(Arg, [], St0) of - {E0,[],Bools,St1} -> - {E,Eps,St} = force_booleans(Bools, E0, [], St1), - {E,Eps,Bools0,St}; - {E0,Eps0,Bools,St1} -> - {E,Eps,St} = force_booleans(Bools, E0, Eps0, St1), - {#iprotect{anno=#a{anno=[Line]},body=Eps++[E]},[],Bools0,St} - end; -gexpr({op,Line,Op,L,R}=Call, Bools0, St0) -> - case erl_internal:bool_op(Op, 2) of - true -> - {Le,Lps,Bools1,St1} = gexpr(L, Bools0, St0), - {Ll,Llps,St2} = force_safe(Le, St1), - {Re,Rps,Bools,St3} = gexpr(R, Bools1, St2), - {Rl,Rlps,St4} = force_safe(Re, St3), - Anno = [Line], - {#icall{anno=#a{anno=Anno}, %Must have an #a{} - module=#c_atom{anno=Anno,val=erlang},name=#c_atom{anno=Anno,val=Op}, - args=[Ll,Rl]},Lps ++ Llps ++ Rps ++ Rlps,Bools,St4}; - false -> - gexpr_test(Call, Bools0, St0) - end; -gexpr({op,Line,Op,A}=Call, Bools0, St0) -> - case erl_internal:bool_op(Op, 1) of - true -> - {Ae,Aps,Bools,St1} = gexpr(A, Bools0, St0), - {Al,Alps,St2} = force_safe(Ae, St1), - Anno = [Line], - {#icall{anno=#a{anno=Anno}, %Must have an #a{} - module=#c_atom{anno=Anno,val=erlang},name=#c_atom{anno=Anno,val=Op}, - args=[Al]},Aps ++ Alps,Bools,St2}; - false -> - gexpr_test(Call, Bools0, St0) - end; -gexpr(E0, Bools, St0) -> - gexpr_test(E0, Bools, St0). - -%% gexpr_test(Expr, Bools, State) -> {Cexpr,[PreExp],Bools,State}. -%% Generate a guard test. At this stage we must be sure that we have -%% a proper boolean value here so wrap things with an true test if we -%% don't know, i.e. if it is not a comparison or a type test. - -gexpr_test({atom,L,true}, Bools, St0) -> - {#c_atom{anno=[L],val=true},[],Bools,St0}; -gexpr_test({atom,L,false}, Bools, St0) -> - {#c_atom{anno=[L],val=false},[],Bools,St0}; -gexpr_test(E0, Bools0, St0) -> - {E1,Eps0,St1} = expr(E0, St0), - %% Generate "top-level" test and argument calls. - case E1 of - #icall{anno=Anno,module=#c_atom{val=erlang},name=#c_atom{val=N},args=As} -> - Ar = length(As), - case erl_internal:type_test(N, Ar) orelse - erl_internal:comp_op(N, Ar) orelse - (N == internal_is_record andalso Ar == 3) of - true -> {E1,Eps0,Bools0,St1}; - false -> - Lanno = Anno#a.anno, - {New,St2} = new_var(Lanno, St1), - Bools = [New|Bools0], - {#icall{anno=Anno, %Must have an #a{} - module=#c_atom{anno=Lanno,val=erlang}, - name=#c_atom{anno=Lanno,val='=:='}, - args=[New,#c_atom{anno=Lanno,val=true}]}, - Eps0 ++ [#iset{anno=Anno,var=New,arg=E1}],Bools,St2} - end; - _ -> - Anno = get_ianno(E1), - Lanno = get_lineno_anno(E1), - case core_lib:is_simple(E1) of - true -> - Bools = [E1|Bools0], - {#icall{anno=Anno, %Must have an #a{} - module=#c_atom{anno=Lanno,val=erlang}, - name=#c_atom{anno=Lanno,val='=:='}, - args=[E1,#c_atom{anno=Lanno,val=true}]},Eps0,Bools,St1}; - false -> - {New,St2} = new_var(Lanno, St1), - Bools = [New|Bools0], - {#icall{anno=Anno, %Must have an #a{} - module=#c_atom{anno=Lanno,val=erlang}, - name=#c_atom{anno=Lanno,val='=:='}, - args=[New,#c_atom{anno=Lanno,val=true}]}, - Eps0 ++ [#iset{anno=Anno,var=New,arg=E1}],Bools,St2} - end - end. - -force_booleans([], E, Eps, St) -> - {E,Eps,St}; -force_booleans([V|Vs], E0, Eps0, St0) -> - {E1,Eps1,St1} = force_safe(E0, St0), - Lanno = element(2, V), - Anno = #a{anno=Lanno}, - Call = #icall{anno=Anno,module=#c_atom{anno=Lanno,val=erlang}, - name=#c_atom{anno=Lanno,val=is_boolean}, - args=[V]}, - {New,St} = new_var(Lanno, St1), - Iset = #iset{anno=Anno,var=New,arg=Call}, - Eps = Eps0 ++ Eps1 ++ [Iset], - E = #icall{anno=Anno, - module=#c_atom{anno=Lanno,val=erlang},name=#c_atom{anno=Lanno,val='and'}, - args=[E1,New]}, - force_booleans(Vs, E, Eps, St). - -%% exprs([Expr], State) -> {[Cexpr],State}. -%% Flatten top-level exprs. - -exprs([E0|Es0], St0) -> - {E1,Eps,St1} = expr(E0, St0), - {Es1,St2} = exprs(Es0, St1), - {Eps ++ [E1] ++ Es1,St2}; -exprs([], St) -> {[],St}. - -%% expr(Expr, State) -> {Cexpr,[PreExp],State}. -%% Generate an internal core expression. - -expr({var,L,V}, St) -> {#c_var{anno=[L],name=V},[],St}; -expr({char,L,C}, St) -> {#c_char{anno=[L],val=C},[],St}; -expr({integer,L,I}, St) -> {#c_int{anno=[L],val=I},[],St}; -expr({float,L,F}, St) -> {#c_float{anno=[L],val=F},[],St}; -expr({atom,L,A}, St) -> {#c_atom{anno=[L],val=A},[],St}; -expr({nil,L}, St) -> {#c_nil{anno=[L]},[],St}; -expr({string,L,S}, St) -> {#c_string{anno=[L],val=S},[],St}; -expr({cons,L,H0,T0}, St0) -> - {H1,Hps,St1} = safe(H0, St0), - {T1,Tps,St2} = safe(T0, St1), - {#c_cons{anno=[L],hd=H1,tl=T1},Hps ++ Tps,St2}; -expr({lc,L,E,Qs}, St) -> - lc_tq(L, E, Qs, {nil,L}, St); -expr({tuple,L,Es0}, St0) -> - {Es1,Eps,St1} = safe_list(Es0, St0), - {#c_tuple{anno=[L],es=Es1},Eps,St1}; -expr({bin,L,Es0}, St0) -> - {Es1,Eps,St1} = expr_bin(Es0, St0), - {#ibinary{anno=#a{anno=[L]},segments=Es1},Eps,St1}; -expr({block,_,Es0}, St0) -> - %% Inline the block directly. - {Es1,St1} = exprs(first(Es0), St0), - {E1,Eps,St2} = expr(last(Es0), St1), - {E1,Es1 ++ Eps,St2}; -expr({'if',L,Cs0}, St0) -> - {Cs1,St1} = clauses(Cs0, St0), - Fc = fail_clause([], #c_atom{val=if_clause}), - {#icase{anno=#a{anno=[L]},args=[],clauses=Cs1,fc=Fc},[],St1}; -expr({'case',L,E0,Cs0}, St0) -> - {E1,Eps,St1} = novars(E0, St0), - {Cs1,St2} = clauses(Cs0, St1), - {Fpat,St3} = new_var(St2), - Fc = fail_clause([Fpat], #c_tuple{es=[#c_atom{val=case_clause},Fpat]}), - {#icase{anno=#a{anno=[L]},args=[E1],clauses=Cs1,fc=Fc},Eps,St3}; -expr({'receive',L,Cs0}, St0) -> - {Cs1,St1} = clauses(Cs0, St0), - {#ireceive1{anno=#a{anno=[L]},clauses=Cs1}, [], St1}; -expr({'receive',L,Cs0,Te0,Tes0}, St0) -> - {Te1,Teps,St1} = novars(Te0, St0), - {Tes1,St2} = exprs(Tes0, St1), - {Cs1,St3} = clauses(Cs0, St2), - {#ireceive2{anno=#a{anno=[L]}, - clauses=Cs1,timeout=Te1,action=Tes1},Teps,St3}; -expr({'try',L,Es0,[],Ecs,[]}, St0) -> - %% 'try ... catch ... end' - {Es1,St1} = exprs(Es0, St0), - {V,St2} = new_var(St1), %This name should be arbitrary - {Evs,Hs,St3} = try_exception(Ecs, St2), - {#itry{anno=#a{anno=[L]},args=Es1,vars=[V],body=[V], - evars=Evs,handler=Hs}, - [],St3}; -expr({'try',L,Es0,Cs0,Ecs,[]}, St0) -> - %% 'try ... of ... catch ... end' - {Es1,St1} = exprs(Es0, St0), - {V,St2} = new_var(St1), %This name should be arbitrary - {Cs1,St3} = clauses(Cs0, St2), - {Fpat,St4} = new_var(St3), - Fc = fail_clause([Fpat], #c_tuple{es=[#c_atom{val=try_clause},Fpat]}), - {Evs,Hs,St5} = try_exception(Ecs, St4), - {#itry{anno=#a{anno=[L]},args=Es1, - vars=[V],body=[#icase{anno=#a{},args=[V],clauses=Cs1,fc=Fc}], - evars=Evs,handler=Hs}, - [],St5}; -expr({'try',L,Es0,[],[],As0}, St0) -> - %% 'try ... after ... end' - {Es1,St1} = exprs(Es0, St0), - {As1,St2} = exprs(As0, St1), - {Evs,Hs,St3} = try_after(As1,St2), - {V,St4} = new_var(St3), % (must not exist in As1) - %% TODO: this duplicates the 'after'-code; should lift to function. - {#itry{anno=#a{anno=[L]},args=Es1,vars=[V],body=As1++[V], - evars=Evs,handler=Hs}, - [],St4}; -expr({'try',L,Es,Cs,Ecs,As}, St0) -> - %% 'try ... [of ...] [catch ...] after ... end' - expr({'try',L,[{'try',L,Es,Cs,Ecs,[]}],[],[],As}, St0); -expr({'catch',L,E0}, St0) -> - {E1,Eps,St1} = expr(E0, St0), - {#icatch{anno=#a{anno=[L]},body=Eps ++ [E1]},[],St1}; -expr({'fun',L,{function,F,A},{_,_,_}=Id}, St) -> - {#c_fname{anno=[L,{id,Id}],id=F,arity=A},[],St}; -expr({'fun',L,{clauses,Cs},Id}, St) -> - fun_tq(Id, Cs, L, St); -expr({call,L0,{remote,_,{atom,_,erlang},{atom,_,is_record}},[_,_,_]=As}, St) - when L0 < 0 -> - %% Compiler-generated erlang:is_record/3 should be converted to - %% erlang:internal_is_record/3. - L = -L0, - expr({call,L,{remote,L,{atom,L,erlang},{atom,L,internal_is_record}},As}, St); -expr({call,L,{remote,_,M,F},As0}, St0) -> - {[M1,F1|As1],Aps,St1} = safe_list([M,F|As0], St0), - {#icall{anno=#a{anno=[L]},module=M1,name=F1,args=As1},Aps,St1}; -expr({call,Lc,{atom,Lf,F},As0}, St0) -> - {As1,Aps,St1} = safe_list(As0, St0), - Op = #c_fname{anno=[Lf],id=F,arity=length(As1)}, - {#iapply{anno=#a{anno=[Lc]},op=Op,args=As1},Aps,St1}; -expr({call,L,FunExp,As0}, St0) -> - {Fun,Fps,St1} = safe(FunExp, St0), - {As1,Aps,St2} = safe_list(As0, St1), - {#iapply{anno=#a{anno=[L]},op=Fun,args=As1},Fps ++ Aps,St2}; -expr({match,L,P0,E0}, St0) -> - %% First fold matches together to create aliases. - {P1,E1} = fold_match(E0, P0), - {E2,Eps,St1} = novars(E1, St0), - P2 = (catch pattern(P1)), - {Fpat,St2} = new_var(St1), - Fc = fail_clause([Fpat], #c_tuple{es=[#c_atom{val=badmatch},Fpat]}), - case P2 of - {'EXIT',_}=Exit -> exit(Exit); %Propagate error - nomatch -> - St = add_warning(L, nomatch, St2), - {#icase{anno=#a{anno=[L]}, - args=[E2],clauses=[],fc=Fc},Eps,St}; - _Other -> - {#imatch{anno=#a{anno=[L]},pat=P2,arg=E2,fc=Fc},Eps,St2} - end; -expr({op,_,'++',{lc,Llc,E,Qs},L2}, St) -> - %% Optimise this here because of the list comprehension algorithm. - lc_tq(Llc, E, Qs, L2, St); -expr({op,L,Op,A0}, St0) -> - {A1,Aps,St1} = safe(A0, St0), - LineAnno = [L], - {#icall{anno=#a{anno=LineAnno}, %Must have an #a{} - module=#c_atom{anno=LineAnno,val=erlang}, - name=#c_atom{anno=LineAnno,val=Op},args=[A1]},Aps,St1}; -expr({op,L,Op,L0,R0}, St0) -> - {As,Aps,St1} = safe_list([L0,R0], St0), - LineAnno = [L], - {#icall{anno=#a{anno=LineAnno}, %Must have an #a{} - module=#c_atom{anno=LineAnno,val=erlang}, - name=#c_atom{anno=LineAnno,val=Op},args=As},Aps,St1}. - -%% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}. - -try_exception(Ecs0, St0) -> - %% Note that Tag is not needed for rethrow - it is already in Info. - {Evs,St1} = new_vars(3, St0), % Tag, Value, Info - {Ecs1,St2} = clauses(Ecs0, St1), - [_,Value,Info] = Evs, - Ec = #iclause{anno=#a{anno=[compiler_generated]}, - pats=[#c_tuple{es=Evs}],guard=[#c_atom{val=true}], - body=[#iprimop{anno=#a{}, %Must have an #a{} - name=#c_atom{val=raise}, - args=[Info,Value]}]}, - Hs = [#icase{anno=#a{},args=[#c_tuple{es=Evs}],clauses=Ecs1,fc=Ec}], - {Evs,Hs,St2}. - -try_after(As, St0) -> - %% See above. - {Evs,St1} = new_vars(3, St0), % Tag, Value, Info - [_,Value,Info] = Evs, - B = As ++ [#iprimop{anno=#a{}, %Must have an #a{} - name=#c_atom{val=raise}, - args=[Info,Value]}], - Ec = #iclause{anno=#a{anno=[compiler_generated]}, - pats=[#c_tuple{es=Evs}],guard=[#c_atom{val=true}], - body=B}, - Hs = [#icase{anno=#a{},args=[#c_tuple{es=Evs}],clauses=[],fc=Ec}], - {Evs,Hs,St1}. - -%% expr_bin([ArgExpr], St) -> {[Arg],[PreExpr],St}. -%% Flatten the arguments of a bin. Do this straight left to right! - -expr_bin(Es, St) -> - foldr(fun (E, {Ces,Esp,St0}) -> - {Ce,Ep,St1} = bitstr(E, St0), - {[Ce|Ces],Ep ++ Esp,St1} - end, {[],[],St}, Es). - -bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) -> - {E1,Eps,St1} = safe(E0, St0), - {Size1,Eps2,St2} = safe(Size0, St1), - {#c_bitstr{val=E1,size=Size1, - unit=core_lib:make_literal(Unit), - type=core_lib:make_literal(Type), - flags=core_lib:make_literal(Flags)}, - Eps ++ Eps2,St2}. - -%% fun_tq(Id, [Clauses], Line, State) -> {Fun,[PreExp],State}. - -fun_tq(Id, Cs0, L, St0) -> - {Cs1,St1} = clauses(Cs0, St0), - Arity = length((hd(Cs1))#iclause.pats), - {Args,St2} = new_vars(Arity, St1), - {Ps,St3} = new_vars(Arity, St2), %Need new variables here - Fc = fail_clause(Ps, #c_tuple{es=[#c_atom{val=function_clause}|Ps]}), - Fun = #ifun{anno=#a{anno=[L]}, - id=[{id,Id}], %We KNOW! - vars=Args,clauses=Cs1,fc=Fc}, - {Fun,[],St3}. - -%% lc_tq(Line, Exp, [Qualifier], More, State) -> {LetRec,[PreExp],State}. -%% This TQ from Simon PJ pp 127-138. -%% This gets a bit messy as we must transform all directly here. We -%% recognise guard tests and try to fold them together and join to a -%% preceding generators, this should give us better and more compact -%% code. -%% More could be transformed before calling lc_tq. - -lc_tq(Line, E, [{generate,Lg,P,G}|Qs0], More, St0) -> - {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Name,St1} = new_fun_name("lc", St0), - {Head,St2} = new_var(St1), - {Tname,St3} = new_var_name(St2), - LA = [Line], - LAnno = #a{anno=LA}, - Tail = #c_var{anno=LA,name=Tname}, - {Arg,St4} = new_var(St3), - NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, - {Guardc,St5} = lc_guard_tests(Gs, St4), %These are always flat! - {Lc,Lps,St6} = lc_tq(Line, E, Qs1, NewMore, St5), - {Mc,Mps,St7} = expr(More, St6), - {Nc,Nps,St8} = expr(NewMore, St7), - case catch pattern(P) of - {'EXIT',_}=Exit -> - St9 = St8, - Pc = nomatch, - exit(Exit); %Propagate error - nomatch -> - St9 = add_warning(Line, nomatch, St8), - Pc = nomatch; - Pc -> - St9 = St8 - end, - {Gc,Gps,St10} = safe(G, St9), %Will be a function argument! - Fc = fail_clause([Arg], #c_tuple{anno=LA, - es=[#c_atom{val=function_clause},Arg]}), - Cs0 = [#iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[#c_cons{anno=LA,hd=Head,tl=Tail}], - guard=[], - body=Nps ++ [Nc]}, - #iclause{anno=LAnno, - pats=[#c_nil{anno=LA}],guard=[], - body=Mps ++ [Mc]}], - Cs = case Pc of - nomatch -> Cs0; - _ -> - [#iclause{anno=LAnno, - pats=[#c_cons{anno=LA,hd=Pc,tl=Tail}], - guard=Guardc, - body=Lps ++ [Lc]}|Cs0] - end, - Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc}, - {#iletrec{anno=LAnno,defs=[{Name,Fun}], - body=Gps ++ [#iapply{anno=LAnno, - op=#c_fname{anno=LA,id=Name,arity=1}, - args=[Gc]}]}, - [],St10}; -lc_tq(Line, E, [Fil0|Qs0], More, St0) -> - %% Special case sequences guard tests. - LA = [Line], - LAnno = #a{anno=LA}, - case is_guard_test(Fil0) of - true -> - {Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Lc,Lps,St1} = lc_tq(Line, E, Qs1, More, St0), - {Mc,Mps,St2} = expr(More, St1), - {Gs,St3} = lc_guard_tests([Fil0|Gs0], St2), %These are always flat! - {#icase{anno=LAnno, - args=[], - clauses=[#iclause{anno=LAnno,pats=[], - guard=Gs,body=Lps ++ [Lc]}], - fc=#iclause{anno=LAnno,pats=[],guard=[],body=Mps ++ [Mc]}}, - [],St3}; - false -> - {Lc,Lps,St1} = lc_tq(Line, E, Qs0, More, St0), - {Mc,Mps,St2} = expr(More, St1), - {Fpat,St3} = new_var(St2), - Fc = fail_clause([Fpat], #c_tuple{es=[#c_atom{val=case_clause},Fpat]}), - %% Do a novars little optimisation here. - case Fil0 of - {op,_,'not',Fil1} -> - {Filc,Fps,St4} = novars(Fil1, St3), - {#icase{anno=LAnno, - args=[Filc], - clauses=[#iclause{anno=LAnno, - pats=[#c_atom{anno=LA,val=true}], - guard=[], - body=Mps ++ [Mc]}, - #iclause{anno=LAnno, - pats=[#c_atom{anno=LA,val=false}], - guard=[], - body=Lps ++ [Lc]}], - fc=Fc}, - Fps,St4}; - _Other -> - {Filc,Fps,St4} = novars(Fil0, St3), - {#icase{anno=LAnno, - args=[Filc], - clauses=[#iclause{anno=LAnno, - pats=[#c_atom{anno=LA,val=true}], - guard=[], - body=Lps ++ [Lc]}, - #iclause{anno=LAnno, - pats=[#c_atom{anno=LA,val=false}], - guard=[], - body=Mps ++ [Mc]}], - fc=Fc}, - Fps,St4} - end - end; -lc_tq(Line, E, [], More, St) -> - expr({cons,Line,E,More}, St). - -lc_guard_tests([], St) -> {[],St}; -lc_guard_tests(Gs0, St) -> - Gs = guard_tests(Gs0), - gexpr_top(Gs, St). - -%% is_guard_test(Expression) -> true | false. -%% Test if a general expression is a guard test. Use erl_lint here -%% as it now allows sys_pre_expand transformed source. - -is_guard_test(E) -> erl_lint:is_guard_test(E). - -%% novars(Expr, State) -> {Novars,[PreExpr],State}. -%% Generate a novars expression, basically a call or a safe. At this -%% level we do not need to do a deep check. - -novars(E0, St0) -> - {E1,Eps,St1} = expr(E0, St0), - {Se,Sps,St2} = force_novars(E1, St1), - {Se,Eps ++ Sps,St2}. - -force_novars(#iapply{}=App, St) -> {App,[],St}; -force_novars(#icall{}=Call, St) -> {Call,[],St}; -force_novars(#iprimop{}=Prim, St) -> {Prim,[],St}; -force_novars(#ifun{}=Fun, St) -> {Fun,[],St}; %These are novars too -force_novars(#ibinary{}=Bin, St) -> {Bin,[],St}; -force_novars(Ce, St) -> - force_safe(Ce, St). - -%% safe(Expr, State) -> {Safe,[PreExpr],State}. -%% Generate an internal safe expression. These are simples without -%% binaries which can fail. At this level we do not need to do a -%% deep check. Must do special things with matches here. - -safe(E0, St0) -> - {E1,Eps,St1} = expr(E0, St0), - {Se,Sps,St2} = force_safe(E1, St1), - {Se,Eps ++ Sps,St2}. - -safe_list(Es, St) -> - foldr(fun (E, {Ces,Esp,St0}) -> - {Ce,Ep,St1} = safe(E, St0), - {[Ce|Ces],Ep ++ Esp,St1} - end, {[],[],St}, Es). - -force_safe(#imatch{anno=Anno,pat=P,arg=E,fc=Fc}, St0) -> - {Le,Lps,St1} = force_safe(E, St0), - {Le,Lps ++ [#imatch{anno=Anno,pat=P,arg=Le,fc=Fc}],St1}; -force_safe(Ce, St0) -> - case is_safe(Ce) of - true -> {Ce,[],St0}; - false -> - {V,St1} = new_var(St0), - {V,[#iset{var=V,arg=Ce}],St1} - end. - -is_safe(#c_cons{}) -> true; -is_safe(#c_tuple{}) -> true; -is_safe(#c_var{}) -> true; -is_safe(E) -> core_lib:is_atomic(E). - -%%% %% variable(Expr, State) -> {Variable,[PreExpr],State}. -%%% %% force_variable(Expr, State) -> {Variable,[PreExpr],State}. -%%% %% Generate a variable. - -%%% variable(E0, St0) -> -%%% {E1,Eps,St1} = expr(E0, St0), -%%% {V,Vps,St2} = force_variable(E1, St1), -%%% {V,Eps ++ Vps,St2}. - -%%% force_variable(#c_var{}=Var, St) -> {Var,[],St}; -%%% force_variable(Ce, St0) -> -%%% {V,St1} = new_var(St0), -%%% {V,[#iset{var=V,arg=Ce}],St1}. - -%%% %% atomic(Expr, State) -> {Atomic,[PreExpr],State}. -%%% %% force_atomic(Expr, State) -> {Atomic,[PreExpr],State}. - -%%% atomic(E0, St0) -> -%%% {E1,Eps,St1} = expr(E0, St0), -%%% {A,Aps,St2} = force_atomic(E1, St1), -%%% {A,Eps ++ Aps,St2}. - -%%% force_atomic(Ce, St0) -> -%%% case core_lib:is_atomic(Ce) of -%%% true -> {Ce,[],St0}; -%%% false -> -%%% {V,St1} = new_var(St0), -%%% {V,[#iset{var=V,arg=Ce}],St1} -%%% end. - -%% fold_match(MatchExpr, Pat) -> {MatchPat,Expr}. -%% Fold nested matches into one match with aliased patterns. - -fold_match({match,L,P0,E0}, P) -> - {P1,E1} = fold_match(E0, P), - {{match,L,P0,P1},E1}; -fold_match(E, P) -> {P,E}. - -%% pattern(Pattern) -> CorePat. -%% Transform a pattern by removing line numbers. We also normalise -%% aliases in patterns to standard form, {alias,Pat,[Var]}. - -pattern({var,L,V}) -> #c_var{anno=[L],name=V}; -pattern({char,L,C}) -> #c_char{anno=[L],val=C}; -pattern({integer,L,I}) -> #c_int{anno=[L],val=I}; -pattern({float,L,F}) -> #c_float{anno=[L],val=F}; -pattern({atom,L,A}) -> #c_atom{anno=[L],val=A}; -pattern({string,L,S}) -> #c_string{anno=[L],val=S}; -pattern({nil,L}) -> #c_nil{anno=[L]}; -pattern({cons,L,H,T}) -> - #c_cons{anno=[L],hd=pattern(H),tl=pattern(T)}; -pattern({tuple,L,Ps}) -> - #c_tuple{anno=[L],es=pattern_list(Ps)}; -pattern({bin,L,Ps}) -> - %% We don't create a #ibinary record here, since there is - %% no need to hold any used/new annoations in a pattern. - #c_binary{anno=[L],segments=pat_bin(Ps)}; -pattern({match,_,P1,P2}) -> - pat_alias(pattern(P1), pattern(P2)). - -%% bin_pattern_list([BinElement]) -> [BinSeg]. - -pat_bin(Ps) -> map(fun pat_segment/1, Ps). - -pat_segment({bin_element,_,Term,Size,[Type,{unit,Unit}|Flags]}) -> - #c_bitstr{val=pattern(Term),size=pattern(Size), - unit=core_lib:make_literal(Unit), - type=core_lib:make_literal(Type), - flags=core_lib:make_literal(Flags)}. - -%% pat_alias(CorePat, CorePat) -> AliasPat. -%% Normalise aliases. Trap bad aliases by throwing 'nomatch'. - -pat_alias(#c_var{name=V1}, P2) -> #c_alias{var=#c_var{name=V1},pat=P2}; -pat_alias(P1, #c_var{name=V2}) -> #c_alias{var=#c_var{name=V2},pat=P1}; -pat_alias(#c_cons{}=Cons, #c_string{anno=A,val=[H|T]}=S) -> - pat_alias(Cons, #c_cons{anno=A,hd=#c_char{anno=A,val=H}, - tl=S#c_string{val=T}}); -pat_alias(#c_string{anno=A,val=[H|T]}=S, #c_cons{}=Cons) -> - pat_alias(#c_cons{anno=A,hd=#c_char{anno=A,val=H}, - tl=S#c_string{val=T}}, Cons); -pat_alias(#c_nil{}=Nil, #c_string{val=[]}) -> - Nil; -pat_alias(#c_string{val=[]}, #c_nil{}=Nil) -> - Nil; -pat_alias(#c_cons{anno=A,hd=H1,tl=T1}, #c_cons{hd=H2,tl=T2}) -> - #c_cons{anno=A,hd=pat_alias(H1, H2),tl=pat_alias(T1, T2)}; -pat_alias(#c_tuple{es=Es1}, #c_tuple{es=Es2}) -> - #c_tuple{es=pat_alias_list(Es1, Es2)}; -pat_alias(#c_char{val=C}=Char, #c_int{val=C}) -> - Char; -pat_alias(#c_int{val=C}, #c_char{val=C}=Char) -> - Char; -pat_alias(#c_alias{var=V1,pat=P1}, - #c_alias{var=V2,pat=P2}) -> - if V1 == V2 -> pat_alias(P1, P2); - true -> #c_alias{var=V1,pat=#c_alias{var=V2,pat=pat_alias(P1, P2)}} - end; -pat_alias(#c_alias{var=V1,pat=P1}, P2) -> - #c_alias{var=V1,pat=pat_alias(P1, P2)}; -pat_alias(P1, #c_alias{var=V2,pat=P2}) -> - #c_alias{var=V2,pat=pat_alias(P1, P2)}; -pat_alias(P, P) -> P; -pat_alias(_, _) -> throw(nomatch). - -%% pat_alias_list([A1], [A2]) -> [A]. - -pat_alias_list([A1|A1s], [A2|A2s]) -> - [pat_alias(A1, A2)|pat_alias_list(A1s, A2s)]; -pat_alias_list([], []) -> []; -pat_alias_list(_, _) -> throw(nomatch). - -%% pattern_list([P]) -> [P]. - -pattern_list(Ps) -> map(fun pattern/1, Ps). - -%% first([A]) -> [A]. -%% last([A]) -> A. - -first([_]) -> []; -first([H|T]) -> [H|first(T)]. - -last([L]) -> L; -last([_|T]) -> last(T). - -%% make_vars([Name]) -> [{Var,Name}]. - -make_vars(Vs) -> [ #c_var{name=V} || V <- Vs ]. - -%% new_fun_name(Type, State) -> {FunName,State}. - -new_fun_name(Type, #core{fcount=C}=St) -> - {list_to_atom(Type ++ "$^" ++ integer_to_list(C)),St#core{fcount=C+1}}. - -%% new_var_name(State) -> {VarName,State}. - -new_var_name(#core{vcount=C}=St) -> - {list_to_atom("cor" ++ integer_to_list(C)),St#core{vcount=C + 1}}. - -%% new_var(State) -> {{var,Name},State}. -%% new_var(LineAnno, State) -> {{var,Name},State}. - -new_var(St) -> - new_var([], St). - -new_var(Anno, St0) -> - {New,St} = new_var_name(St0), - {#c_var{anno=Anno,name=New},St}. - -%% new_vars(Count, State) -> {[Var],State}. -%% new_vars(Anno, Count, State) -> {[Var],State}. -%% Make Count new variables. - -new_vars(N, St) -> new_vars_1(N, [], St, []). -new_vars(Anno, N, St) -> new_vars_1(N, Anno, St, []). - -new_vars_1(N, Anno, St0, Vs) when N > 0 -> - {V,St1} = new_var(Anno, St0), - new_vars_1(N-1, Anno, St1, [V|Vs]); -new_vars_1(0, _, St, Vs) -> {Vs,St}. - -fail_clause(Pats, A) -> - #iclause{anno=#a{anno=[compiler_generated]}, - pats=Pats,guard=[], - body=[#iprimop{anno=#a{},name=#c_atom{val=match_fail},args=[A]}]}. - -ubody(B, St) -> uexpr(B, [], St). - -%% uclauses([Lclause], [KnownVar], State) -> {[Lclause],State}. - -uclauses(Lcs, Ks, St0) -> - mapfoldl(fun (Lc, St) -> uclause(Lc, Ks, St) end, St0, Lcs). - -%% uclause(Lclause, [KnownVar], State) -> {Lclause,State}. - -uclause(Cl0, Ks, St0) -> - {Cl1,_Pvs,Used,New,St1} = uclause(Cl0, Ks, Ks, St0), - A0 = get_ianno(Cl1), - A = A0#a{us=Used,ns=New}, - {Cl1#iclause{anno=A},St1}. - -uclause(#iclause{anno=Anno,pats=Ps0,guard=G0,body=B0}, Pks, Ks0, St0) -> - {Ps1,Pg,Pvs,Pus,St1} = upattern_list(Ps0, Pks, St0), - Pu = union(Pus, intersection(Pvs, Ks0)), - Pn = subtract(Pvs, Pu), - Ks1 = union(Pn, Ks0), - {G1,St2} = uguard(Pg, G0, Ks1, St1), - Gu = used_in_any(G1), - Gn = new_in_any(G1), - Ks2 = union(Gn, Ks1), - {B1,St3} = uexprs(B0, Ks2, St2), - Used = intersection(union([Pu,Gu,used_in_any(B1)]), Ks0), - New = union([Pn,Gn,new_in_any(B1)]), - {#iclause{anno=Anno,pats=Ps1,guard=G1,body=B1},Pvs,Used,New,St3}. - -%% uguard([Test], [Kexpr], [KnownVar], State) -> {[Kexpr],State}. -%% Build a guard expression list by folding in the equality tests. - -uguard([], [], _, St) -> {[],St}; -uguard(Pg, [], Ks, St) -> - %% No guard, so fold together equality tests. - uguard(first(Pg), [last(Pg)], Ks, St); -uguard(Pg, Gs0, Ks, St0) -> - %% Gs0 must contain at least one element here. - {Gs3,St5} = foldr(fun (T, {Gs1,St1}) -> - {L,St2} = new_var(St1), - {R,St3} = new_var(St2), - {[#iset{var=L,arg=T}] ++ first(Gs1) ++ - [#iset{var=R,arg=last(Gs1)}, - #icall{anno=#a{}, %Must have an #a{} - module=#c_atom{val=erlang}, - name=#c_atom{val='and'}, - args=[L,R]}], - St3} - end, {Gs0,St0}, Pg), - %%ok = io:fwrite("core ~w: ~p~n", [?LINE,Gs3]), - uexprs(Gs3, Ks, St5). - -%% uexprs([Kexpr], [KnownVar], State) -> {[Kexpr],State}. - -uexprs([#imatch{anno=A,pat=P0,arg=Arg,fc=Fc}|Les], Ks, St0) -> - %% Optimise for simple set of unbound variable. - case upattern(P0, Ks, St0) of - {#c_var{},[],_Pvs,_Pus,_} -> - %% Throw our work away and just set to iset. - uexprs([#iset{var=P0,arg=Arg}|Les], Ks, St0); - _Other -> - %% Throw our work away and set to icase. - if - Les == [] -> - %% Need to explicitly return match "value", make - %% safe for efficiency. - {La,Lps,St1} = force_safe(Arg, St0), - Mc = #iclause{anno=A,pats=[P0],guard=[],body=[La]}, - uexprs(Lps ++ [#icase{anno=A, - args=[La],clauses=[Mc],fc=Fc}], Ks, St1); - true -> - Mc = #iclause{anno=A,pats=[P0],guard=[],body=Les}, - uexprs([#icase{anno=A,args=[Arg], - clauses=[Mc],fc=Fc}], Ks, St0) - end - end; -uexprs([Le0|Les0], Ks, St0) -> - {Le1,St1} = uexpr(Le0, Ks, St0), - {Les1,St2} = uexprs(Les0, union((core_lib:get_anno(Le1))#a.ns, Ks), St1), - {[Le1|Les1],St2}; -uexprs([], _, St) -> {[],St}. - -uexpr(#iset{anno=A,var=V,arg=A0}, Ks, St0) -> - {A1,St1} = uexpr(A0, Ks, St0), - {#iset{anno=A#a{us=del_element(V#c_var.name, (core_lib:get_anno(A1))#a.us), - ns=add_element(V#c_var.name, (core_lib:get_anno(A1))#a.ns)}, - var=V,arg=A1},St1}; -%% imatch done in uexprs. -uexpr(#iletrec{anno=A,defs=Fs0,body=B0}, Ks, St0) -> - %%ok = io:fwrite("~w: ~p~n", [?LINE,{Fs0,B0}]), - {Fs1,St1} = mapfoldl(fun ({Name,F0}, St0) -> - {F1,St1} = uexpr(F0, Ks, St0), - {{Name,F1},St1} - end, St0, Fs0), - {B1,St2} = uexprs(B0, Ks, St1), - Used = used_in_any(map(fun ({_,F}) -> F end, Fs1) ++ B1), - {#iletrec{anno=A#a{us=Used,ns=[]},defs=Fs1,body=B1},St2}; -uexpr(#icase{anno=A,args=As0,clauses=Cs0,fc=Fc0}, Ks, St0) -> - %% As0 will never generate new variables. - {As1,St1} = uexpr_list(As0, Ks, St0), - {Cs1,St2} = uclauses(Cs0, Ks, St1), - {Fc1,St3} = uclause(Fc0, Ks, St2), - Used = union(used_in_any(As1), used_in_any(Cs1)), - New = new_in_all(Cs1), - {#icase{anno=A#a{us=Used,ns=New},args=As1,clauses=Cs1,fc=Fc1},St3}; -uexpr(#ifun{anno=A,id=Id,vars=As,clauses=Cs0,fc=Fc0}, Ks0, St0) -> - Avs = lit_list_vars(As), - Ks1 = union(Avs, Ks0), - {Cs1,St1} = ufun_clauses(Cs0, Ks1, St0), - {Fc1,St2} = ufun_clause(Fc0, Ks1, St1), - Used = subtract(intersection(used_in_any(Cs1), Ks0), Avs), - {#ifun{anno=A#a{us=Used,ns=[]},id=Id,vars=As,clauses=Cs1,fc=Fc1},St2}; -uexpr(#iapply{anno=A,op=Op,args=As}, _, St) -> - Used = union(lit_vars(Op), lit_list_vars(As)), - {#iapply{anno=A#a{us=Used},op=Op,args=As},St}; -uexpr(#iprimop{anno=A,name=Name,args=As}, _, St) -> - Used = lit_list_vars(As), - {#iprimop{anno=A#a{us=Used},name=Name,args=As},St}; -uexpr(#icall{anno=A,module=Mod,name=Name,args=As}, _, St) -> - Used = union([lit_vars(Mod),lit_vars(Name),lit_list_vars(As)]), - {#icall{anno=A#a{us=Used},module=Mod,name=Name,args=As},St}; -uexpr(#itry{anno=A,args=As0,vars=Vs,body=Bs0,evars=Evs,handler=Hs0}, Ks, St0) -> - %% Note that we export only from body and exception. - {As1,St1} = uexprs(As0, Ks, St0), - {Bs1,St2} = uexprs(Bs0, Ks, St1), - {Hs1,St3} = uexprs(Hs0, Ks, St2), - Used = intersection(used_in_any(Bs1++Hs1++As1), Ks), - New = new_in_all(Bs1++Hs1), - {#itry{anno=A#a{us=Used,ns=New}, - args=As1,vars=Vs,body=Bs1,evars=Evs,handler=Hs1},St3}; -uexpr(#icatch{anno=A,body=Es0}, Ks, St0) -> - {Es1,St1} = uexprs(Es0, Ks, St0), - {#icatch{anno=A#a{us=used_in_any(Es1)},body=Es1},St1}; -uexpr(#ireceive1{anno=A,clauses=Cs0}, Ks, St0) -> - {Cs1,St1} = uclauses(Cs0, Ks, St0), - {#ireceive1{anno=A#a{us=used_in_any(Cs1),ns=new_in_all(Cs1)}, - clauses=Cs1},St1}; -uexpr(#ireceive2{anno=A,clauses=Cs0,timeout=Te0,action=Tes0}, Ks, St0) -> - %% Te0 will never generate new variables. - {Te1,St1} = uexpr(Te0, Ks, St0), - {Cs1,St2} = uclauses(Cs0, Ks, St1), - {Tes1,St3} = uexprs(Tes0, Ks, St2), - Used = union([used_in_any(Cs1),used_in_any(Tes1), - (core_lib:get_anno(Te1))#a.us]), - New = case Cs1 of - [] -> new_in_any(Tes1); - _ -> intersection(new_in_all(Cs1), new_in_any(Tes1)) - end, - {#ireceive2{anno=A#a{us=Used,ns=New}, - clauses=Cs1,timeout=Te1,action=Tes1},St3}; -uexpr(#iprotect{anno=A,body=Es0}, Ks, St0) -> - {Es1,St1} = uexprs(Es0, Ks, St0), - Used = used_in_any(Es1), - {#iprotect{anno=A#a{us=Used},body=Es1},St1}; %No new variables escape! -uexpr(#ibinary{anno=A,segments=Ss}, _, St) -> - Used = bitstr_vars(Ss), - {#ibinary{anno=A#a{us=Used},segments=Ss},St}; -uexpr(Lit, _, St) -> - true = core_lib:is_simple(Lit), %Sanity check! - Vs = lit_vars(Lit), - Anno = core_lib:get_anno(Lit), - {core_lib:set_anno(Lit, #a{us=Vs,anno=Anno}),St}. - -uexpr_list(Les0, Ks, St0) -> - mapfoldl(fun (Le, St) -> uexpr(Le, Ks, St) end, St0, Les0). - -%% ufun_clauses([Lclause], [KnownVar], State) -> {[Lclause],State}. - -ufun_clauses(Lcs, Ks, St0) -> - mapfoldl(fun (Lc, St) -> ufun_clause(Lc, Ks, St) end, St0, Lcs). - -%% ufun_clause(Lclause, [KnownVar], State) -> {Lclause,State}. - -ufun_clause(Cl0, Ks, St0) -> - {Cl1,Pvs,Used,_,St1} = uclause(Cl0, [], Ks, St0), - A0 = get_ianno(Cl1), - A = A0#a{us=subtract(intersection(Used, Ks), Pvs),ns=[]}, - {Cl1#iclause{anno=A},St1}. - -%% upattern(Pat, [KnownVar], State) -> -%% {Pat,[GuardTest],[NewVar],[UsedVar],State}. - -upattern(#c_var{name='_'}, _, St0) -> - {New,St1} = new_var_name(St0), - {#c_var{name=New},[],[New],[],St1}; -upattern(#c_var{name=V}=Var, Ks, St0) -> - case is_element(V, Ks) of - true -> - {N,St1} = new_var_name(St0), - New = #c_var{name=N}, - Test = #icall{anno=#a{us=add_element(N, [V])}, - module=#c_atom{val=erlang}, - name=#c_atom{val='=:='}, - args=[New,Var]}, - %% Test doesn't need protecting. - {New,[Test],[N],[],St1}; - false -> {Var,[],[V],[],St0} - end; -upattern(#c_cons{hd=H0,tl=T0}=Cons, Ks, St0) -> - {H1,Hg,Hv,Hu,St1} = upattern(H0, Ks, St0), - {T1,Tg,Tv,Tu,St2} = upattern(T0, union(Hv, Ks), St1), - {Cons#c_cons{hd=H1,tl=T1},Hg ++ Tg,union(Hv, Tv),union(Hu, Tu),St2}; -upattern(#c_tuple{es=Es0}=Tuple, Ks, St0) -> - {Es1,Esg,Esv,Eus,St1} = upattern_list(Es0, Ks, St0), - {Tuple#c_tuple{es=Es1},Esg,Esv,Eus,St1}; -upattern(#c_binary{segments=Es0}=Bin, Ks, St0) -> - {Es1,Esg,Esv,Eus,St1} = upat_bin(Es0, Ks, St0), - {Bin#c_binary{segments=Es1},Esg,Esv,Eus,St1}; -upattern(#c_alias{var=V0,pat=P0}=Alias, Ks, St0) -> - {V1,Vg,Vv,Vu,St1} = upattern(V0, Ks, St0), - {P1,Pg,Pv,Pu,St2} = upattern(P0, union(Vv, Ks), St1), - {Alias#c_alias{var=V1,pat=P1},Vg ++ Pg,union(Vv, Pv),union(Vu, Pu),St2}; -upattern(Other, _, St) -> {Other,[],[],[],St}. %Constants - -%% upattern_list([Pat], [KnownVar], State) -> -%% {[Pat],[GuardTest],[NewVar],[UsedVar],State}. - -upattern_list([P0|Ps0], Ks, St0) -> - {P1,Pg,Pv,Pu,St1} = upattern(P0, Ks, St0), - {Ps1,Psg,Psv,Psu,St2} = upattern_list(Ps0, union(Pv, Ks), St1), - {[P1|Ps1],Pg ++ Psg,union(Pv, Psv),union(Pu, Psu),St2}; -upattern_list([], _, St) -> {[],[],[],[],St}. - -%% upat_bin([Pat], [KnownVar], State) -> -%% {[Pat],[GuardTest],[NewVar],[UsedVar],State}. -upat_bin(Es0, Ks, St0) -> - upat_bin(Es0, Ks, [], St0). - -%% upat_bin([Pat], [KnownVar], [LocalVar], State) -> -%% {[Pat],[GuardTest],[NewVar],[UsedVar],State}. -upat_bin([P0|Ps0], Ks, Bs, St0) -> - {P1,Pg,Pv,Pu,Bs1,St1} = upat_element(P0, Ks, Bs, St0), - {Ps1,Psg,Psv,Psu,St2} = upat_bin(Ps0, union(Pv, Ks), Bs1, St1), - {[P1|Ps1],Pg ++ Psg,union(Pv, Psv),union(Pu, Psu),St2}; -upat_bin([], _, _, St) -> {[],[],[],[],St}. - - -%% upat_element(Segment, [KnownVar], [LocalVar], State) -> -%% {Segment,[GuardTest],[NewVar],[UsedVar],[LocalVar],State} -upat_element(#c_bitstr{val=H0,size=Sz}=Seg, Ks, Bs, St0) -> - {H1,Hg,Hv,[],St1} = upattern(H0, Ks, St0), - Bs1 = case H0 of - #c_var{name=Hname} -> - case H1 of - #c_var{name=Hname} -> - Bs; - #c_var{name=Other} -> - [{Hname, Other}|Bs] - end; - _ -> - Bs - end, - {Sz1, Us} = case Sz of - #c_var{name=Vname} -> - rename_bitstr_size(Vname, Bs); - _Other -> {Sz, []} - end, - {Seg#c_bitstr{val=H1, size=Sz1},Hg,Hv,Us,Bs1,St1}. - -rename_bitstr_size(V, [{V, N}|_]) -> - New = #c_var{name=N}, - {New, [N]}; -rename_bitstr_size(V, [_|Rest]) -> - rename_bitstr_size(V, Rest); -rename_bitstr_size(V, []) -> - Old = #c_var{name=V}, - {Old, [V]}. - -used_in_any(Les) -> - foldl(fun (Le, Ns) -> union((core_lib:get_anno(Le))#a.us, Ns) end, - [], Les). - -new_in_any(Les) -> - foldl(fun (Le, Ns) -> union((core_lib:get_anno(Le))#a.ns, Ns) end, - [], Les). - -new_in_all([Le|Les]) -> - foldl(fun (L, Ns) -> intersection((core_lib:get_anno(L))#a.ns, Ns) end, - (core_lib:get_anno(Le))#a.ns, Les); -new_in_all([]) -> []. - -%% The AfterVars are the variables which are used afterwards. We need -%% this to work out which variables are actually exported and used -%% from case/receive. In subblocks/clauses the AfterVars of the block -%% are just the exported variables. - -cbody(B0, St0) -> - {B1,_,_,St1} = cexpr(B0, [], St0), - {B1,St1}. - -%% cclause(Lclause, [AfterVar], State) -> {Cclause,State}. -%% The AfterVars are the exported variables. - -cclause(#iclause{anno=#a{anno=Anno},pats=Ps,guard=G0,body=B0}, Exp, St0) -> - {B1,_Us1,St1} = cexprs(B0, Exp, St0), - {G1,St2} = cguard(G0, St1), - {#c_clause{anno=Anno,pats=Ps,guard=G1,body=B1},St2}. - -cclauses(Lcs, Es, St0) -> - mapfoldl(fun (Lc, St) -> cclause(Lc, Es, St) end, St0, Lcs). - -cguard([], St) -> {#c_atom{val=true},St}; -cguard(Gs, St0) -> - {G,_,St1} = cexprs(Gs, [], St0), - {G,St1}. - -%% cexprs([Lexpr], [AfterVar], State) -> {Cexpr,[AfterVar],State}. -%% Must be sneaky here at the last expr when combining exports for the -%% whole sequence and exports for that expr. - -cexprs([#iset{var=#c_var{name=Name}=Var}=Iset], As, St) -> - %% Make return value explicit, and make Var true top level. - cexprs([Iset,Var#c_var{anno=#a{us=[Name]}}], As, St); -cexprs([Le], As, St0) -> - {Ce,Es,Us,St1} = cexpr(Le, As, St0), - Exp = make_vars(As), %The export variables - if - Es == [] -> {core_lib:make_values([Ce|Exp]),union(Us, As),St1}; - true -> - {R,St2} = new_var(St1), - {#c_let{anno=get_lineno_anno(Ce), - vars=[R|make_vars(Es)],arg=Ce, - body=core_lib:make_values([R|Exp])}, - union(Us, As),St2} - end; -cexprs([#iset{anno=#a{anno=A},var=V,arg=A0}|Les], As0, St0) -> - {Ces,As1,St1} = cexprs(Les, As0, St0), - {A1,Es,Us,St2} = cexpr(A0, As1, St1), - {#c_let{anno=A,vars=[V|make_vars(Es)],arg=A1,body=Ces}, - union(Us, As1),St2}; -cexprs([Le|Les], As0, St0) -> - {Ces,As1,St1} = cexprs(Les, As0, St0), - {Ce,Es,Us,St2} = cexpr(Le, As1, St1), - if - Es == [] -> - {#c_seq{arg=Ce,body=Ces},union(Us, As1),St2}; - true -> - {R,St3} = new_var(St2), - {#c_let{vars=[R|make_vars(Es)],arg=Ce,body=Ces}, - union(Us, As1),St3} - end. - -%% cexpr(Lexpr, [AfterVar], State) -> {Cexpr,[ExpVar],[UsedVar],State}. - -cexpr(#iletrec{anno=A,defs=Fs0,body=B0}, As, St0) -> - {Fs1,{_,St1}} = mapfoldl(fun ({Name,F0}, {Used,St0}) -> - {F1,[],Us,St1} = cexpr(F0, [], St0), - {#c_def{name=#c_fname{id=Name,arity=1}, - val=F1}, - {union(Us, Used),St1}} - end, {[],St0}, Fs0), - Exp = intersection(A#a.ns, As), - {B1,_Us,St2} = cexprs(B0, Exp, St1), - {#c_letrec{anno=A#a.anno,defs=Fs1,body=B1},Exp,A#a.us,St2}; -cexpr(#icase{anno=A,args=Largs,clauses=Lcs,fc=Lfc}, As, St0) -> - Exp = intersection(A#a.ns, As), %Exports - {Cargs,St1} = foldr(fun (La, {Cas,Sta}) -> - {Ca,[],_Us1,Stb} = cexpr(La, As, Sta), - {[Ca|Cas],Stb} - end, {[],St0}, Largs), - {Ccs,St2} = cclauses(Lcs, Exp, St1), - {Cfc,St3} = cclause(Lfc, [], St2), %Never exports - {#c_case{anno=A#a.anno, - arg=core_lib:make_values(Cargs),clauses=Ccs ++ [Cfc]}, - Exp,A#a.us,St3}; -cexpr(#ireceive1{anno=A,clauses=Lcs}, As, St0) -> - Exp = intersection(A#a.ns, As), %Exports - {Ccs,St1} = cclauses(Lcs, Exp, St0), - {#c_receive{anno=A#a.anno, - clauses=Ccs, - timeout=#c_atom{val=infinity},action=#c_atom{val=true}}, - Exp,A#a.us,St1}; -cexpr(#ireceive2{anno=A,clauses=Lcs,timeout=Lto,action=Les}, As, St0) -> - Exp = intersection(A#a.ns, As), %Exports - {Cto,[],_Us1,St1} = cexpr(Lto, As, St0), - {Ccs,St2} = cclauses(Lcs, Exp, St1), - {Ces,_Us2,St3} = cexprs(Les, Exp, St2), - {#c_receive{anno=A#a.anno, - clauses=Ccs,timeout=Cto,action=Ces}, - Exp,A#a.us,St3}; -cexpr(#itry{anno=A,args=La,vars=Vs,body=Lb,evars=Evs,handler=Lh}, As, St0) -> - Exp = intersection(A#a.ns, As), %Exports - {Ca,_Us1,St1} = cexprs(La, [], St0), - {Cb,_Us2,St2} = cexprs(Lb, Exp, St1), - {Ch,_Us3,St3} = cexprs(Lh, Exp, St2), - {#c_try{anno=A#a.anno,arg=Ca,vars=Vs,body=Cb,evars=Evs,handler=Ch}, - Exp,A#a.us,St3}; -cexpr(#icatch{anno=A,body=Les}, _As, St0) -> - {Ces,_Us1,St1} = cexprs(Les, [], St0), %Never export! - {#c_catch{body=Ces},[],A#a.us,St1}; -cexpr(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) -> - {Ccs,St1} = cclauses(Lcs, [], St0), %NEVER export! - {Cfc,St2} = cclause(Lfc, [], St1), - Anno = A#a.anno, - {#c_fun{anno=Id++Anno,vars=Args, - body=#c_case{anno=Anno, - arg=core_lib:set_anno(core_lib:make_values(Args), Anno), - clauses=Ccs ++ [Cfc]}}, - [],A#a.us,St2}; -cexpr(#iapply{anno=A,op=Op,args=Args}, _As, St) -> - {#c_apply{anno=A#a.anno,op=Op,args=Args},[],A#a.us,St}; -cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St) -> - {#c_call{anno=A#a.anno,module=Mod,name=Name,args=Args},[],A#a.us,St}; -cexpr(#iprimop{anno=A,name=Name,args=Args}, _As, St) -> - {#c_primop{anno=A#a.anno,name=Name,args=Args},[],A#a.us,St}; -cexpr(#iprotect{anno=A,body=Es}, _As, St0) -> - {Ce,_,St1} = cexprs(Es, [], St0), - V = #c_var{name='Try'}, %The names are arbitrary - Vs = [#c_var{name='T'},#c_var{name='R'}], - {#c_try{anno=A#a.anno,arg=Ce,vars=[V],body=V, - evars=Vs,handler=#c_atom{val=false}}, - [],A#a.us,St1}; -cexpr(#ibinary{anno=#a{anno=Anno,us=Us},segments=Segs}, _As, St) -> - {#c_binary{anno=Anno,segments=Segs},[],Us,St}; -cexpr(Lit, _As, St) -> - true = core_lib:is_simple(Lit), %Sanity check! - Anno = core_lib:get_anno(Lit), - Vs = Anno#a.us, - %%Vs = lit_vars(Lit), - {core_lib:set_anno(Lit, Anno#a.anno),[],Vs,St}. - -%% lit_vars(Literal) -> [Var]. - -lit_vars(Lit) -> lit_vars(Lit, []). - -lit_vars(#c_cons{hd=H,tl=T}, Vs) -> lit_vars(H, lit_vars(T, Vs)); -lit_vars(#c_tuple{es=Es}, Vs) -> lit_list_vars(Es, Vs); -lit_vars(#c_var{name=V}, Vs) -> add_element(V, Vs); -lit_vars(_, Vs) -> Vs. %These are atomic - -% lit_bin_vars(Segs, Vs) -> -% foldl(fun (#c_bitstr{val=V,size=S}, Vs0) -> -% lit_vars(V, lit_vars(S, Vs0)) -% end, Vs, Segs). - -lit_list_vars(Ls) -> lit_list_vars(Ls, []). - -lit_list_vars(Ls, Vs) -> - foldl(fun (L, Vs0) -> lit_vars(L, Vs0) end, Vs, Ls). - -bitstr_vars(Segs) -> - bitstr_vars(Segs, []). - -bitstr_vars(Segs, Vs) -> - foldl(fun (#c_bitstr{val=V,size=S}, Vs0) -> - lit_vars(V, lit_vars(S, Vs0)) - end, Vs, Segs). - -get_ianno(Ce) -> - case core_lib:get_anno(Ce) of - #a{}=A -> A; - A when is_list(A) -> #a{anno=A} - end. - -get_lineno_anno(Ce) -> - case core_lib:get_anno(Ce) of - #a{anno=A} -> A; - A when is_list(A) -> A - end. - - -%%% -%%% Handling of warnings. -%%% - -format_error(nomatch) -> "pattern cannot possibly match". - -add_warning(Line, Term, #core{ws=Ws}=St) when Line >= 0 -> - St#core{ws=[{Line,?MODULE,Term}|Ws]}; -add_warning(_, _, St) -> St. - diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_kernel.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_kernel.erl deleted file mode 100644 index 2d600fabc4..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_kernel.erl +++ /dev/null @@ -1,1568 +0,0 @@ -%% ``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 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. -%% -%% 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: v3_kernel.erl,v 1.3 2010/03/04 13:54:20 maria Exp $ -%% -%% Purpose : Transform Core Erlang to Kernel Erlang - -%% Kernel erlang is like Core Erlang with a few significant -%% differences: -%% -%% 1. It is flat! There are no nested calls or sub-blocks. -%% -%% 2. All variables are unique in a function. There is no scoping, or -%% rather the scope is the whole function. -%% -%% 3. Pattern matching (in cases and receives) has been compiled. -%% -%% 4. The annotations contain variable usages. Seeing we have to work -%% this out anyway for funs we might as well pass it on for free to -%% later passes. -%% -%% 5. All remote-calls are to statically named m:f/a. Meta-calls are -%% passed via erlang:apply/3. -%% -%% The translation is done in two passes: -%% -%% 1. Basic translation, translate variable/function names, flatten -%% completely, pattern matching compilation. -%% -%% 2. Fun-lifting (lambda-lifting), variable usage annotation and -%% last-call handling. -%% -%% All new Kexprs are created in the first pass, they are just -%% annotated in the second. -%% -%% Functions and BIFs -%% -%% Functions are "call"ed or "enter"ed if it is a last call, their -%% return values may be ignored. BIFs are things which are known to -%% be internal by the compiler and can only be called, their return -%% values cannot be ignored. -%% -%% Letrec's are handled rather naively. All the functions in one -%% letrec are handled as one block to find the free variables. While -%% this is not optimal it reflects how letrec's often are used. We -%% don't have to worry about variable shadowing and nested letrec's as -%% this is handled in the variable/function name translation. There -%% is a little bit of trickery to ensure letrec transformations fit -%% into the scheme of things. -%% -%% To ensure unique variable names we use a variable substitution -%% table and keep the set of all defined variables. The nested -%% scoping of Core means that we must also nest the substitution -%% tables, but the defined set must be passed through to match the -%% flat structure of Kernel and to make sure variables with the same -%% name from different scopes get different substitutions. -%% -%% We also use these substitutions to handle the variable renaming -%% necessary in pattern matching compilation. -%% -%% The pattern matching compilation assumes that the values of -%% different types don't overlap. This means that as there is no -%% character type yet in the machine all characters must be converted -%% to integers! - --module(v3_kernel). - --export([module/2,format_error/1]). - --import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2, - member/2,reverse/1,reverse/2]). --import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). - --include("core_parse.hrl"). --include("v3_kernel.hrl"). - -%% These are not defined in v3_kernel.hrl. -get_kanno(Kthing) -> element(2, Kthing). -set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno). - -%% Internal kernel expressions and help functions. -%% N.B. the annotation field is ALWAYS the first field! - --record(ivalues, {anno=[],args}). --record(ifun, {anno=[],vars,body}). --record(iset, {anno=[],vars,arg,body}). --record(iletrec, {anno=[],defs}). --record(ialias, {anno=[],vars,pat}). --record(iclause, {anno=[],sub,pats,guard,body}). --record(ireceive_accept, {anno=[],arg}). --record(ireceive_next, {anno=[],arg}). - -%% State record for kernel translator. --record(kern, {func, %Current function - vcount=0, %Variable counter - fcount=0, %Fun counter - ds=[], %Defined variables - funs=[], %Fun functions - free=[], %Free variables - ws=[], %Warnings. - extinstr=false}). %Generate extended instructions - -module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, Options) -> - ExtInstr = not member(no_new_apply, Options), - {Kfs,St} = mapfoldl(fun function/2, #kern{extinstr=ExtInstr}, Fs), - Kes = map(fun (#c_fname{id=N,arity=Ar}) -> {N,Ar} end, Es), - Kas = map(fun (#c_def{name=#c_atom{val=N},val=V}) -> - {N,core_lib:literal_value(V)} end, As), - {ok,#k_mdef{anno=A,name=M#c_atom.val,exports=Kes,attributes=Kas, - body=Kfs ++ St#kern.funs},St#kern.ws}. - -function(#c_def{anno=Af,name=#c_fname{id=F,arity=Arity},val=Body}, St0) -> - %%ok = io:fwrite("kern: ~p~n", [{F,Arity}]), - St1 = St0#kern{func={F,Arity},vcount=0,fcount=0,ds=sets:new()}, - {#ifun{anno=Ab,vars=Kvs,body=B0},[],St2} = expr(Body, new_sub(), St1), - {B1,_,St3} = ubody(B0, return, St2), - %%B1 = B0, St3 = St2, %Null second pass - {#k_fdef{anno=#k{us=[],ns=[],a=Af ++ Ab}, - func=F,arity=Arity,vars=Kvs,body=B1},St3}. - -%% body(Cexpr, Sub, State) -> {Kexpr,[PreKepxr],State}. -%% Do the main sequence of a body. A body ends in an atomic value or -%% values. Must check if vector first so do expr. - -body(#c_values{anno=A,es=Ces}, Sub, St0) -> - %% Do this here even if only in bodies. - {Kes,Pe,St1} = atomic_list(Ces, Sub, St0), - %%{Kes,Pe,St1} = expr_list(Ces, Sub, St0), - {#ivalues{anno=A,args=Kes},Pe,St1}; -body(#ireceive_next{anno=A}, _, St) -> - {#k_receive_next{anno=A},[],St}; -body(Ce, Sub, St0) -> - expr(Ce, Sub, St0). - -%% guard(Cexpr, Sub, State) -> {Kexpr,State}. -%% We handle guards almost as bodies. The only special thing we -%% must do is to make the final Kexpr a #k_test{}. -%% Also, we wrap the entire guard in a try/catch which is -%% not strictly needed, but makes sure that every 'bif' instruction -%% will get a proper failure label. - -guard(G0, Sub, St0) -> - {G1,St1} = wrap_guard(G0, St0), - {Ge0,Pre,St2} = expr(G1, Sub, St1), - {Ge,St} = gexpr_test(Ge0, St2), - {pre_seq(Pre, Ge),St}. - -%% Wrap the entire guard in a try/catch if needed. - -wrap_guard(#c_try{}=Try, St) -> {Try,St}; -wrap_guard(Core, St0) -> - {VarName,St} = new_var_name(St0), - Var = #c_var{name=VarName}, - Try = #c_try{arg=Core,vars=[Var],body=Var,evars=[],handler=#c_atom{val=false}}, - {Try,St}. - -%% gexpr_test(Kexpr, State) -> {Kexpr,State}. -%% Builds the final boolean test from the last Kexpr in a guard test. -%% Must enter try blocks and isets and find the last Kexpr in them. -%% This must end in a recognised BEAM test! - -gexpr_test(#k_bif{anno=A,op=#k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=is_boolean},arity=1}=Op, - args=Kargs}, St) -> - %% XXX Remove this clause in R11. For bootstrap purposes, we must - %% recognize erlang:is_boolean/1 here. - {#k_test{anno=A,op=Op,args=Kargs},St}; -gexpr_test(#k_bif{anno=A,op=#k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=internal_is_record},arity=3}=Op, - args=Kargs}, St) -> - {#k_test{anno=A,op=Op,args=Kargs},St}; -gexpr_test(#k_bif{anno=A,op=#k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=F},arity=Ar}=Op, - args=Kargs}=Ke, St) -> - %% Either convert to test if ok, or add test. - %% At this stage, erlang:float/1 is not a type test. (It should - %% have been converted to erlang:is_float/1.) - case erl_internal:new_type_test(F, Ar) orelse - erl_internal:comp_op(F, Ar) of - true -> {#k_test{anno=A,op=Op,args=Kargs},St}; - false -> gexpr_test_add(Ke, St) %Add equality test - end; -gexpr_test(#k_try{arg=B0,vars=[#k_var{name=X}],body=#k_var{name=X}, - handler=#k_atom{val=false}}=Try, St0) -> - {B,St} = gexpr_test(B0, St0), - %%ok = io:fwrite("~w: ~p~n", [?LINE,{B0,B}]), - {Try#k_try{arg=B},St}; -gexpr_test(#iset{body=B0}=Iset, St0) -> - {B1,St1} = gexpr_test(B0, St0), - {Iset#iset{body=B1},St1}; -gexpr_test(Ke, St) -> gexpr_test_add(Ke, St). %Add equality test - -gexpr_test_add(Ke, St0) -> - Test = #k_remote{mod=#k_atom{val='erlang'}, - name=#k_atom{val='=:='}, - arity=2}, - {Ae,Ap,St1} = force_atomic(Ke, St0), - {pre_seq(Ap, #k_test{anno=get_kanno(Ke), - op=Test,args=[Ae,#k_atom{val='true'}]}),St1}. - -%% expr(Cexpr, Sub, State) -> {Kexpr,[PreKexpr],State}. -%% Convert a Core expression, flattening it at the same time. - -expr(#c_var{anno=A,name=V}, Sub, St) -> - {#k_var{anno=A,name=get_vsub(V, Sub)},[],St}; -expr(#c_char{anno=A,val=C}, _Sub, St) -> - {#k_int{anno=A,val=C},[],St}; %Convert to integers! -expr(#c_int{anno=A,val=I}, _Sub, St) -> - {#k_int{anno=A,val=I},[],St}; -expr(#c_float{anno=A,val=F}, _Sub, St) -> - {#k_float{anno=A,val=F},[],St}; -expr(#c_atom{anno=A,val=At}, _Sub, St) -> - {#k_atom{anno=A,val=At},[],St}; -expr(#c_string{anno=A,val=S}, _Sub, St) -> - {#k_string{anno=A,val=S},[],St}; -expr(#c_nil{anno=A}, _Sub, St) -> - {#k_nil{anno=A},[],St}; -expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) -> - %% Do cons in two steps, first the expressions left to right, then - %% any remaining literals right to left. - {Kh0,Hp0,St1} = expr(Ch, Sub, St0), - {Kt0,Tp0,St2} = expr(Ct, Sub, St1), - {Kt1,Tp1,St3} = force_atomic(Kt0, St2), - {Kh1,Hp1,St4} = force_atomic(Kh0, St3), - {#k_cons{anno=A,hd=Kh1,tl=Kt1},Hp0 ++ Tp0 ++ Tp1 ++ Hp1,St4}; -expr(#c_tuple{anno=A,es=Ces}, Sub, St0) -> - {Kes,Ep,St1} = atomic_list(Ces, Sub, St0), - {#k_tuple{anno=A,es=Kes},Ep,St1}; -expr(#c_binary{anno=A,segments=Cv}, Sub, St0) -> - case catch atomic_bin(Cv, Sub, St0, 0) of - {'EXIT',R} -> exit(R); - bad_element_size -> - Erl = #c_atom{val=erlang}, - Name = #c_atom{val=error}, - Args = [#c_atom{val=badarg}], - Fault = #c_call{module=Erl,name=Name,args=Args}, - expr(Fault, Sub, St0); - {Kv,Ep,St1} -> - {#k_binary{anno=A,segs=Kv},Ep,St1} - end; -expr(#c_fname{anno=A,arity=Ar}=Fname, Sub, St) -> - %% A local in an expression. - %% For now, these are wrapped into a fun by reverse - %% etha-conversion, but really, there should be exactly one - %% such "lambda function" for each escaping local name, - %% instead of one for each occurrence as done now. - Vs = [#c_var{name=list_to_atom("V" ++ integer_to_list(V))} || - V <- integers(1, Ar)], - Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{op=Fname,args=Vs}}, - expr(Fun, Sub, St); -expr(#c_fun{anno=A,vars=Cvs,body=Cb}, Sub0, St0) -> - {Kvs,Sub1,St1} = pattern_list(Cvs, Sub0, St0), - %%ok = io:fwrite("~w: ~p~n", [?LINE,{{Cvs,Sub0,St0},{Kvs,Sub1,St1}}]), - {Kb,Pb,St2} = body(Cb, Sub1, St1), - {#ifun{anno=A,vars=Kvs,body=pre_seq(Pb, Kb)},[],St2}; -expr(#c_seq{arg=Ca,body=Cb}, Sub, St0) -> - {Ka,Pa,St1} = body(Ca, Sub, St0), - case is_exit_expr(Ka) of - true -> {Ka,Pa,St1}; - false -> - {Kb,Pb,St2} = body(Cb, Sub, St1), - {Kb,Pa ++ [Ka] ++ Pb,St2} - end; -expr(#c_let{anno=A,vars=Cvs,arg=Ca,body=Cb}, Sub0, St0) -> - %%ok = io:fwrite("~w: ~p~n", [?LINE,{Cvs,Sub0,St0}]), - {Ka,Pa,St1} = body(Ca, Sub0, St0), - case is_exit_expr(Ka) of - true -> {Ka,Pa,St1}; - false -> - {Kps,Sub1,St2} = pattern_list(Cvs, Sub0, St1), - %%ok = io:fwrite("~w: ~p~n", [?LINE,{Kps,Sub1,St1,St2}]), - %% Break known multiple values into separate sets. - Sets = case Ka of - #ivalues{args=Kas} -> - foldr2(fun (V, Val, Sb) -> - [#iset{vars=[V],arg=Val}|Sb] end, - [], Kps, Kas); - _Other -> - [#iset{anno=A,vars=Kps,arg=Ka}] - end, - {Kb,Pb,St3} = body(Cb, Sub1, St2), - {Kb,Pa ++ Sets ++ Pb,St3} - end; -expr(#c_letrec{anno=A,defs=Cfs,body=Cb}, Sub0, St0) -> - %% Make new function names and store substitution. - {Fs0,{Sub1,St1}} = - mapfoldl(fun (#c_def{name=#c_fname{id=F,arity=Ar},val=B}, {Sub,St0}) -> - {N,St1} = new_fun_name(atom_to_list(F) - ++ "/" ++ - integer_to_list(Ar), - St0), - {{N,B},{set_fsub(F, Ar, N, Sub),St1}} - end, {Sub0,St0}, Cfs), - %% Run translation on functions and body. - {Fs1,St2} = mapfoldl(fun ({N,Fd0}, St1) -> - {Fd1,[],St2} = expr(Fd0, Sub1, St1), - Fd = set_kanno(Fd1, A), - {{N,Fd},St2} - end, St1, Fs0), - {Kb,Pb,St3} = body(Cb, Sub1, St2), - {Kb,[#iletrec{anno=A,defs=Fs1}|Pb],St3}; -expr(#c_case{arg=Ca,clauses=Ccs}, Sub, St0) -> - {Ka,Pa,St1} = body(Ca, Sub, St0), %This is a body! - {Kvs,Pv,St2} = match_vars(Ka, St1), %Must have variables here! - {Km,St3} = kmatch(Kvs, Ccs, Sub, St2), - Match = flatten_seq(build_match(Kvs, Km)), - {last(Match),Pa ++ Pv ++ first(Match),St3}; -expr(#c_receive{anno=A,clauses=Ccs0,timeout=Ce,action=Ca}, Sub, St0) -> - {Ke,Pe,St1} = atomic_lit(Ce, Sub, St0), %Force this to be atomic! - {Rvar,St2} = new_var(St1), - %% Need to massage accept clauses and add reject clause before matching. - Ccs1 = map(fun (#c_clause{anno=Banno,body=B0}=C) -> - B1 = #c_seq{arg=#ireceive_accept{anno=A},body=B0}, - C#c_clause{anno=Banno,body=B1} - end, Ccs0), - {Mpat,St3} = new_var_name(St2), - Rc = #c_clause{anno=[compiler_generated|A], - pats=[#c_var{name=Mpat}],guard=#c_atom{anno=A,val=true}, - body=#ireceive_next{anno=A}}, - {Km,St4} = kmatch([Rvar], Ccs1 ++ [Rc], Sub, add_var_def(Rvar, St3)), - {Ka,Pa,St5} = body(Ca, Sub, St4), - {#k_receive{anno=A,var=Rvar,body=Km,timeout=Ke,action=pre_seq(Pa, Ka)}, - Pe,St5}; -expr(#c_apply{anno=A,op=Cop,args=Cargs}, Sub, St) -> - c_apply(A, Cop, Cargs, Sub, St); -expr(#c_call{anno=A,module=M0,name=F0,args=Cargs}, Sub, St0) -> - {[M1,F1|Kargs],Ap,St1} = atomic_list([M0,F0|Cargs], Sub, St0), - Ar = length(Cargs), - case {M1,F1} of - {#k_atom{val=Ma},#k_atom{val=Fa}} -> - Call = case is_remote_bif(Ma, Fa, Ar) of - true -> - #k_bif{anno=A, - op=#k_remote{mod=M1,name=F1,arity=Ar}, - args=Kargs}; - false -> - #k_call{anno=A, - op=#k_remote{mod=M1,name=F1,arity=Ar}, - args=Kargs} - end, - {Call,Ap,St1}; - _Other when St0#kern.extinstr == false -> %Old explicit apply - Call = #c_call{anno=A, - module=#c_atom{val=erlang}, - name=#c_atom{val=apply}, - args=[M0,F0,make_list(Cargs)]}, - expr(Call, Sub, St0); - _Other -> %New instruction in R10. - Call = #k_call{anno=A, - op=#k_remote{mod=M1,name=F1,arity=Ar}, - args=Kargs}, - {Call,Ap,St1} - end; -expr(#c_primop{anno=A,name=#c_atom{val=match_fail},args=Cargs}, Sub, St0) -> - %% This special case will disappear. - {Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0), - Ar = length(Cargs), - Call = #k_call{anno=A,op=#k_internal{name=match_fail,arity=Ar},args=Kargs}, - {Call,Ap,St1}; -expr(#c_primop{anno=A,name=#c_atom{val=N},args=Cargs}, Sub, St0) -> - {Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0), - Ar = length(Cargs), - {#k_bif{anno=A,op=#k_internal{name=N,arity=Ar},args=Kargs},Ap,St1}; -expr(#c_try{anno=A,arg=Ca,vars=Cvs,body=Cb,evars=Evs,handler=Ch}, Sub0, St0) -> - %% The normal try expression. The body and exception handler - %% variables behave as let variables. - {Ka,Pa,St1} = body(Ca, Sub0, St0), - {Kcvs,Sub1,St2} = pattern_list(Cvs, Sub0, St1), - {Kb,Pb,St3} = body(Cb, Sub1, St2), - {Kevs,Sub2,St4} = pattern_list(Evs, Sub0, St3), - {Kh,Ph,St5} = body(Ch, Sub2, St4), - {#k_try{anno=A,arg=pre_seq(Pa, Ka), - vars=Kcvs,body=pre_seq(Pb, Kb), - evars=Kevs,handler=pre_seq(Ph, Kh)},[],St5}; -expr(#c_catch{anno=A,body=Cb}, Sub, St0) -> - {Kb,Pb,St1} = body(Cb, Sub, St0), - {#k_catch{anno=A,body=pre_seq(Pb, Kb)},[],St1}; -%% Handle internal expressions. -expr(#ireceive_accept{anno=A}, _Sub, St) -> {#k_receive_accept{anno=A},[],St}. - -%% expr_list([Cexpr], Sub, State) -> {[Kexpr],[PreKexpr],State}. - -% expr_list(Ces, Sub, St) -> -% foldr(fun (Ce, {Kes,Esp,St0}) -> -% {Ke,Ep,St1} = expr(Ce, Sub, St0), -% {[Ke|Kes],Ep ++ Esp,St1} -% end, {[],[],St}, Ces). - -%% match_vars(Kexpr, State) -> {[Kvar],[PreKexpr],State}. -%% Force return from body into a list of variables. - -match_vars(#ivalues{args=As}, St) -> - foldr(fun (Ka, {Vs,Vsp,St0}) -> - {V,Vp,St1} = force_variable(Ka, St0), - {[V|Vs],Vp ++ Vsp,St1} - end, {[],[],St}, As); -match_vars(Ka, St0) -> - {V,Vp,St1} = force_variable(Ka, St0), - {[V],Vp,St1}. - -%% c_apply(A, Op, [Carg], Sub, State) -> {Kexpr,[PreKexpr],State}. -%% Transform application, detect which are guaranteed to be bifs. - -c_apply(A, #c_fname{anno=Ra,id=F0,arity=Ar}, Cargs, Sub, St0) -> - {Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0), - F1 = get_fsub(F0, Ar, Sub), %Has it been rewritten - {#k_call{anno=A,op=#k_local{anno=Ra,name=F1,arity=Ar},args=Kargs}, - Ap,St1}; -c_apply(A, Cop, Cargs, Sub, St0) -> - {Kop,Op,St1} = variable(Cop, Sub, St0), - {Kargs,Ap,St2} = atomic_list(Cargs, Sub, St1), - {#k_call{anno=A,op=Kop,args=Kargs},Op ++ Ap,St2}. - -flatten_seq(#iset{anno=A,vars=Vs,arg=Arg,body=B}) -> - [#iset{anno=A,vars=Vs,arg=Arg}|flatten_seq(B)]; -flatten_seq(Ke) -> [Ke]. - -pre_seq([#iset{anno=A,vars=Vs,arg=Arg,body=B}|Ps], K) -> - B = undefined, %Assertion. - #iset{anno=A,vars=Vs,arg=Arg,body=pre_seq(Ps, K)}; -pre_seq([P|Ps], K) -> - #iset{vars=[],arg=P,body=pre_seq(Ps, K)}; -pre_seq([], K) -> K. - -%% atomic_lit(Cexpr, Sub, State) -> {Katomic,[PreKexpr],State}. -%% Convert a Core expression making sure the result is an atomic -%% literal. - -atomic_lit(Ce, Sub, St0) -> - {Ke,Kp,St1} = expr(Ce, Sub, St0), - {Ka,Ap,St2} = force_atomic(Ke, St1), - {Ka,Kp ++ Ap,St2}. - -force_atomic(Ke, St0) -> - case is_atomic(Ke) of - true -> {Ke,[],St0}; - false -> - {V,St1} = new_var(St0), - {V,[#iset{vars=[V],arg=Ke}],St1} - end. - -% force_atomic_list(Kes, St) -> -% foldr(fun (Ka, {As,Asp,St0}) -> -% {A,Ap,St1} = force_atomic(Ka, St0), -% {[A|As],Ap ++ Asp,St1} -% end, {[],[],St}, Kes). - -atomic_bin([#c_bitstr{anno=A,val=E0,size=S0,unit=U,type=T,flags=Fs}|Es0], - Sub, St0, B0) -> - {E,Ap1,St1} = atomic_lit(E0, Sub, St0), - {S1,Ap2,St2} = atomic_lit(S0, Sub, St1), - validate_bin_element_size(S1), - U0 = core_lib:literal_value(U), - Fs0 = core_lib:literal_value(Fs), - {B1,Fs1} = aligned(B0, S1, U0, Fs0), - {Es,Ap3,St3} = atomic_bin(Es0, Sub, St2, B1), - {#k_bin_seg{anno=A,size=S1, - unit=U0, - type=core_lib:literal_value(T), - flags=Fs1, - seg=E,next=Es}, - Ap1++Ap2++Ap3,St3}; -atomic_bin([], _Sub, St, _Bits) -> {#k_bin_end{},[],St}. - -validate_bin_element_size(#k_var{}) -> ok; -validate_bin_element_size(#k_int{val=V}) when V >= 0 -> ok; -validate_bin_element_size(#k_atom{val=all}) -> ok; -validate_bin_element_size(_) -> throw(bad_element_size). - -%% atomic_list([Cexpr], Sub, State) -> {[Kexpr],[PreKexpr],State}. - -atomic_list(Ces, Sub, St) -> - foldr(fun (Ce, {Kes,Esp,St0}) -> - {Ke,Ep,St1} = atomic_lit(Ce, Sub, St0), - {[Ke|Kes],Ep ++ Esp,St1} - end, {[],[],St}, Ces). - -%% is_atomic(Kexpr) -> boolean(). -%% Is a Kexpr atomic? Strings are NOT considered atomic! - -is_atomic(#k_int{}) -> true; -is_atomic(#k_float{}) -> true; -is_atomic(#k_atom{}) -> true; -%%is_atomic(#k_char{}) -> true; %No characters -%%is_atomic(#k_string{}) -> true; -is_atomic(#k_nil{}) -> true; -is_atomic(#k_var{}) -> true; -is_atomic(_) -> false. - -%% variable(Cexpr, Sub, State) -> {Kvar,[PreKexpr],State}. -%% Convert a Core expression making sure the result is a variable. - -variable(Ce, Sub, St0) -> - {Ke,Kp,St1} = expr(Ce, Sub, St0), - {Kv,Vp,St2} = force_variable(Ke, St1), - {Kv,Kp ++ Vp,St2}. - -force_variable(#k_var{}=Ke, St) -> {Ke,[],St}; -force_variable(Ke, St0) -> - {V,St1} = new_var(St0), - {V,[#iset{vars=[V],arg=Ke}],St1}. - -%% pattern(Cpat, Sub, State) -> {Kpat,Sub,State}. -%% Convert patterns. Variables shadow so rename variables that are -%% already defined. - -pattern(#c_var{anno=A,name=V}, Sub, St0) -> - case sets:is_element(V, St0#kern.ds) of - true -> - {New,St1} = new_var_name(St0), - {#k_var{anno=A,name=New}, - set_vsub(V, New, Sub), - St1#kern{ds=sets:add_element(New, St1#kern.ds)}}; - false -> - {#k_var{anno=A,name=V},Sub, - St0#kern{ds=sets:add_element(V, St0#kern.ds)}} - end; -pattern(#c_char{anno=A,val=C}, Sub, St) -> - {#k_int{anno=A,val=C},Sub,St}; %Convert to integers! -pattern(#c_int{anno=A,val=I}, Sub, St) -> - {#k_int{anno=A,val=I},Sub,St}; -pattern(#c_float{anno=A,val=F}, Sub, St) -> - {#k_float{anno=A,val=F},Sub,St}; -pattern(#c_atom{anno=A,val=At}, Sub, St) -> - {#k_atom{anno=A,val=At},Sub,St}; -pattern(#c_string{val=S}, Sub, St) -> - L = foldr(fun (C, T) -> #k_cons{hd=#k_int{val=C},tl=T} end, - #k_nil{}, S), - {L,Sub,St}; -pattern(#c_nil{anno=A}, Sub, St) -> - {#k_nil{anno=A},Sub,St}; -pattern(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub0, St0) -> - {Kh,Sub1,St1} = pattern(Ch, Sub0, St0), - {Kt,Sub2,St2} = pattern(Ct, Sub1, St1), - {#k_cons{anno=A,hd=Kh,tl=Kt},Sub2,St2}; -pattern(#c_tuple{anno=A,es=Ces}, Sub0, St0) -> - {Kes,Sub1,St1} = pattern_list(Ces, Sub0, St0), - {#k_tuple{anno=A,es=Kes},Sub1,St1}; -pattern(#c_binary{anno=A,segments=Cv}, Sub0, St0) -> - {Kv,Sub1,St1} = pattern_bin(Cv, Sub0, St0), - {#k_binary{anno=A,segs=Kv},Sub1,St1}; -pattern(#c_alias{anno=A,var=Cv,pat=Cp}, Sub0, St0) -> - {Cvs,Cpat} = flatten_alias(Cp), - {Kvs,Sub1,St1} = pattern_list([Cv|Cvs], Sub0, St0), - {Kpat,Sub2,St2} = pattern(Cpat, Sub1, St1), - {#ialias{anno=A,vars=Kvs,pat=Kpat},Sub2,St2}. - -flatten_alias(#c_alias{var=V,pat=P}) -> - {Vs,Pat} = flatten_alias(P), - {[V|Vs],Pat}; -flatten_alias(Pat) -> {[],Pat}. - -pattern_bin(Es, Sub, St) -> pattern_bin(Es, Sub, St, 0). - -pattern_bin([#c_bitstr{anno=A,val=E0,size=S0,unit=U,type=T,flags=Fs}|Es0], - Sub0, St0, B0) -> - {S1,[],St1} = expr(S0, Sub0, St0), - U0 = core_lib:literal_value(U), - Fs0 = core_lib:literal_value(Fs), - %%ok= io:fwrite("~w: ~p~n", [?LINE,{B0,S1,U0,Fs0}]), - {B1,Fs1} = aligned(B0, S1, U0, Fs0), - {E,Sub1,St2} = pattern(E0, Sub0, St1), - {Es,Sub2,St3} = pattern_bin(Es0, Sub1, St2, B1), - {#k_bin_seg{anno=A,size=S1, - unit=U0, - type=core_lib:literal_value(T), - flags=Fs1, - seg=E,next=Es}, - Sub2,St3}; -pattern_bin([], Sub, St, _Bits) -> {#k_bin_end{},Sub,St}. - -%% pattern_list([Cexpr], Sub, State) -> {[Kexpr],Sub,State}. - -pattern_list(Ces, Sub, St) -> - foldr(fun (Ce, {Kes,Sub0,St0}) -> - {Ke,Sub1,St1} = pattern(Ce, Sub0, St0), - {[Ke|Kes],Sub1,St1} - end, {[],Sub,St}, Ces). - -%% new_sub() -> Subs. -%% set_vsub(Name, Sub, Subs) -> Subs. -%% subst_vsub(Name, Sub, Subs) -> Subs. -%% get_vsub(Name, Subs) -> SubName. -%% Add/get substitute Sub for Name to VarSub. Use orddict so we know -%% the format is a list {Name,Sub} pairs. When adding a new -%% substitute we fold substitute chains so we never have to search -%% more than once. - -new_sub() -> orddict:new(). - -get_vsub(V, Vsub) -> - case orddict:find(V, Vsub) of - {ok,Val} -> Val; - error -> V - end. - -set_vsub(V, S, Vsub) -> - orddict:store(V, S, Vsub). - -subst_vsub(V, S, Vsub0) -> - %% Fold chained substitutions. - Vsub1 = orddict:map(fun (_, V1) when V1 =:= V -> S; - (_, V1) -> V1 - end, Vsub0), - orddict:store(V, S, Vsub1). - -get_fsub(F, A, Fsub) -> - case orddict:find({F,A}, Fsub) of - {ok,Val} -> Val; - error -> F - end. - -set_fsub(F, A, S, Fsub) -> - orddict:store({F,A}, S, Fsub). - -new_fun_name(St) -> - new_fun_name("anonymous", St). - -%% new_fun_name(Type, State) -> {FunName,State}. - -new_fun_name(Type, #kern{func={F,Arity},fcount=C}=St) -> - Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(Arity) ++ - "-" ++ Type ++ "-" ++ integer_to_list(C) ++ "-", - {list_to_atom(Name),St#kern{fcount=C+1}}. - -%% new_var_name(State) -> {VarName,State}. - -new_var_name(#kern{vcount=C}=St) -> - {list_to_atom("ker" ++ integer_to_list(C)),St#kern{vcount=C+1}}. - -%% new_var(State) -> {#k_var{},State}. - -new_var(St0) -> - {New,St1} = new_var_name(St0), - {#k_var{name=New},St1}. - -%% new_vars(Count, State) -> {[#k_var{}],State}. -%% Make Count new variables. - -new_vars(N, St) -> new_vars(N, St, []). - -new_vars(N, St0, Vs) when N > 0 -> - {V,St1} = new_var(St0), - new_vars(N-1, St1, [V|Vs]); -new_vars(0, St, Vs) -> {Vs,St}. - -make_vars(Vs) -> [ #k_var{name=V} || V <- Vs ]. - -add_var_def(V, St) -> - St#kern{ds=sets:add_element(V#k_var.name, St#kern.ds)}. - -%%add_vars_def(Vs, St) -> -%% Ds = foldl(fun (#k_var{name=V}, Ds) -> add_element(V, Ds) end, -%% St#kern.ds, Vs), -%% St#kern{ds=Ds}. - -%% is_remote_bif(Mod, Name, Arity) -> true | false. -%% Test if function is really a BIF. - -is_remote_bif(erlang, is_boolean, 1) -> - %% XXX Remove this clause in R11. For bootstrap purposes, we must - %% recognize erlang:is_boolean/1 here. - true; -is_remote_bif(erlang, internal_is_record, 3) -> true; -is_remote_bif(erlang, get, 1) -> true; -is_remote_bif(erlang, N, A) -> - case erl_internal:guard_bif(N, A) of - true -> true; - false -> - case erl_internal:type_test(N, A) of - true -> true; - false -> - case catch erl_internal:op_type(N, A) of - arith -> true; - bool -> true; - comp -> true; - _Other -> false %List, send or not an op - end - end - end; -is_remote_bif(_, _, _) -> false. - -%% bif_vals(Name, Arity) -> integer(). -%% bif_vals(Mod, Name, Arity) -> integer(). -%% Determine how many return values a BIF has. Provision for BIFs to -%% return multiple values. Only used in bodies where a BIF may be -%% called for effect only. - -bif_vals(dsetelement, 3) -> 0; -bif_vals(_, _) -> 1. - -bif_vals(_, _, _) -> 1. - -%% foldr2(Fun, Acc, List1, List2) -> Acc. -%% Fold over two lists. - -foldr2(Fun, Acc0, [E1|L1], [E2|L2]) -> - Acc1 = Fun(E1, E2, Acc0), - foldr2(Fun, Acc1, L1, L2); -foldr2(_, Acc, [], []) -> Acc. - -%% first([A]) -> [A]. -%% last([A]) -> A. - -last([L]) -> L; -last([_|T]) -> last(T). - -first([_]) -> []; -first([H|T]) -> [H|first(T)]. - -%% This code implements the algorithm for an optimizing compiler for -%% pattern matching given "The Implementation of Functional -%% Programming Languages" by Simon Peyton Jones. The code is much -%% longer as the meaning of constructors is different from the book. -%% -%% In Erlang many constructors can have different values, e.g. 'atom' -%% or 'integer', whereas in the original algorithm thse would be -%% different constructors. Our view makes it easier in later passes to -%% handle indexing over each type. -%% -%% Patterns are complicated by having alias variables. The form of a -%% pattern is Pat | {alias,Pat,[AliasVar]}. This is hidden by access -%% functions to pattern arguments but the code must be aware of it. -%% -%% The compilation proceeds in two steps: -%% -%% 1. The patterns in the clauses to converted to lists of kernel -%% patterns. The Core clause is now hybrid, this is easier to work -%% with. Remove clauses with trivially false guards, this simplifies -%% later passes. Add local defined vars and variable subs to each -%% clause for later use. -%% -%% 2. The pattern matching is optimised. Variable substitutions are -%% added to the VarSub structure and new variables are made visible. -%% The guard and body are then converted to Kernel form. - -%% kmatch([Var], [Clause], Sub, State) -> {Kexpr,[PreExpr],State}. - -kmatch(Us, Ccs, Sub, St0) -> - {Cs,St1} = match_pre(Ccs, Sub, St0), %Convert clauses - %%Def = kernel_match_error, %The strict case - %% This should be a kernel expression from the first pass. - Def = #k_call{anno=[compiler_generated], - op=#k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=exit}, - arity=1}, - args=[#k_atom{val=kernel_match_error}]}, - {Km,St2} = match(Us, Cs, Def, St1), %Do the match. - {Km,St2}. - -%% match_pre([Cclause], Sub, State) -> {[Clause],State}. -%% Must be careful not to generate new substitutions here now! -%% Remove clauses with trivially false guards which will never -%% succeed. - -match_pre(Cs, Sub0, St) -> - foldr(fun (#c_clause{anno=A,pats=Ps,guard=G,body=B}, {Cs0,St0}) -> - case is_false_guard(G) of - true -> {Cs0,St0}; - false -> - {Kps,Sub1,St1} = pattern_list(Ps, Sub0, St0), - {[#iclause{anno=A,sub=Sub1,pats=Kps,guard=G,body=B}| - Cs0],St1} - end - end, {[],St}, Cs). - -%% match([Var], [Clause], Default, State) -> {MatchExpr,State}. - -match([U|Us], Cs, Def, St0) -> - %%ok = io:format("match ~p~n", [Cs]), - Pcss = partition(Cs), - foldr(fun (Pcs, {D,St}) -> match_varcon([U|Us], Pcs, D, St) end, - {Def,St0}, Pcss); -match([], Cs, Def, St) -> - match_guard(Cs, Def, St). - -%% match_guard([Clause], Default, State) -> {IfExpr,State}. -%% Build a guard to handle guards. A guard *ALWAYS* fails if no -%% clause matches, there will be a surrounding 'alt' to catch the -%% failure. Drop redundant cases, i.e. those after a true guard. - -match_guard(Cs0, Def0, St0) -> - {Cs1,Def1,St1} = match_guard_1(Cs0, Def0, St0), - {build_alt(build_guard(Cs1), Def1),St1}. - -match_guard_1([#iclause{anno=A,sub=Sub,guard=G,body=B}|Cs0], Def0, St0) -> - case is_true_guard(G) of - true -> - %% The true clause body becomes the default. - {Kb,Pb,St1} = body(B, Sub, St0), - Line = get_line(A), - St2 = maybe_add_warning(Cs0, Line, St1), - St = maybe_add_warning(Def0, Line, St2), - {[],pre_seq(Pb, Kb),St}; - false -> - {Kg,St1} = guard(G, Sub, St0), - {Kb,Pb,St2} = body(B, Sub, St1), - {Cs1,Def1,St3} = match_guard_1(Cs0, Def0, St2), - {[#k_guard_clause{guard=Kg,body=pre_seq(Pb, Kb)}|Cs1], - Def1,St3} - end; -match_guard_1([], Def, St) -> {[],Def,St}. - -maybe_add_warning([C|_], Line, St) -> - maybe_add_warning(C, Line, St); -maybe_add_warning([], _Line, St) -> St; -maybe_add_warning(fail, _Line, St) -> St; -maybe_add_warning(Ke, MatchLine, St) -> - case get_kanno(Ke) of - [compiler_generated|_] -> St; - Anno -> - Line = get_line(Anno), - Warn = case MatchLine of - none -> nomatch_shadow; - _ -> {nomatch_shadow,MatchLine} - end, - add_warning(Line, Warn, St) - end. - -get_line([Line|_]) when is_integer(Line) -> Line; -get_line([_|T]) -> get_line(T); -get_line([]) -> none. - - -%% is_true_guard(Guard) -> boolean(). -%% is_false_guard(Guard) -> boolean(). -%% Test if a guard is either trivially true/false. This has probably -%% already been optimised away, but what the heck! - -is_true_guard(G) -> guard_value(G) == true. -is_false_guard(G) -> guard_value(G) == false. - -%% guard_value(Guard) -> true | false | unknown. - -guard_value(#c_atom{val=true}) -> true; -guard_value(#c_atom{val=false}) -> false; -guard_value(#c_call{module=#c_atom{val=erlang}, - name=#c_atom{val='not'}, - args=[A]}) -> - case guard_value(A) of - true -> false; - false -> true; - unknown -> unknown - end; -guard_value(#c_call{module=#c_atom{val=erlang}, - name=#c_atom{val='and'}, - args=[Ca,Cb]}) -> - case guard_value(Ca) of - true -> guard_value(Cb); - false -> false; - unknown -> - case guard_value(Cb) of - false -> false; - _Other -> unknown - end - end; -guard_value(#c_call{module=#c_atom{val=erlang}, - name=#c_atom{val='or'}, - args=[Ca,Cb]}) -> - case guard_value(Ca) of - true -> true; - false -> guard_value(Cb); - unknown -> - case guard_value(Cb) of - true -> true; - _Other -> unknown - end - end; -guard_value(#c_try{arg=E,vars=[#c_var{name=X}],body=#c_var{name=X}, - handler=#c_atom{val=false}}) -> - guard_value(E); -guard_value(_) -> unknown. - -%% partition([Clause]) -> [[Clause]]. -%% Partition a list of clauses into groups which either contain -%% clauses with a variable first argument, or with a "constructor". - -partition([C1|Cs]) -> - V1 = is_var_clause(C1), - {More,Rest} = splitwith(fun (C) -> is_var_clause(C) == V1 end, Cs), - [[C1|More]|partition(Rest)]; -partition([]) -> []. - -%% match_varcon([Var], [Clause], Def, [Var], Sub, State) -> -%% {MatchExpr,State}. - -match_varcon(Us, [C|_]=Cs, Def, St) -> - case is_var_clause(C) of - true -> match_var(Us, Cs, Def, St); - false -> match_con(Us, Cs, Def, St) - end. - -%% match_var([Var], [Clause], Def, State) -> {MatchExpr,State}. -%% Build a call to "select" from a list of clauses all containing a -%% variable as the first argument. We must rename the variable in -%% each clause to be the match variable as these clause will share -%% this variable and may have different names for it. Rename aliases -%% as well. - -match_var([U|Us], Cs0, Def, St) -> - Cs1 = map(fun (#iclause{sub=Sub0,pats=[Arg|As]}=C) -> - Vs = [arg_arg(Arg)|arg_alias(Arg)], - Sub1 = foldl(fun (#k_var{name=V}, Acc) -> - subst_vsub(V, U#k_var.name, Acc) - end, Sub0, Vs), - C#iclause{sub=Sub1,pats=As} - end, Cs0), - match(Us, Cs1, Def, St). - -%% match_con(Variables, [Clause], Default, State) -> {SelectExpr,State}. -%% Build call to "select" from a list of clauses all containing a -%% constructor/constant as first argument. Group the constructors -%% according to type, the order is really irrelevant but tries to be -%% smart. - -match_con([U|Us], Cs, Def, St0) -> - %% Extract clauses for different constructors (types). - %%ok = io:format("match_con ~p~n", [Cs]), - Ttcs = [ {T,Tcs} || T <- [k_cons,k_tuple,k_atom,k_float,k_int,k_nil, - k_binary,k_bin_end], - begin Tcs = select(T, Cs), - Tcs /= [] - end ] ++ select_bin_con(Cs), - %%ok = io:format("ttcs = ~p~n", [Ttcs]), - {Scs,St1} = - mapfoldl(fun ({T,Tcs}, St) -> - {[S|_]=Sc,S1} = match_value([U|Us], T, Tcs, fail, St), - %%ok = io:format("match_con type2 ~p~n", [T]), - Anno = get_kanno(S), - {#k_type_clause{anno=Anno,type=T,values=Sc},S1} end, - St0, Ttcs), - {build_alt_1st_no_fail(build_select(U, Scs), Def),St1}. - -%% select_bin_con([Clause]) -> [{Type,[Clause]}]. -%% Extract clauses for the k_bin_seg constructor. As k_bin_seg -%% matching can overlap, the k_bin_seg constructors cannot be -%% reordered, only grouped. - -select_bin_con(Cs0) -> - Cs1 = lists:filter(fun (C) -> - clause_con(C) == k_bin_seg - end, Cs0), - select_bin_con_1(Cs1). - -select_bin_con_1([C1|Cs]) -> - Con = clause_con(C1), - {More,Rest} = splitwith(fun (C) -> clause_con(C) == Con end, Cs), - [{Con,[C1|More]}|select_bin_con_1(Rest)]; -select_bin_con_1([]) -> []. - -%% select(Con, [Clause]) -> [Clause]. - -select(T, Cs) -> [ C || C <- Cs, clause_con(C) == T ]. - -%% match_value([Var], Con, [Clause], Default, State) -> {SelectExpr,State}. -%% At this point all the clauses have the same constructor, we must -%% now separate them according to value. - -match_value(_, _, [], _, St) -> {[],St}; -match_value(Us, T, Cs0, Def, St0) -> - Css = group_value(T, Cs0), - %%ok = io:format("match_value ~p ~p~n", [T, Css]), - {Css1,St1} = mapfoldl(fun (Cs, St) -> - match_clause(Us, Cs, Def, St) end, - St0, Css), - {Css1,St1}. - %%{#k_select_val{type=T,var=hd(Us),clauses=Css1},St1}. - -%% group_value([Clause]) -> [[Clause]]. -%% Group clauses according to value. Here we know that -%% 1. Some types are singled valued -%% 2. The clauses in bin_segs cannot be reordered only grouped -%% 3. Other types are disjoint and can be reordered - -group_value(k_cons, Cs) -> [Cs]; %These are single valued -group_value(k_nil, Cs) -> [Cs]; -group_value(k_binary, Cs) -> [Cs]; -group_value(k_bin_end, Cs) -> [Cs]; -group_value(k_bin_seg, Cs) -> - group_bin_seg(Cs); -group_value(_, Cs) -> - %% group_value(Cs). - Cd = foldl(fun (C, Gcs0) -> dict:append(clause_val(C), C, Gcs0) end, - dict:new(), Cs), - dict:fold(fun (_, Vcs, Css) -> [Vcs|Css] end, [], Cd). - -group_bin_seg([C1|Cs]) -> - V1 = clause_val(C1), - {More,Rest} = splitwith(fun (C) -> clause_val(C) == V1 end, Cs), - [[C1|More]|group_bin_seg(Rest)]; -group_bin_seg([]) -> []. - -%% Profiling shows that this quadratic implementation account for a big amount -%% of the execution time if there are many values. -% group_value([C|Cs]) -> -% V = clause_val(C), -% Same = [ Cv || Cv <- Cs, clause_val(Cv) == V ], %Same value -% Rest = [ Cv || Cv <- Cs, clause_val(Cv) /= V ], % and all the rest -% [[C|Same]|group_value(Rest)]; -% group_value([]) -> []. - -%% match_clause([Var], [Clause], Default, State) -> {Clause,State}. -%% At this point all the clauses have the same "value". Build one -%% select clause for this value and continue matching. Rename -%% aliases as well. - -match_clause([U|Us], [C|_]=Cs0, Def, St0) -> - Anno = get_kanno(C), - {Match0,Vs,St1} = get_match(get_con(Cs0), St0), - Match = sub_size_var(Match0, Cs0), - {Cs1,St2} = new_clauses(Cs0, U, St1), - {B,St3} = match(Vs ++ Us, Cs1, Def, St2), - {#k_val_clause{anno=Anno,val=Match,body=B},St3}. - -sub_size_var(#k_bin_seg{size=#k_var{name=Name}=Kvar}=BinSeg, [#iclause{sub=Sub}|_]) -> - BinSeg#k_bin_seg{size=Kvar#k_var{name=get_vsub(Name, Sub)}}; -sub_size_var(K, _) -> K. - -get_con([C|_]) -> arg_arg(clause_arg(C)). %Get the constructor - -get_match(#k_cons{}, St0) -> - {[H,T],St1} = new_vars(2, St0), - {#k_cons{hd=H,tl=T},[H,T],St1}; -get_match(#k_binary{}, St0) -> - {[V]=Mes,St1} = new_vars(1, St0), - {#k_binary{segs=V},Mes,St1}; -get_match(#k_bin_seg{}=Seg, St0) -> - {[S,N]=Mes,St1} = new_vars(2, St0), - {Seg#k_bin_seg{seg=S,next=N},Mes,St1}; -get_match(#k_tuple{es=Es}, St0) -> - {Mes,St1} = new_vars(length(Es), St0), - {#k_tuple{es=Mes},Mes,St1}; -get_match(M, St) -> - {M,[],St}. - -new_clauses(Cs0, U, St) -> - Cs1 = map(fun (#iclause{sub=Sub0,pats=[Arg|As]}=C) -> - Head = case arg_arg(Arg) of - #k_cons{hd=H,tl=T} -> [H,T|As]; - #k_tuple{es=Es} -> Es ++ As; - #k_binary{segs=E} -> [E|As]; - #k_bin_seg{seg=S,next=N} -> - [S,N|As]; - _Other -> As - end, - Vs = arg_alias(Arg), - Sub1 = foldl(fun (#k_var{name=V}, Acc) -> - subst_vsub(V, U#k_var.name, Acc) - end, Sub0, Vs), - C#iclause{sub=Sub1,pats=Head} - end, Cs0), - {Cs1,St}. - -%% build_guard([GuardClause]) -> GuardExpr. - -build_guard([]) -> fail; -build_guard(Cs) -> #k_guard{clauses=Cs}. - -%% build_select(Var, [ConClause]) -> SelectExpr. - -build_select(V, [Tc|_]=Tcs) -> - Anno = get_kanno(Tc), - #k_select{anno=Anno,var=V,types=Tcs}. - -%% build_alt(First, Then) -> AltExpr. -%% Build an alt, attempt some simple optimisation. - -build_alt(fail, Then) -> Then; -build_alt(First,Then) -> build_alt_1st_no_fail(First, Then). - -build_alt_1st_no_fail(First, fail) -> First; -build_alt_1st_no_fail(First, Then) -> #k_alt{first=First,then=Then}. - -%% build_match([MatchVar], MatchExpr) -> Kexpr. -%% Build a match expr if there is a match. - -build_match(Us, #k_alt{}=Km) -> #k_match{vars=Us,body=Km}; -build_match(Us, #k_select{}=Km) -> #k_match{vars=Us,body=Km}; -build_match(Us, #k_guard{}=Km) -> #k_match{vars=Us,body=Km}; -build_match(_, Km) -> Km. - -%% clause_arg(Clause) -> FirstArg. -%% clause_con(Clause) -> Constructor. -%% clause_val(Clause) -> Value. -%% is_var_clause(Clause) -> boolean(). - -clause_arg(#iclause{pats=[Arg|_]}) -> Arg. - -clause_con(C) -> arg_con(clause_arg(C)). - -clause_val(C) -> arg_val(clause_arg(C)). - -is_var_clause(C) -> clause_con(C) == k_var. - -%% arg_arg(Arg) -> Arg. -%% arg_alias(Arg) -> Aliases. -%% arg_con(Arg) -> Constructor. -%% arg_val(Arg) -> Value. -%% These are the basic functions for obtaining fields in an argument. - -arg_arg(#ialias{pat=Con}) -> Con; -arg_arg(Con) -> Con. - -arg_alias(#ialias{vars=As}) -> As; -arg_alias(_Con) -> []. - -arg_con(Arg) -> - case arg_arg(Arg) of - #k_int{} -> k_int; - #k_float{} -> k_float; - #k_atom{} -> k_atom; - #k_nil{} -> k_nil; - #k_cons{} -> k_cons; - #k_tuple{} -> k_tuple; - #k_binary{} -> k_binary; - #k_bin_end{} -> k_bin_end; - #k_bin_seg{} -> k_bin_seg; - #k_var{} -> k_var - end. - -arg_val(Arg) -> - case arg_arg(Arg) of - #k_int{val=I} -> I; - #k_float{val=F} -> F; - #k_atom{val=A} -> A; - #k_nil{} -> 0; - #k_cons{} -> 2; - #k_tuple{es=Es} -> length(Es); - #k_bin_seg{size=S,unit=U,type=T,flags=Fs} -> - {set_kanno(S, []),U,T,Fs}; - #k_bin_end{} -> 0; - #k_binary{} -> 0 - end. - -%% ubody(Expr, Break, State) -> {Expr,[UsedVar],State}. -%% Tag the body sequence with its used variables. These bodies -%% either end with a #k_break{}, or with #k_return{} or an expression -%% which itself can return, #k_enter{}, #k_match{} ... . - -ubody(#iset{vars=[],arg=#iletrec{}=Let,body=B0}, Br, St0) -> - %% An iletrec{} should never be last. - St1 = iletrec_funs(Let, St0), - ubody(B0, Br, St1); -ubody(#iset{anno=A,vars=Vs,arg=E0,body=B0}, Br, St0) -> - {E1,Eu,St1} = uexpr(E0, {break,Vs}, St0), - {B1,Bu,St2} = ubody(B0, Br, St1), - Ns = lit_list_vars(Vs), - Used = union(Eu, subtract(Bu, Ns)), %Used external vars - {#k_seq{anno=#k{us=Used,ns=Ns,a=A},arg=E1,body=B1},Used,St2}; -ubody(#ivalues{anno=A,args=As}, return, St) -> - Au = lit_list_vars(As), - {#k_return{anno=#k{us=Au,ns=[],a=A},args=As},Au,St}; -ubody(#ivalues{anno=A,args=As}, {break,_Vbs}, St) -> - Au = lit_list_vars(As), - {#k_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St}; -ubody(E, return, St0) -> - %% Enterable expressions need no trailing return. - case is_enter_expr(E) of - true -> uexpr(E, return, St0); - false -> - {Ea,Pa,St1} = force_atomic(E, St0), - ubody(pre_seq(Pa, #ivalues{args=[Ea]}), return, St1) - end; -ubody(E, {break,Rs}, St0) -> - %%ok = io:fwrite("ubody ~w:~p~n", [?LINE,{E,Br}]), - %% Exiting expressions need no trailing break. - case is_exit_expr(E) of - true -> uexpr(E, return, St0); - false -> - {Ea,Pa,St1} = force_atomic(E, St0), - ubody(pre_seq(Pa, #ivalues{args=[Ea]}), {break,Rs}, St1) - end. - -iletrec_funs(#iletrec{defs=Fs}, St0) -> - %% Use union of all free variables. - %% First just work out free variables for all functions. - Free = foldl(fun ({_,#ifun{vars=Vs,body=Fb0}}, Free0) -> - {_,Fbu,_} = ubody(Fb0, return, St0), - Ns = lit_list_vars(Vs), - Free1 = subtract(Fbu, Ns), - union(Free1, Free0) - end, [], Fs), - FreeVs = make_vars(Free), - %% Add this free info to State. - St1 = foldl(fun ({N,#ifun{vars=Vs}}, Lst) -> - store_free(N, length(Vs), FreeVs, Lst) - end, St0, Fs), - %% Now regenerate local functions to use free variable information. - St2 = foldl(fun ({N,#ifun{anno=Fa,vars=Vs,body=Fb0}}, Lst0) -> - {Fb1,_,Lst1} = ubody(Fb0, return, Lst0), - Arity = length(Vs) + length(FreeVs), - Fun = #k_fdef{anno=#k{us=[],ns=[],a=Fa}, - func=N,arity=Arity, - vars=Vs ++ FreeVs,body=Fb1}, - Lst1#kern{funs=[Fun|Lst1#kern.funs]} - end, St1, Fs), - St2. - -%% is_exit_expr(Kexpr) -> boolean(). -%% Test whether Kexpr always exits and never returns. - -is_exit_expr(#k_call{op=#k_remote{mod=erlang,name=throw,arity=1}}) -> true; -is_exit_expr(#k_call{op=#k_remote{mod=erlang,name=exit,arity=1}}) -> true; -is_exit_expr(#k_call{op=#k_remote{mod=erlang,name=error,arity=1}}) -> true; -is_exit_expr(#k_call{op=#k_remote{mod=erlang,name=error,arity=2}}) -> true; -is_exit_expr(#k_call{op=#k_remote{mod=erlang,name=fault,arity=1}}) -> true; -is_exit_expr(#k_call{op=#k_remote{mod=erlang,name=fault,arity=2}}) -> true; -is_exit_expr(#k_call{op=#k_internal{name=match_fail,arity=1}}) -> true; -is_exit_expr(#k_bif{op=#k_internal{name=rethrow,arity=2}}) -> true; -is_exit_expr(#k_receive_next{}) -> true; -is_exit_expr(_) -> false. - -%% is_enter_expr(Kexpr) -> boolean(). -%% Test whether Kexpr is "enterable", i.e. can handle return from -%% within itself without extra #k_return{}. - -is_enter_expr(#k_call{}) -> true; -is_enter_expr(#k_match{}) -> true; -is_enter_expr(#k_receive{}) -> true; -is_enter_expr(#k_receive_next{}) -> true; -%%is_enter_expr(#k_try{}) -> true; %Soon -is_enter_expr(_) -> false. - -%% uguard(Expr, State) -> {Expr,[UsedVar],State}. -%% Tag the guard sequence with its used variables. - -uguard(#k_try{anno=A,arg=B0,vars=[#k_var{name=X}],body=#k_var{name=X}, - handler=#k_atom{val=false}}=Try, St0) -> - {B1,Bu,St1} = uguard(B0, St0), - {Try#k_try{anno=#k{us=Bu,ns=[],a=A},arg=B1},Bu,St1}; -uguard(T, St) -> - %%ok = io:fwrite("~w: ~p~n", [?LINE,T]), - uguard_test(T, St). - -%% uguard_test(Expr, State) -> {Test,[UsedVar],State}. -%% At this stage tests are just expressions which don't return any -%% values. - -uguard_test(T, St) -> uguard_expr(T, [], St). - -uguard_expr(#iset{anno=A,vars=Vs,arg=E0,body=B0}, Rs, St0) -> - Ns = lit_list_vars(Vs), - {E1,Eu,St1} = uguard_expr(E0, Vs, St0), - {B1,Bu,St2} = uguard_expr(B0, Rs, St1), - Used = union(Eu, subtract(Bu, Ns)), - {#k_seq{anno=#k{us=Used,ns=Ns,a=A},arg=E1,body=B1},Used,St2}; -uguard_expr(#k_try{anno=A,arg=B0,vars=[#k_var{name=X}],body=#k_var{name=X}, - handler=#k_atom{val=false}}=Try, Rs, St0) -> - {B1,Bu,St1} = uguard_expr(B0, Rs, St0), - {Try#k_try{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A},arg=B1,ret=Rs}, - Bu,St1}; -uguard_expr(#k_test{anno=A,op=Op,args=As}=Test, Rs, St) -> - [] = Rs, %Sanity check - Used = union(op_vars(Op), lit_list_vars(As)), - {Test#k_test{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A}}, - Used,St}; -uguard_expr(#k_bif{anno=A,op=Op,args=As}=Bif, Rs, St) -> - Used = union(op_vars(Op), lit_list_vars(As)), - {Bif#k_bif{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A},ret=Rs}, - Used,St}; -uguard_expr(#ivalues{anno=A,args=As}, Rs, St) -> - Sets = foldr2(fun (V, Arg, Rhs) -> - #iset{anno=A,vars=[V],arg=Arg,body=Rhs} - end, #k_atom{val=true}, Rs, As), - uguard_expr(Sets, [], St); -uguard_expr(#k_match{anno=A,vars=Vs,body=B0}, Rs, St0) -> - %% Experimental support for andalso/orelse in guards. - Br = case Rs of - [] -> return; - _ -> {break,Rs} - end, - {B1,Bu,St1} = umatch(B0, Br, St0), - {#k_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A}, - vars=Vs,body=B1,ret=Rs},Bu,St1}; -uguard_expr(Lit, Rs, St) -> - %% Transform literals to puts here. - Used = lit_vars(Lit), - {#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)}, - arg=Lit,ret=Rs},Used,St}. - -%% uexpr(Expr, Break, State) -> {Expr,[UsedVar],State}. -%% Tag an expression with its used variables. -%% Break = return | {break,[RetVar]}. - -uexpr(#k_call{anno=A,op=#k_local{name=F,arity=Ar}=Op,args=As0}=Call, Br, St) -> - Free = get_free(F, Ar, St), - As1 = As0 ++ Free, %Add free variables LAST! - Used = lit_list_vars(As1), - {case Br of - {break,Rs} -> - Call#k_call{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A}, - op=Op#k_local{arity=Ar + length(Free)}, - args=As1,ret=Rs}; - return -> - #k_enter{anno=#k{us=Used,ns=[],a=A}, - op=Op#k_local{arity=Ar + length(Free)}, - args=As1} - end,Used,St}; -uexpr(#k_call{anno=A,op=Op,args=As}=Call, {break,Rs}, St) -> - Used = union(op_vars(Op), lit_list_vars(As)), - {Call#k_call{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A},ret=Rs}, - Used,St}; -uexpr(#k_call{anno=A,op=Op,args=As}, return, St) -> - Used = union(op_vars(Op), lit_list_vars(As)), - {#k_enter{anno=#k{us=Used,ns=[],a=A},op=Op,args=As}, - Used,St}; -uexpr(#k_bif{anno=A,op=Op,args=As}=Bif, {break,Rs}, St0) -> - Used = union(op_vars(Op), lit_list_vars(As)), - {Brs,St1} = bif_returns(Op, Rs, St0), - {Bif#k_bif{anno=#k{us=Used,ns=lit_list_vars(Brs),a=A},ret=Brs}, - Used,St1}; -uexpr(#k_match{anno=A,vars=Vs,body=B0}, Br, St0) -> - Rs = break_rets(Br), - {B1,Bu,St1} = umatch(B0, Br, St0), - {#k_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A}, - vars=Vs,body=B1,ret=Rs},Bu,St1}; -uexpr(#k_receive{anno=A,var=V,body=B0,timeout=T,action=A0}, Br, St0) -> - Rs = break_rets(Br), - Tu = lit_vars(T), %Timeout is atomic - {B1,Bu,St1} = umatch(B0, Br, St0), - {A1,Au,St2} = ubody(A0, Br, St1), - Used = del_element(V#k_var.name, union(Bu, union(Tu, Au))), - {#k_receive{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A}, - var=V,body=B1,timeout=T,action=A1,ret=Rs}, - Used,St2}; -uexpr(#k_receive_accept{anno=A}, _, St) -> - {#k_receive_accept{anno=#k{us=[],ns=[],a=A}},[],St}; -uexpr(#k_receive_next{anno=A}, _, St) -> - {#k_receive_next{anno=#k{us=[],ns=[],a=A}},[],St}; -uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}, - {break,Rs0}, St0) -> - {Avs,St1} = new_vars(length(Vs), St0), %Need dummy names here - {A1,Au,St2} = ubody(A0, {break,Avs}, St1), %Must break to clean up here! - {B1,Bu,St3} = ubody(B0, {break,Rs0}, St2), - {H1,Hu,St4} = ubody(H0, {break,Rs0}, St3), - %% Guarantee ONE return variable. - NumNew = if - Rs0 =:= [] -> 1; - true -> 0 - end, - {Ns,St5} = new_vars(NumNew, St4), - Rs1 = Rs0 ++ Ns, - Used = union([Au,subtract(Bu, lit_list_vars(Vs)), - subtract(Hu, lit_list_vars(Evs))]), - {#k_try{anno=#k{us=Used,ns=lit_list_vars(Rs1),a=A}, - arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs1}, - Used,St5}; -uexpr(#k_catch{anno=A,body=B0}, {break,Rs0}, St0) -> - {Rb,St1} = new_var(St0), - {B1,Bu,St2} = ubody(B0, {break,[Rb]}, St1), - %% Guarantee ONE return variable. - {Ns,St3} = new_vars(1 - length(Rs0), St2), - Rs1 = Rs0 ++ Ns, - {#k_catch{anno=#k{us=Bu,ns=lit_list_vars(Rs1),a=A},body=B1,ret=Rs1},Bu,St3}; -uexpr(#ifun{anno=A,vars=Vs,body=B0}=IFun, {break,Rs}, St0) -> - {B1,Bu,St1} = ubody(B0, return, St0), %Return out of new function - Ns = lit_list_vars(Vs), - Free = subtract(Bu, Ns), %Free variables in fun - Fvs = make_vars(Free), - Arity = length(Vs) + length(Free), - {{Index,Uniq,Fname}, St3} = - case lists:keysearch(id, 1, A) of - {value,{id,Id}} -> - {Id, St1}; - false -> - %% No id annotation. Must invent one. - I = St1#kern.fcount, - U = erlang:hash(IFun, (1 bsl 27)-1), - {N, St2} = new_fun_name(St1), - {{I,U,N}, St2} - end, - Fun = #k_fdef{anno=#k{us=[],ns=[],a=A},func=Fname,arity=Arity, - vars=Vs ++ Fvs,body=B1}, - {#k_bif{anno=#k{us=Free,ns=lit_list_vars(Rs),a=A}, - op=#k_internal{name=make_fun,arity=length(Free)+3}, - args=[#k_atom{val=Fname},#k_int{val=Arity}, - #k_int{val=Index},#k_int{val=Uniq}|Fvs], - ret=Rs}, -% {#k_call{anno=#k{us=Free,ns=lit_list_vars(Rs),a=A}, -% op=#k_internal{name=make_fun,arity=length(Free)+3}, -% args=[#k_atom{val=Fname},#k_int{val=Arity}, -% #k_int{val=Index},#k_int{val=Uniq}|Fvs], -% ret=Rs}, - Free,St3#kern{funs=[Fun|St3#kern.funs]}}; -uexpr(Lit, {break,Rs}, St) -> - %% Transform literals to puts here. - %%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,Lit]), - Used = lit_vars(Lit), - {#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)}, - arg=Lit,ret=Rs},Used,St}. - -%% get_free(Name, Arity, State) -> [Free]. -%% store_free(Name, Arity, [Free], State) -> State. - -get_free(F, A, St) -> - case orddict:find({F,A}, St#kern.free) of - {ok,Val} -> Val; - error -> [] - end. - -store_free(F, A, Free, St) -> - St#kern{free=orddict:store({F,A}, Free, St#kern.free)}. - -break_rets({break,Rs}) -> Rs; -break_rets(return) -> []. - -%% bif_returns(Op, [Ret], State) -> {[Ret],State}. - -bif_returns(#k_remote{mod=M,name=N,arity=Ar}, Rs, St0) -> - %%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,{M,N,Ar,Rs}]), - {Ns,St1} = new_vars(bif_vals(M, N, Ar) - length(Rs), St0), - {Rs ++ Ns,St1}; -bif_returns(#k_internal{name=N,arity=Ar}, Rs, St0) -> - %%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,{N,Ar,Rs}]), - {Ns,St1} = new_vars(bif_vals(N, Ar) - length(Rs), St0), - {Rs ++ Ns,St1}. - -%% umatch(Match, Break, State) -> {Match,[UsedVar],State}. -%% Tag a match expression with its used variables. - -umatch(#k_alt{anno=A,first=F0,then=T0}, Br, St0) -> - {F1,Fu,St1} = umatch(F0, Br, St0), - {T1,Tu,St2} = umatch(T0, Br, St1), - Used = union(Fu, Tu), - {#k_alt{anno=#k{us=Used,ns=[],a=A},first=F1,then=T1}, - Used,St2}; -umatch(#k_select{anno=A,var=V,types=Ts0}, Br, St0) -> - {Ts1,Tus,St1} = umatch_list(Ts0, Br, St0), - Used = add_element(V#k_var.name, Tus), - {#k_select{anno=#k{us=Used,ns=[],a=A},var=V,types=Ts1},Used,St1}; -umatch(#k_type_clause{anno=A,type=T,values=Vs0}, Br, St0) -> - {Vs1,Vus,St1} = umatch_list(Vs0, Br, St0), - {#k_type_clause{anno=#k{us=Vus,ns=[],a=A},type=T,values=Vs1},Vus,St1}; -umatch(#k_val_clause{anno=A,val=P,body=B0}, Br, St0) -> - {U0,Ps} = pat_vars(P), - {B1,Bu,St1} = umatch(B0, Br, St0), - Used = union(U0, subtract(Bu, Ps)), - {#k_val_clause{anno=#k{us=Used,ns=[],a=A},val=P,body=B1}, - Used,St1}; -umatch(#k_guard{anno=A,clauses=Gs0}, Br, St0) -> - {Gs1,Gus,St1} = umatch_list(Gs0, Br, St0), - {#k_guard{anno=#k{us=Gus,ns=[],a=A},clauses=Gs1},Gus,St1}; -umatch(#k_guard_clause{anno=A,guard=G0,body=B0}, Br, St0) -> - %%ok = io:fwrite("~w: ~p~n", [?LINE,G0]), - {G1,Gu,St1} = uguard(G0, St0), - %%ok = io:fwrite("~w: ~p~n", [?LINE,G1]), - {B1,Bu,St2} = umatch(B0, Br, St1), - Used = union(Gu, Bu), - {#k_guard_clause{anno=#k{us=Used,ns=[],a=A},guard=G1,body=B1},Used,St2}; -umatch(B0, Br, St0) -> ubody(B0, Br, St0). - -umatch_list(Ms0, Br, St) -> - foldr(fun (M0, {Ms1,Us,Sta}) -> - {M1,Mu,Stb} = umatch(M0, Br, Sta), - {[M1|Ms1],union(Mu, Us),Stb} - end, {[],[],St}, Ms0). - -%% op_vars(Op) -> [VarName]. - -op_vars(#k_local{}) -> []; -op_vars(#k_remote{mod=Mod,name=Name}) -> - ordsets:from_list([V || #k_var{name=V} <- [Mod,Name]]); -op_vars(#k_internal{}) -> []; -op_vars(Atomic) -> lit_vars(Atomic). - -%% lit_vars(Literal) -> [VarName]. -%% Return the variables in a literal. - -lit_vars(#k_var{name=N}) -> [N]; -lit_vars(#k_int{}) -> []; -lit_vars(#k_float{}) -> []; -lit_vars(#k_atom{}) -> []; -%%lit_vars(#k_char{}) -> []; -lit_vars(#k_string{}) -> []; -lit_vars(#k_nil{}) -> []; -lit_vars(#k_cons{hd=H,tl=T}) -> - union(lit_vars(H), lit_vars(T)); -lit_vars(#k_binary{segs=V}) -> lit_vars(V); -lit_vars(#k_bin_end{}) -> []; -lit_vars(#k_bin_seg{size=Size,seg=S,next=N}) -> - union(lit_vars(Size), union(lit_vars(S), lit_vars(N))); -lit_vars(#k_tuple{es=Es}) -> - lit_list_vars(Es). - -lit_list_vars(Ps) -> - foldl(fun (P, Vs) -> union(lit_vars(P), Vs) end, [], Ps). - -%% pat_vars(Pattern) -> {[UsedVarName],[NewVarName]}. -%% Return variables in a pattern. All variables are new variables -%% except those in the size field of binary segments. - -pat_vars(#k_var{name=N}) -> {[],[N]}; -%%pat_vars(#k_char{}) -> {[],[]}; -pat_vars(#k_int{}) -> {[],[]}; -pat_vars(#k_float{}) -> {[],[]}; -pat_vars(#k_atom{}) -> {[],[]}; -pat_vars(#k_string{}) -> {[],[]}; -pat_vars(#k_nil{}) -> {[],[]}; -pat_vars(#k_cons{hd=H,tl=T}) -> - pat_list_vars([H,T]); -pat_vars(#k_binary{segs=V}) -> - pat_vars(V); -pat_vars(#k_bin_seg{size=Size,seg=S,next=N}) -> - {U1,New} = pat_list_vars([S,N]), - {[],U2} = pat_vars(Size), - {union(U1, U2),New}; -pat_vars(#k_bin_end{}) -> {[],[]}; -pat_vars(#k_tuple{es=Es}) -> - pat_list_vars(Es). - -pat_list_vars(Ps) -> - foldl(fun (P, {Used0,New0}) -> - {Used,New} = pat_vars(P), - {union(Used0, Used),union(New0, New)} end, - {[],[]}, Ps). - -%% aligned(Bits, Size, Unit, Flags) -> {Size,Flags} -%% Add 'aligned' to the flags if the current field is aligned. -%% Number of bits correct modulo 8. - -aligned(B, S, U, Fs) when B rem 8 =:= 0 -> - {incr_bits(B, S, U),[aligned|Fs]}; -aligned(B, S, U, Fs) -> - {incr_bits(B, S, U),Fs}. - -incr_bits(B, #k_int{val=S}, U) when integer(B) -> B + S*U; -incr_bits(_, #k_atom{val=all}, _) -> 0; %Always aligned -incr_bits(B, _, 8) -> B; -incr_bits(_, _, _) -> unknown. - -make_list(Es) -> - foldr(fun (E, Acc) -> #c_cons{hd=E,tl=Acc} end, #c_nil{}, Es). - -%% List of integers in interval [N,M]. Empty list if N > M. - -integers(N, M) when N =< M -> - [N|integers(N + 1, M)]; -integers(_, _) -> []. - -%%% -%%% Handling of warnings. -%%% - -format_error({nomatch_shadow,Line}) -> - M = io_lib:format("this clause cannot match because a previous clause at line ~p " - "always matches", [Line]), - lists:flatten(M); -format_error(nomatch_shadow) -> - "this clause cannot match because a previous clause always matches". - -add_warning(none, Term, #kern{ws=Ws}=St) -> - St#kern{ws=[{?MODULE,Term}|Ws]}; -add_warning(Line, Term, #kern{ws=Ws}=St) when Line >= 0 -> - St#kern{ws=[{Line,?MODULE,Term}|Ws]}; -add_warning(_, _, St) -> St. - diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_kernel.hrl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_kernel.hrl deleted file mode 100644 index 822a9e34e1..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_kernel.hrl +++ /dev/null @@ -1,77 +0,0 @@ -%% ``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 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. -%% -%% 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: v3_kernel.hrl,v 1.1 2008/12/17 09:53:43 mikpe Exp $ -%% - -%% Purpose : Kernel Erlang as records. - -%% It would be nice to incorporate some generic functions as well but -%% this could make including this file difficult. -%% N.B. the annotation field is ALWAYS the first field! - -%% Kernel annotation record. --record(k, {us, %Used variables - ns, %New variables - a}). %Core annotation - -%% Literals -%% NO CHARACTERS YET. -%%-record(k_char, {anno=[],val}). --record(k_int, {anno=[],val}). --record(k_float, {anno=[],val}). --record(k_atom, {anno=[],val}). --record(k_string, {anno=[],val}). --record(k_nil, {anno=[]}). - --record(k_tuple, {anno=[],es}). --record(k_cons, {anno=[],hd,tl}). --record(k_binary, {anno=[],segs}). --record(k_bin_seg, {anno=[],size,unit,type,flags,seg,next}). --record(k_bin_end, {anno=[]}). --record(k_var, {anno=[],name}). - --record(k_local, {anno=[],name,arity}). --record(k_remote, {anno=[],mod,name,arity}). --record(k_internal, {anno=[],name,arity}). - --record(k_mdef, {anno=[],name,exports,attributes,body}). --record(k_fdef, {anno=[],func,arity,vars,body}). - --record(k_seq, {anno=[],arg,body}). --record(k_put, {anno=[],arg,ret=[]}). --record(k_bif, {anno=[],op,args,ret=[]}). --record(k_test, {anno=[],op,args}). --record(k_call, {anno=[],op,args,ret=[]}). --record(k_enter, {anno=[],op,args}). --record(k_receive, {anno=[],var,body,timeout,action,ret=[]}). --record(k_receive_accept, {anno=[]}). --record(k_receive_next, {anno=[]}). --record(k_try, {anno=[],arg,vars,body,evars,handler,ret=[]}). --record(k_catch, {anno=[],body,ret=[]}). - --record(k_match, {anno=[],vars,body,ret=[]}). --record(k_alt, {anno=[],first,then}). --record(k_select, {anno=[],var,types}). --record(k_type_clause, {anno=[],type,values}). --record(k_val_clause, {anno=[],val,body}). --record(k_guard, {anno=[],clauses}). --record(k_guard_clause, {anno=[],guard,body}). - --record(k_break, {anno=[],args=[]}). --record(k_return, {anno=[],args=[]}). - -%%k_get_anno(Thing) -> element(2, Thing). -%%k_set_anno(Thing, Anno) -> setelement(2, Thing, Anno). diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_kernel_pp.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_kernel_pp.erl deleted file mode 100644 index 92ff173834..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_kernel_pp.erl +++ /dev/null @@ -1,444 +0,0 @@ -%% ``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 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. -%% -%% 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: v3_kernel_pp.erl,v 1.1 2008/12/17 09:53:43 mikpe Exp $ -%% -%% Purpose : Kernel Erlang (naive) prettyprinter - --module(v3_kernel_pp). - --include("v3_kernel.hrl"). - --export([format/1]). - -%% These are "internal" structures in sys_kernel which are here for -%% debugging purposes. --record(iset, {anno=[],vars,arg,body}). --record(ifun, {anno=[],vars,body}). - -%% ====================================================================== %% -%% format(Node) -> Text -%% Node = coreErlang() -%% Text = string() | [Text] -%% -%% Prettyprint-formats (naively) an abstract Core Erlang syntax -%% tree. - --record(ctxt, {indent = 0, - item_indent = 2, - body_indent = 2, - tab_width = 8}). - -canno(Cthing) -> element(2, Cthing). - -format(Node) -> format(Node, #ctxt{}). - -format(Node, Ctxt) -> - case canno(Node) of - [] -> - format_1(Node, Ctxt); - List -> - format_anno(List, Ctxt, fun (Ctxt1) -> format_1(Node, Ctxt1) end) - end. - -format_anno(Anno, Ctxt, ObjFun) -> - Ctxt1 = ctxt_bump_indent(Ctxt, 2), - ["( ", - ObjFun(Ctxt1), - nl_indent(Ctxt1), - "-| ",io_lib:write(Anno), - " )"]. - -%% format_1(Kexpr, Context) -> string(). - -format_1(#k_atom{val=A}, _Ctxt) -> core_atom(A); -%%format_1(#k_char{val=C}, _Ctxt) -> io_lib:write_char(C); -format_1(#k_float{val=F}, _Ctxt) -> float_to_list(F); -format_1(#k_int{val=I}, _Ctxt) -> integer_to_list(I); -format_1(#k_nil{}, _Ctxt) -> "[]"; -format_1(#k_string{val=S}, _Ctxt) -> io_lib:write_string(S); -format_1(#k_var{name=V}, _Ctxt) -> - if atom(V) -> - case atom_to_list(V) of - [$_|Cs] -> "_X" ++ Cs; - [C|Cs] when C >= $A, C =< $Z -> [C|Cs]; - Cs -> [$_|Cs] - end; - integer(V) -> [$_|integer_to_list(V)] - end; -format_1(#k_cons{hd=H,tl=T}, Ctxt) -> - Txt = ["["|format(H, ctxt_bump_indent(Ctxt, 1))], - [Txt|format_list_tail(T, ctxt_bump_indent(Ctxt, width(Txt, Ctxt)))]; -format_1(#k_tuple{es=Es}, Ctxt) -> - [${, - format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), - $} - ]; -format_1(#k_binary{segs=S}, Ctxt) -> - ["#<",format(S, ctxt_bump_indent(Ctxt, 2)),">#"]; -format_1(#k_bin_seg{}=S, Ctxt) -> - [format_bin_seg_1(S, Ctxt), - format_bin_seg(S#k_bin_seg.next, ctxt_bump_indent(Ctxt, 2))]; -format_1(#k_bin_end{}, _Ctxt) -> "#<>#"; -format_1(#k_local{name=N,arity=A}, Ctxt) -> - "local " ++ format_fa_pair({N,A}, Ctxt); -format_1(#k_remote{mod=M,name=N,arity=A}, _Ctxt) -> - %% This is for our internal translator. - io_lib:format("remote ~s:~s/~w", [format(M),format(N),A]); -format_1(#k_internal{name=N,arity=A}, Ctxt) -> - "internal " ++ format_fa_pair({N,A}, Ctxt); -format_1(#k_seq{arg=A,body=B}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, 2), - ["do", - nl_indent(Ctxt1), - format(A, Ctxt1), - nl_indent(Ctxt), - "then", - nl_indent(Ctxt) - | format(B, Ctxt) - ]; -format_1(#k_match{vars=Vs,body=Bs,ret=Rs}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.item_indent), - ["match ", - format_hseq(Vs, ",", ctxt_bump_indent(Ctxt, 6), fun format/2), - nl_indent(Ctxt1), - format(Bs, Ctxt1), - nl_indent(Ctxt), - "end", - format_ret(Rs, Ctxt1) - ]; -format_1(#k_alt{first=O,then=T}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.item_indent), - ["alt", - nl_indent(Ctxt1), - format(O, Ctxt1), - nl_indent(Ctxt1), - format(T, Ctxt1)]; -format_1(#k_select{var=V,types=Cs}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, 2), - ["select ", - format(V, Ctxt), - nl_indent(Ctxt1), - format_vseq(Cs, "", "", Ctxt1, fun format/2) - ]; -format_1(#k_type_clause{type=T,values=Cs}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent), - ["type ", - io_lib:write(T), - nl_indent(Ctxt1), - format_vseq(Cs, "", "", Ctxt1, fun format/2) - ]; -format_1(#k_val_clause{val=Val,body=B}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent), - [format(Val, Ctxt), - " ->", - nl_indent(Ctxt1) - | format(B, Ctxt1) - ]; -format_1(#k_guard{clauses=Gs}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, 5), - ["when ", - nl_indent(Ctxt1), - format_vseq(Gs, "", "", Ctxt1, fun format/2)]; -format_1(#k_guard_clause{guard=G,body=B}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent), - [format(G, Ctxt), - nl_indent(Ctxt), - "->", - nl_indent(Ctxt1) - | format(B, Ctxt1) - ]; -format_1(#k_call{op=Op,args=As,ret=Rs}, Ctxt) -> - Txt = ["call (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)], - Ctxt1 = ctxt_bump_indent(Ctxt, 2), - [Txt,format_args(As, Ctxt1), - format_ret(Rs, Ctxt1) - ]; -format_1(#k_enter{op=Op,args=As}, Ctxt) -> - Txt = ["enter (",format(Op, ctxt_bump_indent(Ctxt, 7)),$)], - Ctxt1 = ctxt_bump_indent(Ctxt, 2), - [Txt,format_args(As, Ctxt1)]; -format_1(#k_bif{op=Op,args=As,ret=Rs}, Ctxt) -> - Txt = ["bif (",format(Op, ctxt_bump_indent(Ctxt, 5)),$)], - Ctxt1 = ctxt_bump_indent(Ctxt, 2), - [Txt,format_args(As, Ctxt1), - format_ret(Rs, Ctxt1) - ]; -format_1(#k_test{op=Op,args=As}, Ctxt) -> - Txt = ["test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)], - Ctxt1 = ctxt_bump_indent(Ctxt, 2), - [Txt,format_args(As, Ctxt1)]; -format_1(#k_put{arg=A,ret=Rs}, Ctxt) -> - [format(A, Ctxt), - format_ret(Rs, ctxt_bump_indent(Ctxt, 1)) - ]; -format_1(#k_try{arg=A,vars=Vs,body=B,evars=Evs,handler=H,ret=Rs}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent), - ["try", - nl_indent(Ctxt1), - format(A, Ctxt1), - nl_indent(Ctxt), - "of ", - format_hseq(Vs, ", ", ctxt_bump_indent(Ctxt, 3), fun format/2), - nl_indent(Ctxt1), - format(B, Ctxt1), - nl_indent(Ctxt), - "catch ", - format_hseq(Evs, ", ", ctxt_bump_indent(Ctxt, 6), fun format/2), - nl_indent(Ctxt1), - format(H, Ctxt1), - nl_indent(Ctxt), - "end", - format_ret(Rs, Ctxt1) - ]; -format_1(#k_catch{body=B,ret=Rs}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent), - ["catch", - nl_indent(Ctxt1), - format(B, Ctxt1), - nl_indent(Ctxt), - "end", - format_ret(Rs, Ctxt1) - ]; -format_1(#k_receive{var=V,body=B,timeout=T,action=A,ret=Rs}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.item_indent), - ["receive ", - format(V, Ctxt), - nl_indent(Ctxt1), - format(B, Ctxt1), - nl_indent(Ctxt), - "after ", - format(T, ctxt_bump_indent(Ctxt, 6)), - " ->", - nl_indent(Ctxt1), - format(A, Ctxt1), - nl_indent(Ctxt), - "end", - format_ret(Rs, Ctxt1) - ]; -format_1(#k_receive_accept{}, _Ctxt) -> "receive_accept"; -format_1(#k_receive_next{}, _Ctxt) -> "receive_next"; -format_1(#k_break{args=As}, Ctxt) -> - ["<", - format_hseq(As, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), - ">" - ]; -format_1(#k_return{args=As}, Ctxt) -> - ["<<", - format_hseq(As, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), - ">>" - ]; -format_1(#k_fdef{func=F,arity=A,vars=Vs,body=B}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent), - ["fdef ", - format_fa_pair({F,A}, ctxt_bump_indent(Ctxt, 5)), - format_args(Vs, ctxt_bump_indent(Ctxt, 14)), - " =", - nl_indent(Ctxt1), - format(B, Ctxt1) - ]; -format_1(#k_mdef{name=N,exports=Es,attributes=As,body=B}, Ctxt) -> - ["module ", - format(#k_atom{val=N}, ctxt_bump_indent(Ctxt, 7)), - nl_indent(Ctxt), - "export [", - format_vseq(Es, - "", ",", - ctxt_bump_indent(Ctxt, 8), - fun format_fa_pair/2), - "]", - nl_indent(Ctxt), - "attributes [", - format_vseq(As, - "", ",", - ctxt_bump_indent(Ctxt, 12), - fun format_attribute/2), - "]", - nl_indent(Ctxt), - format_vseq(B, - "", "", - Ctxt, - fun format/2), - nl_indent(Ctxt) - | "end" - ]; -%% Internal sys_kernel structures. -format_1(#iset{vars=Vs,arg=A,body=B}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent), - ["set <", - format_hseq(Vs, ", ", ctxt_bump_indent(Ctxt, 5), fun format/2), - "> =", - nl_indent(Ctxt1), - format(A, Ctxt1), - nl_indent(Ctxt), - "in " - | format(B, ctxt_bump_indent(Ctxt, 2)) - ]; -format_1(#ifun{vars=Vs,body=B}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent), - ["fun ", - format_args(Vs, ctxt_bump_indent(Ctxt, 4)), - " ->", - nl_indent(Ctxt1) - | format(B, Ctxt1) - ]; -format_1(Type, _Ctxt) -> - ["** Unsupported type: ", - io_lib:write(Type) - | " **" - ]. - -%% format_ret([RetVar], Context) -> Txt. -%% Format the return vars of kexpr. - -format_ret(Rs, Ctxt) -> - [" >> ", - "<", - format_hseq(Rs, ",", ctxt_bump_indent(Ctxt, 5), fun format/2), - ">"]. - -%% format_args([Arg], Context) -> Txt. -%% Format arguments. - -format_args(As, Ctxt) -> - [$(,format_hseq(As, ", ", ctxt_bump_indent(Ctxt, 1), fun format/2),$)]. - -%% format_hseq([Thing], Separator, Context, Fun) -> Txt. -%% Format a sequence horizontally. - -format_hseq([H], _Sep, Ctxt, Fun) -> - Fun(H, Ctxt); -format_hseq([H|T], Sep, Ctxt, Fun) -> - Txt = [Fun(H, Ctxt)|Sep], - Ctxt1 = ctxt_bump_indent(Ctxt, width(Txt, Ctxt)), - [Txt|format_hseq(T, Sep, Ctxt1, Fun)]; -format_hseq([], _, _, _) -> "". - -%% format_vseq([Thing], LinePrefix, LineSuffix, Context, Fun) -> Txt. -%% Format a sequence vertically. - -format_vseq([H], _Pre, _Suf, Ctxt, Fun) -> - Fun(H, Ctxt); -format_vseq([H|T], Pre, Suf, Ctxt, Fun) -> - [Fun(H, Ctxt),Suf,nl_indent(Ctxt),Pre| - format_vseq(T, Pre, Suf, Ctxt, Fun)]; -format_vseq([], _, _, _, _) -> "". - -format_fa_pair({F,A}, _Ctxt) -> [core_atom(F),$/,integer_to_list(A)]. - -%% format_attribute({Name,Val}, Context) -> Txt. - -format_attribute({Name,Val}, Ctxt) when list(Val) -> - Txt = format(#k_atom{val=Name}, Ctxt), - Ctxt1 = ctxt_bump_indent(Ctxt, width(Txt,Ctxt)+4), - [Txt," = ", - $[,format_vseq(Val, "", ",", Ctxt1, - fun (A, _C) -> io_lib:write(A) end),$] - ]; -format_attribute({Name,Val}, Ctxt) -> - Txt = format(#k_atom{val=Name}, Ctxt), - [Txt," = ",io_lib:write(Val)]. - -format_list_tail(#k_nil{anno=[]}, _Ctxt) -> "]"; -format_list_tail(#k_cons{anno=[],hd=H,tl=T}, Ctxt) -> - Txt = [$,|format(H, Ctxt)], - Ctxt1 = ctxt_bump_indent(Ctxt, width(Txt, Ctxt)), - [Txt|format_list_tail(T, Ctxt1)]; -format_list_tail(Tail, Ctxt) -> - ["|",format(Tail, ctxt_bump_indent(Ctxt, 1)), "]"]. - -format_bin_seg(#k_bin_end{anno=[]}, _Ctxt) -> ""; -format_bin_seg(#k_bin_seg{anno=[],next=N}=Seg, Ctxt) -> - Txt = [$,|format_bin_seg_1(Seg, Ctxt)], - [Txt|format_bin_seg(N, ctxt_bump_indent(Ctxt, width(Txt, Ctxt)))]; -format_bin_seg(Seg, Ctxt) -> - ["|",format(Seg, ctxt_bump_indent(Ctxt, 2))]. - -format_bin_seg_1(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg}, Ctxt) -> - [format(Seg, Ctxt), - ":",format(S, Ctxt),"*",io_lib:write(U), - ":",io_lib:write(T), - lists:map(fun (F) -> [$-,io_lib:write(F)] end, Fs) - ]. - -% format_bin_elements(#k_binary_cons{hd=H,tl=T,size=S,info=I}, Ctxt) -> -% A = canno(T), -% Fe = fun (Eh, Es, Ei, Ct) -> -% [format(Eh, Ct),":",format(Es, Ct),"/",io_lib:write(Ei)] -% end, -% case T of -% #k_zero_binary{} when A == [] -> -% Fe(H, S, I, Ctxt); -% #k_binary_cons{} when A == [] -> -% Txt = [Fe(H, S, I, Ctxt)|","], -% Ctxt1 = ctxt_bump_indent(Ctxt, width(Txt, Ctxt)), -% [Txt|format_bin_elements(T, Ctxt1)]; -% _ -> -% Txt = [Fe(H, S, I, Ctxt)|"|"], -% [Txt|format(T, ctxt_bump_indent(Ctxt, width(Txt, Ctxt)))] -% end. - -indent(Ctxt) -> indent(Ctxt#ctxt.indent, Ctxt). - -indent(N, _Ctxt) when N =< 0 -> ""; -indent(N, Ctxt) -> - T = Ctxt#ctxt.tab_width, - string:chars($\t, N div T, string:chars($\s, N rem T)). - -nl_indent(Ctxt) -> [$\n|indent(Ctxt)]. - - -unindent(T, Ctxt) -> - unindent(T, Ctxt#ctxt.indent, Ctxt, []). - -unindent(T, N, _Ctxt, C) when N =< 0 -> - [T|C]; -unindent([$\s|T], N, Ctxt, C) -> - unindent(T, N - 1, Ctxt, C); -unindent([$\t|T], N, Ctxt, C) -> - Tab = Ctxt#ctxt.tab_width, - if N >= Tab -> - unindent(T, N - Tab, Ctxt, C); - true -> - unindent([string:chars($\s, Tab - N)|T], 0, Ctxt, C) - end; -unindent([L|T], N, Ctxt, C) when list(L) -> - unindent(L, N, Ctxt, [T|C]); -unindent([H|T], _N, _Ctxt, C) -> - [H|[T|C]]; -unindent([], N, Ctxt, [H|T]) -> - unindent(H, N, Ctxt, T); -unindent([], _, _, []) -> []. - - -width(Txt, Ctxt) -> - width(Txt, 0, Ctxt, []). - -width([$\t|T], A, Ctxt, C) -> - width(T, A + Ctxt#ctxt.tab_width, Ctxt, C); -width([$\n|T], _A, Ctxt, C) -> - width(unindent([T|C], Ctxt), Ctxt); -width([H|T], A, Ctxt, C) when list(H) -> - width(H, A, Ctxt, [T|C]); -width([_|T], A, Ctxt, C) -> - width(T, A + 1, Ctxt, C); -width([], A, Ctxt, [H|T]) -> - width(H, A, Ctxt, T); -width([], A, _, []) -> A. - -ctxt_bump_indent(Ctxt, Dx) -> - Ctxt#ctxt{indent=Ctxt#ctxt.indent + Dx}. - -core_atom(A) -> io_lib:write_string(atom_to_list(A), $'). diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_life.erl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_life.erl deleted file mode 100644 index ff210d83f5..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_life.erl +++ /dev/null @@ -1,448 +0,0 @@ -%% ``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 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. -%% -%% 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: v3_life.erl,v 1.2 2010/03/04 13:54:20 maria Exp $ -%% -%% Purpose : Convert annotated kernel expressions to annotated beam format. - -%% This module creates beam format annotated with variable lifetime -%% information. Each thing is given an index and for each variable we -%% store the first and last index for its occurrence. The variable -%% database, VDB, attached to each thing is only relevant internally -%% for that thing. -%% -%% For nested things like matches the numbering continues locally and -%% the VDB for that thing refers to the variable usage within that -%% thing. Variables which live through a such a thing are internally -%% given a very large last index. Internally the indexes continue -%% after the index of that thing. This creates no problems as the -%% internal variable info never escapes and externally we only see -%% variable which are alive both before or after. -%% -%% This means that variables never "escape" from a thing and the only -%% way to get values from a thing is to "return" them, with 'break' or -%% 'return'. Externally these values become the return values of the -%% thing. This is no real limitation as most nested things have -%% multiple threads so working out a common best variable usage is -%% difficult. - --module(v3_life). - --export([module/2]). - --export([vdb_find/2]). - --import(lists, [map/2,foldl/3]). --import(ordsets, [add_element/2,intersection/2,union/2,union/1]). - --include("v3_kernel.hrl"). --include("v3_life.hrl"). - -%% These are not defined in v3_kernel.hrl. -get_kanno(Kthing) -> element(2, Kthing). -%%set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno). - -module(#k_mdef{name=M,exports=Es,attributes=As,body=Fs0}, Opts) -> - put(?MODULE, Opts), - Fs1 = map(fun function/1, Fs0), - erase(?MODULE), - {ok,{M,Es,As,Fs1}}. - -%% function(Kfunc) -> Func. - -function(#k_fdef{func=F,arity=Ar,vars=Vs,body=Kb}) -> - %%ok = io:fwrite("life ~w: ~p~n", [?LINE,{F,Ar}]), - As = var_list(Vs), - Vdb0 = foldl(fun ({var,N}, Vdb) -> new_var(N, 0, Vdb) end, [], As), - %% Force a top-level match! - B0 = case Kb of - #k_match{} -> Kb; - _ -> - Ka = get_kanno(Kb), - #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a}, - vars=Vs,body=Kb,ret=[]} - end, - {B1,_,Vdb1} = body(B0, 1, Vdb0), - {function,F,Ar,As,B1,Vdb1}. - -%% body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}. -%% Handle a body, need special cases for transforming match_fails. -%% We KNOW that they only occur last in a body. - -body(#k_seq{arg=#k_put{anno=Pa,arg=Arg,ret=[R]}, - body=#k_enter{anno=Ea,op=#k_internal{name=match_fail,arity=1}, - args=[R]}}, - I, Vdb0) -> - Vdb1 = use_vars(Pa#k.us, I, Vdb0), %All used here - {[match_fail(Arg, I, Pa#k.a ++ Ea#k.a)],I,Vdb1}; -body(#k_enter{anno=Ea,op=#k_internal{name=match_fail,arity=1},args=[Arg]}, - I, Vdb0) -> - Vdb1 = use_vars(Ea#k.us, I, Vdb0), - {[match_fail(Arg, I, Ea#k.a)],I,Vdb1}; -body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) -> - %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), - A = get_kanno(Ke), - Vdb1 = use_vars(A#k.us, I, new_vars(A#k.ns, I, Vdb0)), - {Es,MaxI,Vdb2} = body(Kb, I+1, Vdb1), - E = expr(Ke, I, Vdb2), - {[E|Es],MaxI,Vdb2}; -body(Ke, I, Vdb0) -> - %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), - A = get_kanno(Ke), - Vdb1 = use_vars(A#k.us, I, new_vars(A#k.ns, I, Vdb0)), - E = expr(Ke, I, Vdb1), - {[E],I,Vdb1}. - -%% guard(Kguard, I, Vdb) -> Guard. - -guard(#k_try{anno=A,arg=Ts,vars=[#k_var{name=X}],body=#k_var{name=X}, - handler=#k_atom{val=false},ret=Rs}, I, Vdb) -> - %% Lock variables that are alive before try and used afterwards. - %% Don't lock variables that are only used inside the try expression. - Pdb0 = vdb_sub(I, I+1, Vdb), - {T,MaxI,Pdb1} = guard_body(Ts, I+1, Pdb0), - Pdb2 = use_vars(A#k.ns, MaxI+1, Pdb1), %Save "return" values - #l{ke={protected,T,var_list(Rs)},i=I,a=A#k.a,vdb=Pdb2}; -guard(#k_seq{}=G, I, Vdb0) -> - {Es,_,Vdb1} = guard_body(G, I, Vdb0), - #l{ke={block,Es},i=I,vdb=Vdb1,a=[]}; -guard(G, I, Vdb) -> guard_expr(G, I, Vdb). - -%% guard_body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}. - -guard_body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) -> - A = get_kanno(Ke), - Vdb1 = use_vars(A#k.us, I, new_vars(A#k.ns, I, Vdb0)), - {Es,MaxI,Vdb2} = guard_body(Kb, I+1, Vdb1), - E = guard_expr(Ke, I, Vdb2), - {[E|Es],MaxI,Vdb2}; -guard_body(Ke, I, Vdb0) -> - A = get_kanno(Ke), - Vdb1 = use_vars(A#k.us, I, new_vars(A#k.ns, I, Vdb0)), - E = guard_expr(Ke, I, Vdb1), - {[E],I,Vdb1}. - -%% guard_expr(Call, I, Vdb) -> Expr - -guard_expr(#k_test{anno=A,op=Op,args=As}, I, _Vdb) -> - #l{ke={test,test_op(Op),atomic_list(As)},i=I,a=A#k.a}; -guard_expr(#k_bif{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) -> - #l{ke={bif,bif_op(Op),atomic_list(As),var_list(Rs)},i=I,a=A#k.a}; -guard_expr(#k_put{anno=A,arg=Arg,ret=Rs}, I, _Vdb) -> - #l{ke={set,var_list(Rs),literal(Arg)},i=I,a=A#k.a}; -guard_expr(#k_match{anno=A,body=Kb,ret=Rs}, I, Vdb) -> - %% Experimental support for andalso/orelse in guards. - %% Work out imported variables which need to be locked. - Mdb = vdb_sub(I, I+1, Vdb), - M = match(Kb, A#k.us, I+1, Mdb), - #l{ke={match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a}; -guard_expr(G, I, Vdb) -> guard(G, I, Vdb). - -%% expr(Kexpr, I, Vdb) -> Expr. - -expr(#k_call{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) -> - #l{ke={call,call_op(Op),atomic_list(As),var_list(Rs)},i=I,a=A#k.a}; -expr(#k_enter{anno=A,op=Op,args=As}, I, _Vdb) -> - #l{ke={enter,call_op(Op),atomic_list(As)},i=I,a=A#k.a}; -expr(#k_bif{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) -> - Bif = k_bif(A, Op, As, Rs), - #l{ke=Bif,i=I,a=A#k.a}; -expr(#k_match{anno=A,body=Kb,ret=Rs}, I, Vdb) -> - %% Work out imported variables which need to be locked. - Mdb = vdb_sub(I, I+1, Vdb), - M = match(Kb, A#k.us, I+1, Mdb), - #l{ke={match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a}; -expr(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh,ret=Rs}, I, Vdb) -> - %% Lock variables that are alive before the catch and used afterwards. - %% Don't lock variables that are only used inside the try. - Tdb0 = vdb_sub(I, I+1, Vdb), - %% This is the tricky bit. Lock variables in Arg that are used in - %% the body and handler. Add try tag 'variable'. - Ab = get_kanno(Kb), - Ah = get_kanno(Kh), - Tdb1 = use_vars(Ab#k.us, I+3, use_vars(Ah#k.us, I+3, Tdb0)), - Tdb2 = vdb_sub(I, I+2, Tdb1), - Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names - {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, 1000000, Tdb2)), - {Bes,_,Bdb} = body(Kb, I+4, new_vars(map(Vnames, Vs), I+3, Tdb2)), - {Hes,_,Hdb} = body(Kh, I+4, new_vars(map(Vnames, Evs), I+3, Tdb2)), - #l{ke={'try',#l{ke={block,Aes},i=I+1,vdb=Adb,a=[]}, - var_list(Vs),#l{ke={block,Bes},i=I+3,vdb=Bdb,a=[]}, - var_list(Evs),#l{ke={block,Hes},i=I+3,vdb=Hdb,a=[]}, - var_list(Rs)}, - i=I,vdb=Tdb1,a=A#k.a}; -expr(#k_catch{anno=A,body=Kb,ret=[R]}, I, Vdb) -> - %% Lock variables that are alive before the catch and used afterwards. - %% Don't lock variables that are only used inside the catch. - %% Add catch tag 'variable'. - Cdb0 = vdb_sub(I, I+1, Vdb), - {Es,_,Cdb1} = body(Kb, I+1, add_var({catch_tag,I}, I, 1000000, Cdb0)), - #l{ke={'catch',Es,variable(R)},i=I,vdb=Cdb1,a=A#k.a}; -expr(#k_receive{anno=A,var=V,body=Kb,timeout=T,action=Ka,ret=Rs}, I, Vdb) -> - %% Work out imported variables which need to be locked. - Rdb = vdb_sub(I, I+1, Vdb), - M = match(Kb, add_element(V#k_var.name, A#k.us), I+1, - new_var(V#k_var.name, I, Rdb)), - {Tes,_,Adb} = body(Ka, I+1, Rdb), - #l{ke={receive_loop,atomic_lit(T),variable(V),M, - #l{ke=Tes,i=I+1,vdb=Adb,a=[]},var_list(Rs)}, - i=I,vdb=use_vars(A#k.us, I+1, Vdb),a=A#k.a}; -expr(#k_receive_accept{anno=A}, I, _Vdb) -> - #l{ke=receive_accept,i=I,a=A#k.a}; -expr(#k_receive_next{anno=A}, I, _Vdb) -> - #l{ke=receive_next,i=I,a=A#k.a}; -expr(#k_put{anno=A,arg=Arg,ret=Rs}, I, _Vdb) -> - #l{ke={set,var_list(Rs),literal(Arg)},i=I,a=A#k.a}; -expr(#k_break{anno=A,args=As}, I, _Vdb) -> - #l{ke={break,atomic_list(As)},i=I,a=A#k.a}; -expr(#k_return{anno=A,args=As}, I, _Vdb) -> - #l{ke={return,atomic_list(As)},i=I,a=A#k.a}. - -%% call_op(Op) -> Op. -%% bif_op(Op) -> Op. -%% test_op(Op) -> Op. -%% Do any necessary name translations here to munge into beam format. - -call_op(#k_local{name=N}) -> N; -call_op(#k_remote{mod=M,name=N}) -> {remote,atomic_lit(M),atomic_lit(N)}; -call_op(Other) -> variable(Other). - -bif_op(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=N}}) -> N; -bif_op(#k_internal{name=N}) -> N. - -test_op(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=N}}) -> N. - -%% k_bif(Anno, Op, [Arg], [Ret]) -> Expr. -%% Build bifs, do special handling of internal some calls. - -k_bif(_A, #k_internal{name=dsetelement,arity=3}, As, []) -> - {bif,dsetelement,atomic_list(As),[]}; -k_bif(_A, #k_internal{name=make_fun}, - [#k_atom{val=Fun},#k_int{val=Arity}, - #k_int{val=Index},#k_int{val=Uniq}|Free], - Rs) -> - {bif,{make_fun,Fun,Arity,Index,Uniq},var_list(Free),var_list(Rs)}; -k_bif(_A, Op, As, Rs) -> - %% The general case. - {bif,bif_op(Op),atomic_list(As),var_list(Rs)}. - -%% match(Kexpr, [LockVar], I, Vdb) -> Expr. -%% Convert match tree to old format. - -match(#k_alt{anno=A,first=Kf,then=Kt}, Ls, I, Vdb0) -> - Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), - F = match(Kf, Ls, I+1, Vdb1), - T = match(Kt, Ls, I+1, Vdb1), - #l{ke={alt,F,T},i=I,vdb=Vdb1,a=A#k.a}; -match(#k_select{anno=A,var=V,types=Kts}, Ls0, I, Vdb0) -> - Ls1 = add_element(V#k_var.name, Ls0), - Vdb1 = use_vars(union(A#k.us, Ls1), I, Vdb0), - Ts = map(fun (Tc) -> type_clause(Tc, Ls1, I+1, Vdb1) end, Kts), - #l{ke={select,literal(V),Ts},i=I,vdb=Vdb1,a=A#k.a}; -match(#k_guard{anno=A,clauses=Kcs}, Ls, I, Vdb0) -> - Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), - Cs = map(fun (G) -> guard_clause(G, Ls, I+1, Vdb1) end, Kcs), - #l{ke={guard,Cs},i=I,vdb=Vdb1,a=A#k.a}; -match(Other, Ls, I, Vdb0) -> - Vdb1 = use_vars(Ls, I, Vdb0), - {B,_,Vdb2} = body(Other, I+1, Vdb1), - #l{ke={block,B},i=I,vdb=Vdb2,a=[]}. - -type_clause(#k_type_clause{anno=A,type=T,values=Kvs}, Ls, I, Vdb0) -> - %%ok = io:format("life ~w: ~p~n", [?LINE,{T,Kvs}]), - Vdb1 = use_vars(union(A#k.us, Ls), I+1, Vdb0), - Vs = map(fun (Vc) -> val_clause(Vc, Ls, I+1, Vdb1) end, Kvs), - #l{ke={type_clause,type(T),Vs},i=I,vdb=Vdb1,a=A#k.a}. - -val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Vdb0) -> - {_Used,New} = match_pat_vars(V), - %% Not clear yet how Used should be used. - Bus = (get_kanno(Kb))#k.us, - %%ok = io:format("Ls0 = ~p, Used=~p\n New=~p, Bus=~p\n", [Ls0,Used,New,Bus]), - Ls1 = union(intersection(New, Bus), Ls0), %Lock for safety - Vdb1 = use_vars(union(A#k.us, Ls1), I+1, new_vars(New, I, Vdb0)), - B = match(Kb, Ls1, I+1, Vdb1), - #l{ke={val_clause,literal(V),B},i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}. - -guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Vdb0) -> - Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0), - Gdb = vdb_sub(I+1, I+2, Vdb1), - G = guard(Kg, I+1, Gdb), - B = match(Kb, Ls, I+2, Vdb1), - #l{ke={guard_clause,G,B}, - i=I,vdb=use_vars((get_kanno(Kg))#k.us, I+2, Vdb1), - a=A#k.a}. - -%% match_fail(FailValue, I, Anno) -> Expr. -%% Generate the correct match_fail instruction. N.B. there is no -%% generic case for when the fail value has been created elsewhere. - -match_fail(#k_tuple{es=[#k_atom{val=function_clause}|As]}, I, A) -> - #l{ke={match_fail,{function_clause,literal_list(As)}},i=I,a=A}; -match_fail(#k_tuple{es=[#k_atom{val=badmatch},Val]}, I, A) -> - #l{ke={match_fail,{badmatch,literal(Val)}},i=I,a=A}; -match_fail(#k_tuple{es=[#k_atom{val=case_clause},Val]}, I, A) -> - #l{ke={match_fail,{case_clause,literal(Val)}},i=I,a=A}; -match_fail(#k_atom{val=if_clause}, I, A) -> - #l{ke={match_fail,if_clause},i=I,a=A}; -match_fail(#k_tuple{es=[#k_atom{val=try_clause},Val]}, I, A) -> - #l{ke={match_fail,{try_clause,literal(Val)}},i=I,a=A}. - -%% type(Ktype) -> Type. - -type(k_int) -> integer; -type(k_char) -> integer; %Hhhmmm??? -type(k_float) -> float; -type(k_atom) -> atom; -type(k_nil) -> nil; -type(k_cons) -> cons; -type(k_tuple) -> tuple; -type(k_binary) -> binary; -type(k_bin_seg) -> bin_seg; -type(k_bin_end) -> bin_end. - -%% variable(Klit) -> Lit. -%% var_list([Klit]) -> [Lit]. - -variable(#k_var{name=N}) -> {var,N}. - -var_list(Ks) -> map(fun variable/1, Ks). - -%% atomic_lit(Klit) -> Lit. -%% atomic_list([Klit]) -> [Lit]. - -atomic_lit(#k_var{name=N}) -> {var,N}; -atomic_lit(#k_int{val=I}) -> {integer,I}; -atomic_lit(#k_float{val=F}) -> {float,F}; -atomic_lit(#k_atom{val=N}) -> {atom,N}; -%%atomic_lit(#k_char{val=C}) -> {char,C}; -%%atomic_lit(#k_string{val=S}) -> {string,S}; -atomic_lit(#k_nil{}) -> nil. - -atomic_list(Ks) -> map(fun atomic_lit/1, Ks). - -%% literal(Klit) -> Lit. -%% literal_list([Klit]) -> [Lit]. - -literal(#k_var{name=N}) -> {var,N}; -literal(#k_int{val=I}) -> {integer,I}; -literal(#k_float{val=F}) -> {float,F}; -literal(#k_atom{val=N}) -> {atom,N}; -%%literal(#k_char{val=C}) -> {char,C}; -literal(#k_string{val=S}) -> {string,S}; -literal(#k_nil{}) -> nil; -literal(#k_cons{hd=H,tl=T}) -> - {cons,[literal(H),literal(T)]}; -literal(#k_binary{segs=V}) -> - case proplists:get_bool(no_new_binaries, get(?MODULE)) of - true -> - {old_binary,literal(V)}; - false -> - {binary,literal(V)} - end; -literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}) -> - {bin_seg,literal(S),U,T,Fs,[literal(Seg),literal(N)]}; -literal(#k_bin_end{}) -> bin_end; -literal(#k_tuple{es=Es}) -> - {tuple,literal_list(Es)}. - -literal_list(Ks) -> map(fun literal/1, Ks). - -%% match_pat_vars(Pattern) -> {[UsedVarName],[NewVarName]}. - -match_pat_vars(#k_var{name=N}) -> {[],[N]}; -match_pat_vars(#k_int{}) -> {[],[]}; -match_pat_vars(#k_float{}) -> {[],[]}; -match_pat_vars(#k_atom{}) -> {[],[]}; -%%match_pat_vars(#k_char{}) -> {[],[]}; -match_pat_vars(#k_string{}) -> {[],[]}; -match_pat_vars(#k_nil{}) -> {[],[]}; -match_pat_vars(#k_cons{hd=H,tl=T}) -> - match_pat_list_vars([H,T]); -match_pat_vars(#k_binary{segs=V}) -> - match_pat_vars(V); -match_pat_vars(#k_bin_seg{size=S,seg=Seg,next=N}) -> - {U1,New1} = match_pat_vars(Seg), - {U2,New2} = match_pat_vars(N), - {[],U3} = match_pat_vars(S), - {union([U1,U2,U3]),union(New1, New2)}; -match_pat_vars(#k_bin_end{}) -> {[],[]}; -match_pat_vars(#k_tuple{es=Es}) -> - match_pat_list_vars(Es). - -match_pat_list_vars(Ps) -> - foldl(fun (P, {Used0,New0}) -> - {Used,New} = match_pat_vars(P), - {union(Used0, Used),union(New0, New)} end, - {[],[]}, Ps). - -%% new_var(VarName, I, Vdb) -> Vdb. -%% new_vars([VarName], I, Vdb) -> Vdb. -%% use_var(VarName, I, Vdb) -> Vdb. -%% use_vars([VarName], I, Vdb) -> Vdb. -%% add_var(VarName, F, L, Vdb) -> Vdb. - -new_var(V, I, Vdb) -> - case vdb_find(V, Vdb) of - {V,F,L} when I < F -> vdb_store(V, I, L, Vdb); - {V,_,_} -> Vdb; - error -> vdb_store(V, I, I, Vdb) - end. - -new_vars(Vs, I, Vdb0) -> - foldl(fun (V, Vdb) -> new_var(V, I, Vdb) end, Vdb0, Vs). - -use_var(V, I, Vdb) -> - case vdb_find(V, Vdb) of - {V,F,L} when I > L -> vdb_store(V, F, I, Vdb); - {V,_,_} -> Vdb; - error -> vdb_store(V, I, I, Vdb) - end. - -use_vars(Vs, I, Vdb0) -> - foldl(fun (V, Vdb) -> use_var(V, I, Vdb) end, Vdb0, Vs). - -add_var(V, F, L, Vdb) -> - use_var(V, L, new_var(V, F, Vdb)). - -vdb_find(V, Vdb) -> - %% Peformance note: Profiling shows that this function accounts for - %% a lot of the execution time when huge constants terms are built. - %% Using the BIF lists:keysearch/3 is a lot faster than the - %% original Erlang version. - case lists:keysearch(V, 1, Vdb) of - {value,Vd} -> Vd; - false -> error - end. - -%vdb_find(V, [{V1,F,L}=Vd|Vdb]) when V < V1 -> error; -%vdb_find(V, [{V1,F,L}=Vd|Vdb]) when V == V1 -> Vd; -%vdb_find(V, [{V1,F,L}=Vd|Vdb]) when V > V1 -> vdb_find(V, Vdb); -%vdb_find(V, []) -> error. - -vdb_store(V, F, L, [{V1,_,_}=Vd|Vdb]) when V > V1 -> - [Vd|vdb_store(V, F, L, Vdb)]; -vdb_store(V, F, L, [{V1,_,_}=Vd|Vdb]) when V < V1 -> [{V,F,L},Vd|Vdb]; -vdb_store(V, F, L, [{_V1,_,_}|Vdb]) -> [{V,F,L}|Vdb]; %V == V1 -vdb_store(V, F, L, []) -> [{V,F,L}]. - -%% vdb_sub(Min, Max, Vdb) -> Vdb. -%% Extract variables which are used before and after Min. Lock -%% variables alive after Max. - -vdb_sub(Min, Max, Vdb) -> - [ if L >= Max -> {V,F,1000000}; - true -> Vd - end || {V,F,L}=Vd <- Vdb, F < Min, L >= Min ]. diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_life.hrl b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_life.hrl deleted file mode 100644 index 95adcfcfd8..0000000000 --- a/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_life.hrl +++ /dev/null @@ -1,25 +0,0 @@ -%% ``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 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. -%% -%% 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: v3_life.hrl,v 1.1 2008/12/17 09:53:43 mikpe Exp $ -%% -%% This record contains variable life-time annotation for a -%% kernel expression. Added by v3_life, used by v3_codegen. - --record(l, {ke, %Kernel expression - i=0, %Op number - vdb=[], %Variable database - a}). %Core annotation - |