aboutsummaryrefslogtreecommitdiffstats
path: root/lib/dialyzer/test/options1_tests_SUITE_data
diff options
context:
space:
mode:
authorStavros Aronis <[email protected]>2010-06-18 03:44:25 +0300
committerLukas Larsson <[email protected]>2011-02-18 12:03:18 +0100
commit98de31e836a04ccc8f5f9acd90b9ba0803a24ab5 (patch)
tree3f26237297b0b2d9040de1b97eeb7cd75bce2dfe /lib/dialyzer/test/options1_tests_SUITE_data
parent08cec89bb1e781157a75c13e72562258b271b469 (diff)
downloadotp-98de31e836a04ccc8f5f9acd90b9ba0803a24ab5.tar.gz
otp-98de31e836a04ccc8f5f9acd90b9ba0803a24ab5.tar.bz2
otp-98de31e836a04ccc8f5f9acd90b9ba0803a24ab5.zip
Test suites for Dialyzer
This is a transcription of most of the cvs.srv.it.uu.se:/hipe repository dialyzer_tests into test suites that use the test server framework. See README for information on how to use the included scripts for modifications and updates. When testing Dialyzer it's important that several OTP modules are included in the plt. The suites takes care of that too.
Diffstat (limited to 'lib/dialyzer/test/options1_tests_SUITE_data')
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/dialyzer_options2
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/my_include/CVS/Entries3
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/my_include/CVS/Repository1
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/my_include/CVS/Root1
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/my_include/erl_bits.hrl43
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/my_include/erl_compile.hrl42
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/results/compiler35
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_asm.erl358
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_block.erl601
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_bool.erl617
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_clean.erl232
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_dict.erl196
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_disasm.erl964
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_flatten.erl137
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_jump.erl477
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_listing.erl117
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_opcodes.erl240
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_opcodes.hrl12
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_type.erl551
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_validator.erl1022
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl.erl4169
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_clauses.erl409
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_inline.erl2762
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_trees.erl801
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/compile.erl1109
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_lib.erl509
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_lint.erl515
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_parse.erl4911
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_parse.hrl111
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_pp.erl430
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_scan.erl495
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/erl_bifs.erl486
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/rec_env.erl611
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/sys_expand_pmod.erl425
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/sys_pre_attributes.erl212
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/sys_pre_expand.erl1026
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_codegen.erl1755
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_core.erl1320
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_kernel.erl1568
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_kernel.hrl77
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_kernel_pp.erl444
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_life.erl448
-rw-r--r--lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_life.hrl25
43 files changed, 30269 insertions, 0 deletions
diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/dialyzer_options b/lib/dialyzer/test/options1_tests_SUITE_data/dialyzer_options
new file mode 100644
index 0000000000..30731d815b
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/dialyzer_options
@@ -0,0 +1,2 @@
+{dialyzer_options, [{include_dirs, ["my_include"]}, {defines, [{'COMPILER_VSN', 42}]}, {warnings, [no_improper_lists]}]}.
+{time_limit, 10}.
diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/my_include/CVS/Entries b/lib/dialyzer/test/options1_tests_SUITE_data/my_include/CVS/Entries
new file mode 100644
index 0000000000..513d4a315a
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/my_include/CVS/Entries
@@ -0,0 +1,3 @@
+/erl_bits.hrl/1.1/Wed Dec 17 09:53:40 2008//
+/erl_compile.hrl/1.1/Wed Dec 17 09:53:40 2008//
+D
diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/my_include/CVS/Repository b/lib/dialyzer/test/options1_tests_SUITE_data/my_include/CVS/Repository
new file mode 100644
index 0000000000..1c6511fec3
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/my_include/CVS/Repository
@@ -0,0 +1 @@
+dialyzer_tests/option_tests/compiler/my_include
diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/my_include/CVS/Root b/lib/dialyzer/test/options1_tests_SUITE_data/my_include/CVS/Root
new file mode 100644
index 0000000000..f6cdd6158b
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/my_include/CVS/Root
@@ -0,0 +1 @@
+:pserver:[email protected]:/hipe
diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/my_include/erl_bits.hrl b/lib/dialyzer/test/options1_tests_SUITE_data/my_include/erl_bits.hrl
new file mode 100644
index 0000000000..96d5cec268
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/my_include/erl_bits.hrl
@@ -0,0 +1,43 @@
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.0, (the "License"); you may not use this file except in
+%% compliance with the License. You may obtain a copy of the License at
+%% http://www.erlang.org/EPL1_0.txt
+%%
+%% 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 Original Code is Erlang-4.7.3, December, 1998.
+%%
+%% The Initial Developer of the Original Code is Ericsson Telecom
+%% AB. Portions created by Ericsson are Copyright (C), 1998, Ericsson
+%% Telecom AB. All Rights Reserved.
+%%
+%% Contributor(s): ______________________________________.''
+%%
+%% This is an -*- erlang -*- file.
+%% Generic compiler options, passed from the erl_compile module.
+
+-record(bittype, {
+ type, %% integer/float/binary
+ unit, %% element unit
+ sign, %% signed/unsigned
+ endian %% big/little
+ }).
+
+-record(bitdefault, {
+ integer, %% default type for integer
+ float, %% default type for float
+ binary %% default type for binary
+ }).
+
+%%% (From config.hrl in the bitsyntax branch.)
+-define(SYS_ENDIAN, big).
+-define(SIZEOF_CHAR, 1).
+-define(SIZEOF_DOUBLE, 8).
+-define(SIZEOF_FLOAT, 4).
+-define(SIZEOF_INT, 4).
+-define(SIZEOF_LONG, 4).
+-define(SIZEOF_LONG_LONG, 8).
+-define(SIZEOF_SHORT, 2).
diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/my_include/erl_compile.hrl b/lib/dialyzer/test/options1_tests_SUITE_data/my_include/erl_compile.hrl
new file mode 100644
index 0000000000..ef2b68ac9a
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/my_include/erl_compile.hrl
@@ -0,0 +1,42 @@
+%% ``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_compile.hrl,v 1.1 2008/12/17 09:53:40 mikpe Exp $
+%%
+
+%% Generic compiler options, passed from the erl_compile module.
+
+-record(options,
+ {includes=[], % Include paths (list of absolute
+ % directory names).
+ outdir=".", % Directory for result (absolute
+ % path).
+ output_type=undefined, % Type of output file (atom).
+ defines=[], % Preprocessor defines. Each
+ % element is an atom (the name to
+ % define), or a {Name, Value}
+ % tuple.
+ warning=1, % Warning level (0 - no
+ % warnings, 1 - standard level,
+ % 2, 3, ... - more warnings).
+ verbose=false, % Verbose (true/false).
+ optimize=999, % Optimize options.
+ specific=[], % Compiler specific options.
+ outfile="", % Name of output file (internal
+ % use in erl_compile.erl).
+ cwd % Current working directory
+ % for erlc.
+ }).
+
diff --git a/lib/dialyzer/test/options1_tests_SUITE_data/results/compiler b/lib/dialyzer/test/options1_tests_SUITE_data/results/compiler
new file mode 100644
index 0000000000..924ef389df
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/results/compiler
@@ -0,0 +1,35 @@
+
+beam_asm.erl:32: The pattern {'error', Error} can never match the type <<_:64,_:_*8>>
+beam_bool.erl:193: The pattern {[], _} can never match the type {[{_,_,_,_},...],[any()]}
+beam_bool.erl:510: The pattern [{'set', [Dst], _, _}, {'%live', _}] can never match the type [{_,_,_,_}]
+beam_disasm.erl:537: The variable X can never match since previous clauses completely covered the type 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7
+beam_type.erl:284: The pattern <'pi', 0> can never match the type <_,1 | 2>
+beam_validator.erl:396: The pattern <{'jump', {'f', _}}, Vst = {'vst', 'none', _}> can never match the type <_,#vst{current::#st{ct::[]}}>
+beam_validator.erl:690: The pattern <'term', OldT> can never match the type <{'tuple',[any(),...]},_>
+beam_validator.erl:692: Clause guard cannot succeed. The pattern <NewT = {Type, New}, OldT = {_, Old}> was matched against the type <{'tuple',[any(),...]},_>
+beam_validator.erl:699: Clause guard cannot succeed. The pattern <NewT = {Type, _}, 'number'> was matched against the type <{'tuple',[any(),...]},_>
+beam_validator.erl:702: The pattern <'number', OldT = {Type, _}> can never match the type <{'tuple',[any(),...]},_>
+beam_validator.erl:705: The pattern <'bool', {'atom', A}> can never match the type <{'tuple',[any(),...]},_>
+beam_validator.erl:707: The pattern <{'atom', A}, 'bool'> can never match the type <{'tuple',[any(),...]},_>
+beam_validator.erl:713: Guard test is_integer(Sz::[any(),...]) can never succeed
+beam_validator.erl:727: Function upgrade_bool/1 will never be called
+cerl_inline.erl:190: The pattern 'true' can never match the type 'false'
+cerl_inline.erl:219: The pattern 'true' can never match the type 'false'
+cerl_inline.erl:230: The pattern 'true' can never match the type 'false'
+cerl_inline.erl:2333: The pattern 'true' can never match the type 'false'
+cerl_inline.erl:2355: The pattern 'true' can never match the type 'false'
+cerl_inline.erl:238: The pattern 'true' can never match the type 'false'
+cerl_inline.erl:2436: Function filename/1 will never be called
+cerl_inline.erl:2700: The pattern 'true' can never match the type 'false'
+cerl_inline.erl:2730: The pattern <{F, L, D}, Vs> can never match the type <[1..255,...],[any()]>
+cerl_inline.erl:2738: The pattern <{F, L, D}, Vs> can never match the type <[1..255,...],[any()]>
+cerl_inline.erl:2750: The pattern <{[], L, D}, Vs> can never match the type <[1..255,...],[any()]>
+cerl_inline.erl:2752: The pattern <{[], _L, D}, Vs> can never match the type <[1..255,...],[any()]>
+cerl_inline.erl:2754: The pattern <{F, L, D}, Vs> can never match the type <[1..255,...],[any()]>
+cerl_inline.erl:2756: The pattern <{F, _L, D}, Vs> can never match the type <[1..255,...],[any()]>
+compile.erl:788: The pattern {'error', Es} can never match the type {'ok',<<_:64,_:_*8>>}
+core_lint.erl:473: The pattern <{'c_atom', _, 'all'}, 'binary', _Def, St> can never match the type <_,#c_nil{} | {'c_atom' | 'c_char' | 'c_float' | 'c_int' | 'c_string' | 'c_tuple',_,_} | #c_cons{hd::#c_nil{} | {'c_atom' | 'c_char' | 'c_float' | 'c_int' | 'c_string' | 'c_tuple',_,_} | #c_cons{hd::{_,_} | {_,_,_} | {_,_,_,_},tl::{_,_} | {_,_,_} | {_,_,_,_}},tl::#c_nil{} | {'c_atom' | 'c_char' | 'c_float' | 'c_int' | 'c_string' | 'c_tuple',_,_} | #c_cons{hd::{_,_} | {_,_,_} | {_,_,_,_},tl::{_,_} | {_,_,_} | {_,_,_,_}}},[any()],_>
+core_lint.erl:505: The pattern <_Req, 'unknown', St> can never match the type <non_neg_integer(),non_neg_integer(),_>
+v3_codegen.erl:1569: The call v3_codegen:load_reg_1(V::any(),I::0,Rs::any(),pos_integer()) will never return since it differs in the 4th argument from the success typing arguments: (any(),0,maybe_improper_list(),0)
+v3_codegen.erl:1571: The call v3_codegen:load_reg_1(V::any(),I::0,[],pos_integer()) will never return since it differs in the 4th argument from the success typing arguments: (any(),0,maybe_improper_list(),0)
+v3_core.erl:646: The pattern <Prim = {'iprimop', _, _, _}, St> can never match the type <#c_nil{anno::[any(),...]} | {'c_atom' | 'c_char' | 'c_float' | 'c_int' | 'c_string' | 'c_tuple' | 'c_var' | 'ibinary' | 'icatch' | 'ireceive1',[any(),...] | {_,_,_,_},_} | #c_cons{anno::[any(),...]} | #c_fname{anno::[any(),...]} | #iletrec{anno::{_,_,_,_},defs::[any(),...],body::[any(),...]} | #icase{anno::{_,_,_,_},args::[any()],clauses::[any()],fc::{_,_,_,_,_,_}} | #ireceive2{anno::{_,_,_,_},clauses::[any()],action::[any()]} | #ifun{anno::{_,_,_,_},id::[any(),...],vars::[any()],clauses::[any(),...],fc::{_,_,_,_,_,_}} | #imatch{anno::{_,_,_,_},guard::[],fc::{_,_,_,_,_,_}} | #itry{anno::{_,_,_,_},args::[any()],vars::[any(),...],body::[any(),...],evars::[any(),...],handler::[any(),...]},_>
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
new file mode 100644
index 0000000000..c2d9edcaa7
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_asm.erl
@@ -0,0 +1,358 @@
+%% ``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
new file mode 100644
index 0000000000..b0dd3e6380
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_block.erl
@@ -0,0 +1,601 @@
+%% ``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
new file mode 100644
index 0000000000..3180a22433
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_bool.erl
@@ -0,0 +1,617 @@
+%% ``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
new file mode 100644
index 0000000000..d47ae9c896
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_clean.erl
@@ -0,0 +1,232 @@
+%% ``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
new file mode 100644
index 0000000000..ddab957704
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_dict.erl
@@ -0,0 +1,196 @@
+%% ``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
new file mode 100644
index 0000000000..451b83db66
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_disasm.erl
@@ -0,0 +1,964 @@
+%% -*- 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
new file mode 100644
index 0000000000..a9958f87cd
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_flatten.erl
@@ -0,0 +1,137 @@
+%% ``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
new file mode 100644
index 0000000000..fd005898b6
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_jump.erl
@@ -0,0 +1,477 @@
+%% ``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
new file mode 100644
index 0000000000..006b8c551a
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_listing.erl
@@ -0,0 +1,117 @@
+%% ``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
new file mode 100644
index 0000000000..a4f5fd34d2
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_opcodes.erl
@@ -0,0 +1,240 @@
+-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
new file mode 100644
index 0000000000..1ad0887314
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_opcodes.hrl
@@ -0,0 +1,12 @@
+%% 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
new file mode 100644
index 0000000000..7d288b249c
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_type.erl
@@ -0,0 +1,551 @@
+%% ``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
new file mode 100644
index 0000000000..a01be447b0
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/beam_validator.erl
@@ -0,0 +1,1022 @@
+%% ``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
new file mode 100644
index 0000000000..be9e088276
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl.erl
@@ -0,0 +1,4169 @@
+%% ``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>&lt;<em>E1</em>, ..., <em>En</em>&gt;</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>#&lt;<em>Value</em>&gt;(<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
+%% &lt;<em>V1</em>, ..., <em>Vn</em>&gt; = <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>&lt;<em>P1</em>, ..., <em>Pn</em>&gt; 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 &lt;<em>V1</em>, ..., <em>Vn</em>&gt; ->
+%% <em>Body</em> catch &lt;<em>X1</em>, ..., <em>Xm</em>&gt; ->
+%% <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 &lt;- Group]
+%% || Group &lt;- 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
new file mode 100644
index 0000000000..f207178f13
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_clauses.erl
@@ -0,0 +1,409 @@
+%% ``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
new file mode 100644
index 0000000000..e040904a19
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_inline.erl
@@ -0,0 +1,2762 @@
+%% ``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
new file mode 100644
index 0000000000..50384a6ff8
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/cerl_trees.erl
@@ -0,0 +1,801 @@
+%% ``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 =&lt; Max
+%% =&lt; 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
new file mode 100644
index 0000000000..4542bf9eb9
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/compile.erl
@@ -0,0 +1,1109 @@
+%% ``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
new file mode 100644
index 0000000000..3a6158286f
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_lib.erl
@@ -0,0 +1,509 @@
+%% ``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
new file mode 100644
index 0000000000..2946fcb8c0
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_lint.erl
@@ -0,0 +1,515 @@
+%% ``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
new file mode 100644
index 0000000000..942845bef7
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_parse.erl
@@ -0,0 +1,4911 @@
+-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
new file mode 100644
index 0000000000..aaf913a15a
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_parse.hrl
@@ -0,0 +1,111 @@
+%% ``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
new file mode 100644
index 0000000000..147a0dba6c
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_pp.erl
@@ -0,0 +1,430 @@
+%% ``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
new file mode 100644
index 0000000000..f53c3c1631
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/core_scan.erl
@@ -0,0 +1,495 @@
+%% ``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
new file mode 100644
index 0000000000..088f44f9fd
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/erl_bifs.erl
@@ -0,0 +1,486 @@
+%% ``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
new file mode 100644
index 0000000000..0dd31b71ea
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/rec_env.erl
@@ -0,0 +1,611 @@
+%% =====================================================================
+%% 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
new file mode 100644
index 0000000000..c5052b0e51
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/sys_expand_pmod.erl
@@ -0,0 +1,425 @@
+%% ``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
new file mode 100644
index 0000000000..6e68611c66
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/sys_pre_attributes.erl
@@ -0,0 +1,212 @@
+%% ``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
new file mode 100644
index 0000000000..5e7c1c8bbd
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/sys_pre_expand.erl
@@ -0,0 +1,1026 @@
+%% ``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
new file mode 100644
index 0000000000..2af4d94655
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_codegen.erl
@@ -0,0 +1,1755 @@
+%% ``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
new file mode 100644
index 0000000000..b561182932
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_core.erl
@@ -0,0 +1,1320 @@
+%% ``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
new file mode 100644
index 0000000000..2d600fabc4
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_kernel.erl
@@ -0,0 +1,1568 @@
+%% ``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
new file mode 100644
index 0000000000..822a9e34e1
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_kernel.hrl
@@ -0,0 +1,77 @@
+%% ``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
new file mode 100644
index 0000000000..92ff173834
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_kernel_pp.erl
@@ -0,0 +1,444 @@
+%% ``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
new file mode 100644
index 0000000000..ff210d83f5
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_life.erl
@@ -0,0 +1,448 @@
+%% ``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
new file mode 100644
index 0000000000..95adcfcfd8
--- /dev/null
+++ b/lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/v3_life.hrl
@@ -0,0 +1,25 @@
+%% ``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
+