aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler/src')
-rw-r--r--lib/compiler/src/Makefile9
-rw-r--r--lib/compiler/src/beam_a.erl3
-rw-r--r--lib/compiler/src/beam_asm.erl77
-rw-r--r--lib/compiler/src/beam_block.erl3
-rw-r--r--lib/compiler/src/beam_bool.erl765
-rw-r--r--lib/compiler/src/beam_bs.erl3
-rw-r--r--lib/compiler/src/beam_bsm.erl38
-rw-r--r--lib/compiler/src/beam_clean.erl20
-rw-r--r--lib/compiler/src/beam_dead.erl59
-rw-r--r--lib/compiler/src/beam_dict.erl32
-rw-r--r--lib/compiler/src/beam_disasm.erl3
-rw-r--r--lib/compiler/src/beam_except.erl9
-rw-r--r--lib/compiler/src/beam_flatten.erl3
-rw-r--r--lib/compiler/src/beam_jump.erl64
-rw-r--r--lib/compiler/src/beam_listing.erl18
-rw-r--r--lib/compiler/src/beam_peep.erl3
-rw-r--r--lib/compiler/src/beam_receive.erl3
-rw-r--r--lib/compiler/src/beam_record.erl106
-rw-r--r--lib/compiler/src/beam_reorder.erl3
-rw-r--r--lib/compiler/src/beam_split.erl3
-rw-r--r--lib/compiler/src/beam_trim.erl9
-rw-r--r--lib/compiler/src/beam_type.erl58
-rw-r--r--lib/compiler/src/beam_utils.erl409
-rw-r--r--lib/compiler/src/beam_validator.erl36
-rw-r--r--lib/compiler/src/beam_z.erl3
-rw-r--r--lib/compiler/src/cerl.erl22
-rw-r--r--lib/compiler/src/cerl_clauses.erl9
-rw-r--r--lib/compiler/src/cerl_inline.erl11
-rw-r--r--lib/compiler/src/cerl_trees.erl9
-rw-r--r--lib/compiler/src/compile.erl504
-rw-r--r--lib/compiler/src/compiler.app.src8
-rw-r--r--lib/compiler/src/core_parse.yrl15
-rw-r--r--lib/compiler/src/core_pp.erl2
-rw-r--r--lib/compiler/src/core_scan.erl34
-rw-r--r--lib/compiler/src/erl_bifs.erl9
-rwxr-xr-xlib/compiler/src/genop.tab10
-rw-r--r--lib/compiler/src/rec_env.erl9
-rw-r--r--lib/compiler/src/sys_core_bsm.erl355
-rw-r--r--lib/compiler/src/sys_core_fold.erl600
-rw-r--r--lib/compiler/src/sys_pre_attributes.erl48
-rw-r--r--lib/compiler/src/sys_pre_expand.erl616
-rw-r--r--lib/compiler/src/v3_codegen.erl54
-rw-r--r--lib/compiler/src/v3_core.erl277
-rw-r--r--lib/compiler/src/v3_kernel.erl618
-rw-r--r--lib/compiler/src/v3_kernel.hrl3
-rw-r--r--lib/compiler/src/v3_kernel_pp.erl24
-rw-r--r--lib/compiler/src/v3_life.erl66
-rw-r--r--lib/compiler/src/v3_life.hrl8
48 files changed, 2439 insertions, 2611 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index 518c89d044..ef6db66ff6 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1996-2016. All Rights Reserved.
+# Copyright Ericsson AB 1996-2017. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
@@ -49,7 +49,6 @@ MODULES = \
beam_a \
beam_asm \
beam_block \
- beam_bool \
beam_bs \
beam_bsm \
beam_clean \
@@ -64,6 +63,7 @@ MODULES = \
beam_peep \
beam_receive \
beam_reorder \
+ beam_record \
beam_split \
beam_trim \
beam_type \
@@ -83,12 +83,12 @@ MODULES = \
core_scan \
erl_bifs \
rec_env \
+ sys_core_bsm \
sys_core_dsetel \
sys_core_fold \
sys_core_fold_lists \
sys_core_inline \
sys_pre_attributes \
- sys_pre_expand \
v3_codegen \
v3_core \
v3_kernel \
@@ -128,7 +128,7 @@ ERL_COMPILE_FLAGS += +native
endif
ERL_COMPILE_FLAGS += +inline +warn_unused_import \
-Werror \
- -I../../stdlib/include -I$(EGEN) -W
+ -I../../stdlib/include -I$(EGEN) -W +warn_missing_spec
# ----------------------------------------------------
# Targets
@@ -198,7 +198,6 @@ $(EBIN)/sys_core_dsetel.beam: core_parse.hrl
$(EBIN)/sys_core_fold.beam: core_parse.hrl
$(EBIN)/sys_core_fold_lists.beam: core_parse.hrl
$(EBIN)/sys_core_inline.beam: core_parse.hrl
-$(EBIN)/sys_pre_expand.beam: ../../stdlib/include/erl_bits.hrl
$(EBIN)/v3_codegen.beam: v3_life.hrl
$(EBIN)/v3_core.beam: core_parse.hrl
$(EBIN)/v3_kernel.beam: core_parse.hrl v3_kernel.hrl
diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl
index 91e6d80da3..cdb32d5d55 100644
--- a/lib/compiler/src/beam_a.erl
+++ b/lib/compiler/src/beam_a.erl
@@ -25,6 +25,9 @@
-export([module/2]).
+-spec module(beam_asm:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
Fs = [function(F) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl
index f6ca7a0afb..c35efdfc9d 100644
--- a/lib/compiler/src/beam_asm.erl
+++ b/lib/compiler/src/beam_asm.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -21,23 +21,54 @@
-module(beam_asm).
--export([module/4]).
+-export([module/5]).
-export([encode/2]).
+-export_type([fail/0,label/0,reg/0,src/0,module_code/0,function_name/0]).
+
-import(lists, [map/2,member/2,keymember/3,duplicate/2,splitwith/2]).
-include("beam_opcodes.hrl").
-module(Code, Abst, SourceFile, Opts) ->
- {ok,assemble(Code, Abst, SourceFile, Opts)}.
+%% Common types for describing operands for BEAM instructions.
+-type reg_num() :: 0..1023.
+-type reg() :: {'x',reg_num()} | {'y',reg_num()}.
+-type src() :: reg() |
+ {'literal',term()} |
+ {'atom',atom()} |
+ {'integer',integer()} |
+ 'nil' |
+ {'float',float()}.
+-type label() :: pos_integer().
+-type fail() :: {'f',label() | 0}.
+
+%% asm_instruction() describes only the instructions that
+%% are used in BEAM files (as opposed to internal instructions
+%% used only during optimization).
+
+-type asm_instruction() :: atom() | tuple().
+
+-type function_name() :: atom().
+
+-type asm_function() ::
+ {'function',function_name(),arity(),label(),[asm_instruction()]}.
+
+-type module_code() ::
+ {module(),[_],[_],[asm_function()],pos_integer()}.
+
+-spec module(module_code(), [{binary(), binary()}], [_], [compile:option()], [compile:option()]) ->
+ {'ok',binary()}.
-assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts) ->
+module(Code, ExtraChunks, SourceFile, Opts, CompilerOpts) ->
+ {ok,assemble(Code, ExtraChunks, SourceFile, Opts, CompilerOpts)}.
+
+assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, ExtraChunks, SourceFile, Opts, CompilerOpts) ->
{1,Dict0} = beam_dict:atom(Mod, beam_dict:new()),
{0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0),
NumFuncs = length(Asm0),
{Asm,Attr} = on_load(Asm0, Attr0),
Exp = cerl_sets:from_list(Exp0),
{Code,Dict2} = assemble_1(Asm, Exp, Dict1, []),
- build_file(Code, Attr, Dict2, NumLabels, NumFuncs, Abst, SourceFile, Opts).
+ build_file(Code, Attr, Dict2, NumLabels, NumFuncs, ExtraChunks, SourceFile, Opts, CompilerOpts).
on_load(Fs0, Attr0) ->
case proplists:get_value(on_load, Attr0) of
@@ -80,7 +111,7 @@ assemble_function([H|T], Acc, Dict0) ->
assemble_function([], Code, Dict) ->
{Code, Dict}.
-build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) ->
+build_file(Code, Attr, Dict, NumLabels, NumFuncs, ExtraChunks, SourceFile, Opts, CompilerOpts) ->
%% Create the code chunk.
CodeChunk = chunk(<<"Code">>,
@@ -92,9 +123,9 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) ->
Code),
%% Create the atom table chunk.
-
- {NumAtoms, AtomTab} = beam_dict:atom_table(Dict),
- AtomChunk = chunk(<<"Atom">>, <<NumAtoms:32>>, AtomTab),
+ AtomEncoding = atom_encoding(CompilerOpts),
+ {NumAtoms, AtomTab} = beam_dict:atom_table(Dict, AtomEncoding),
+ AtomChunk = chunk(atom_chunk_name(AtomEncoding), <<NumAtoms:32>>, AtomTab),
%% Create the import table chunk.
@@ -155,21 +186,30 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) ->
AttrChunk = chunk(<<"Attr">>, Attributes),
CompileChunk = chunk(<<"CInf">>, Compile),
- %% Create the abstract code chunk.
+ %% Compile all extra chunks.
- AbstChunk = chunk(<<"Abst">>, Abst),
+ CheckedChunks = [chunk(Key, Value) || {Key, Value} <- ExtraChunks],
%% Create IFF chunk.
Chunks = case member(slim, Opts) of
true ->
- [Essentials,AttrChunk,AbstChunk];
+ [Essentials,AttrChunk];
false ->
[Essentials,LocChunk,AttrChunk,
- CompileChunk,AbstChunk,LineChunk]
+ CompileChunk,CheckedChunks,LineChunk]
end,
build_form(<<"BEAM">>, Chunks).
+atom_encoding(Opts) ->
+ case proplists:get_bool(no_utf8_atoms, Opts) of
+ false -> utf8;
+ true -> latin1
+ end.
+
+atom_chunk_name(utf8) -> <<"AtU8">>;
+atom_chunk_name(latin1) -> <<"Atom">>.
+
%% finalize_fun_table(Essentials, MD5) -> FinalizedEssentials
%% Update the 'old_uniq' field in the entry for each fun in the
%% 'FunT' chunk. We'll use part of the MD5 for the module as a
@@ -233,7 +273,12 @@ build_attributes(Opts, SourceFile, Attr, MD5) ->
false -> Misc0;
true -> []
end,
- Compile = [{options,Opts},{version,?COMPILER_VSN}|Misc],
+ Compile = case member(deterministic, Opts) of
+ false ->
+ [{options,Opts},{version,?COMPILER_VSN}|Misc];
+ true ->
+ [{version,?COMPILER_VSN}]
+ end,
{term_to_binary(set_vsn_attribute(Attr, MD5)),term_to_binary(Compile)}.
build_line_table(Dict) ->
@@ -434,6 +479,8 @@ encode_alloc_list_1([{floats,Floats}|T], Dict, Acc0) ->
encode_alloc_list_1([], Dict, Acc) ->
{iolist_to_binary(Acc),Dict}.
+-spec encode(non_neg_integer(), pos_integer()) -> iodata().
+
encode(Tag, N) when N < 0 ->
encode1(Tag, negative_to_bytes(N));
encode(Tag, N) when N < 16 ->
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index 6a35191f6e..6543e05e20 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -25,6 +25,9 @@
-export([module/2]).
-import(lists, [reverse/1,reverse/2,foldl/3,member/2]).
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
Fs = [function(F) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl
deleted file mode 100644
index 99e4ccb1e9..0000000000
--- a/lib/compiler/src/beam_bool.erl
+++ /dev/null
@@ -1,765 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%% Purpose: Optimizes booleans in guards.
-
--module(beam_bool).
-
--export([module/2]).
-
--import(lists, [reverse/1,reverse/2,foldl/3,mapfoldl/3,map/2]).
-
--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) ->
- try
- {Is,#st{next=Lbl}} = bool_opt(Is0, Lbl0),
- {{function,Name,Arity,CLabel,Is},Lbl}
- catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
- io:fwrite("Function: ~w/~w\n", [Name,Arity]),
- erlang:raise(Class, Error, Stack)
- end.
-
-%%
-%% Optimize boolean expressions that use guard bifs. Rewrite to
-%% use test instructions if possible.
-%%
-
-bool_opt(Asm, Lbl) ->
- LiveInfo = beam_utils:index_labels(Asm),
- bopt(Asm, [], #st{next=Lbl,ll=LiveInfo}).
-
-bopt([{block,Bl0}=Block|
- [{jump,{f,Succ}},
- {label,Fail},
- {block,[{set,[Dst],[{atom,false}],move}]},
- {label,Succ}|Is]=Is0], Acc0, St) ->
- case split_block(Bl0, Dst, Fail, Acc0, true) of
- failed ->
- bopt(Is0, [Block|Acc0], St);
- {Bl,PreBlock} ->
- Acc1 = case PreBlock of
- [] -> Acc0;
- _ -> [{block,PreBlock}|Acc0]
- end,
- Acc = [{protected,[Dst],Bl,{Fail,Succ}}|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}}|Is], Acc0) ->
- Acc = [{block,Block},{jump,{f,Succ}},
- {label,Fail},
- {block,[{set,[Dst],[{atom,false}],move}]},
- {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, Acc0, false) 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),
- try
- {NewCode,St} = bopt_tree_cg(Bl, Fail, St0),
- ensure_opt_safe(Bl, NewCode, OldIs, Fail, Acc, St),
- {NewCode++Acc,St}
- catch
- %% 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.
- throw:mixed ->
- failed;
-
- %% There was a reference to a boolean expression
- %% from inside a protected block (try/catch), to
- %% a boolean expression outside.
- throw:protected_barrier ->
- failed;
-
- %% The 'xor' operator was used. We currently don't
- %% find it worthwile to translate 'xor' operators
- %% (the code would be clumsy).
- throw:'xor' ->
- failed;
-
- %% The block does not contain a boolean expression,
- %% but only a call to a guard BIF.
- %% For instance: ... when element(1, T) ->
- throw:not_boolean_expr ->
- failed;
-
- %% 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.)
- throw:all_registers_not_killed ->
- failed;
- throw:registers_used ->
- failed;
-
- %% A protected block refered to the value
- %% returned by another protected block,
- %% probably because the Core Erlang code
- %% used nested try/catches in the guard.
- %% (v3_core never produces nested try/catches
- %% in guards, so it must have been another
- %% Core Erlang translator.)
- throw:protected_violation ->
- failed;
-
- %% Failed to work out the live registers for a GC
- %% BIF. For example, if the number of live registers
- %% needed to be 4 because {x,3} was a source register,
- %% but {x,2} was not known to be initialized, this
- %% exception would be thrown.
- throw:gc_bif_alloc_failure ->
- failed
-
- end
- end.
-
-%% ensure_opt_safe(OriginalCode, OptCode, FollowingCode, Fail,
-%% ReversedPrecedingCode, State) -> ok
-%% 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.
-%%
-%% Throw an exception if the optimization is not safe.
-%%
-ensure_opt_safe(Bl, NewCode, OldIs, Fail, PrecedingCode, St) ->
- %% Here are the conditions that must be true for the
- %% optimization to be safe.
- %%
- %% 1. If a register is INITIALIZED by PrecedingCode,
- %% then if that register assigned a value in the original
- %% code, but not in the optimized code, it must be UNUSED or KILLED
- %% in the code that follows.
- %%
- %% 2. If a register is not known to be INITIALIZED by PreccedingCode,
- %% then if that register assigned a value in the original
- %% code, but not in the optimized code, it must be KILLED
- %% by the code that follows.
- %%
- %% 3. Any register that is assigned a value in the optimized
- %% code must be UNUSED or KILLED in the following code,
- %% unless we can be sure that it is always assigned the same
- %% value.
-
- InitInPreceding = initialized_regs(PrecedingCode),
-
- PrevDst = dst_regs(Bl),
- NewDst = dst_regs(NewCode),
- NotSet = ordsets:subtract(PrevDst, NewDst),
- MustBeKilled = ordsets:subtract(NotSet, InitInPreceding),
-
- case all_killed(MustBeKilled, OldIs, Fail, St) of
- false -> throw(all_registers_not_killed);
- true -> ok
- end,
- MustBeUnused = ordsets:subtract(ordsets:union(NotSet, NewDst),
- MustBeKilled),
- case none_used(MustBeUnused, OldIs, Fail, St) of
- false -> throw(registers_used);
- true -> ok
- end,
- ok.
-
-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([{set,Ds,As,{alloc,Regs,{gc_bif,N,{f,_}}}}|Is], Fail, Acc) ->
- update_fail_label(Is, Fail,
- [{set,Ds,As,{alloc,Regs,{gc_bif,N,{f,Fail}}}}|Acc]);
-update_fail_label([], _, Acc) -> reverse(Acc).
-
-make_block(Bl) ->
- make_block(Bl, []).
-
-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]) ->
- case extend_block_1(reverse(Is0), Fail, BlAcc0) of
- {BlAcc,[]} -> extend_block(BlAcc, Fail, OldAcc);
- {BlAcc,Is} -> {BlAcc,[{block,Is}|OldAcc]}
- end;
-extend_block(BlAcc, _, OldAcc) -> {BlAcc,OldAcc}.
-
-extend_block_1([{set,[{x,_}],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) ->
- extend_block_1(Is, Fail, [I|Acc]);
-extend_block_1([{set,[{x,_}],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([Instruction], Destination, FailLabel, [PreInstruction],
-%% ProhibitFailLabelInPreBlock) -> failed | {Block,PreBlock}
-%% Split a sequence of instructions into two blocks - one containing
-%% all guard bif instructions and a pre-block all instructions before
-%% the guard BIFs.
-
-split_block(Is0, Dst, Fail, PreIs, ProhibitFailLabel) ->
- case ProhibitFailLabel andalso beam_jump:is_label_used_in(Fail, PreIs) of
- true ->
- %% The failure label was used in one of the instructions (most
- %% probably bit syntax construction) preceeding the block,
- %% the caller might eliminate the label.
- failed;
- false ->
- case reverse(Is0) of
- [{set,[Dst],_,_}|_]=Is ->
- split_block_1(Is, Fail, ProhibitFailLabel);
- _ -> failed
- end
- end.
-
-split_block_1(Is, Fail, ProhibitFailLabel) ->
- case split_block_2(Is, Fail, []) of
- {[],_} -> failed;
- {_,PreBlock}=Res ->
- case ProhibitFailLabel andalso
- split_block_label_used(PreBlock, Fail) of
- true ->
- %% The failure label was used in the pre-block;
- %% not allowed, because the label may be removed.
- failed;
- false ->
- Res
- end
- end.
-
-split_block_2([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) ->
- split_block_2(Is, Fail, [I|Acc]);
-split_block_2([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}=I|Is], Fail, Acc) ->
- split_block_2(Is, Fail, [I|Acc]);
-split_block_2(Is0, _, Acc) ->
- Is = reverse(Is0),
- {Acc,Is}.
-
-split_block_label_used([{set,[_],_,{bif,_,{f,Fail}}}|_], Fail) ->
- true;
-split_block_label_used([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}|_], Fail) ->
- true;
-split_block_label_used([{set,[_],_,{alloc,_,{put_map,_,{f,Fail}}}}|_], Fail) ->
- true;
-split_block_label_used([_|Is], Fail) ->
- split_block_label_used(Is, Fail);
-split_block_label_used([], _) -> false.
-
-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([{set,[D],_,{alloc,_,{gc_bif,_,{f,_}}}}|Is], Acc) ->
- dst_regs(Is, [D|Acc]);
-dst_regs([{protected,_,Bl,_}|Is], Acc) ->
- dst_regs(Bl, dst_regs(Is, Acc));
-dst_regs([_|Is], Acc) ->
- dst_regs(Is, Acc);
-dst_regs([], Acc) -> ordsets:from_list(Acc).
-
-all_killed([R|Rs], OldIs, Fail, St) ->
- case is_killed(R, OldIs, Fail, St) of
- false -> false;
- true -> all_killed(Rs, OldIs, Fail, St)
- end;
-all_killed([], _, _, _) -> true.
-
-none_used([R|Rs], OldIs, Fail, St) ->
- case is_not_used(R, OldIs, Fail, St) of
- false -> false;
- true -> none_used(Rs, OldIs, Fail, St)
- end;
-none_used([], _, _, _) -> true.
-
-bopt_tree_cg(Block0, Fail, St) ->
- Free = free_variables(Block0),
- Block = ssa_block(Block0),
-%% io:format("~p\n", [Block0]),
-%% io:format("~p\n", [Block]),
-%% io:format("~p\n", [gb_trees:to_list(Free)]),
- case bopt_tree(Block, Free, []) of
- {Pre0,[{_,Tree}]} ->
- Pre1 = update_fail_label(Pre0, Fail, []),
- Regs0 = init_regs(gb_trees:keys(Free)),
-%% io:format("~p\n", [dst_regs(Block0)]),
-%% io:format("~p\n", [Pre1]),
-%% io:format("~p\n", [Tree]),
-%% io:nl(),
- {Pre,Regs} = rename_regs(Pre1, Regs0),
-%% io:format("~p\n", [Regs0]),
-%% io:format("~p\n", [Pre]),
- bopt_cg(Tree, Fail, Regs, make_block(Pre), St);
- _Res ->
- throw(not_boolean_expr)
- end.
-
-bopt_tree([{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(Is, Forest, Pre);
-bopt_tree([{set,[Dst],As0,{bif,'and',_}}|Is], Forest0, Pre) ->
- {As,Forest1} = bopt_bool_args(As0, Forest0),
- Node = make_and_node(As),
- Forest = gb_trees:enter(Dst, Node, Forest1),
- bopt_tree(Is, Forest, Pre);
-bopt_tree([{set,[Dst],As0,{bif,'or',_}}|Is], Forest0, Pre) ->
- {As,Forest1} = bopt_bool_args(As0, Forest0),
- Node = make_or_node(As),
- Forest = gb_trees:enter(Dst, Node, Forest1),
- bopt_tree(Is, Forest, Pre);
-bopt_tree([{set,_,_,{bif,'xor',_}}|_], _, _) ->
- throw('xor');
-bopt_tree([{protected,[Dst],Code,_}|Is], Forest0, Pre) ->
- ProtForest0 = gb_trees:from_orddict([P || {_,any}=P <- gb_trees:to_list(Forest0)]),
- case bopt_tree(Code, ProtForest0, []) of
- {ProtPre,[{_,ProtTree}]} ->
- Prot = {prot,ProtPre,ProtTree},
- Forest = gb_trees:enter(Dst, Prot, Forest0),
- bopt_tree(Is, Forest, Pre);
- _Res ->
- throw(not_boolean_expr)
- end;
-bopt_tree([{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(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(Is, Forest, Pre)
- end;
-bopt_tree([{set,[Dst],As,{alloc,_,{gc_bif,_,_}}}=Bif|Is], Forest0, Pre) ->
- bopt_good_args(As, Forest0),
- Forest = gb_trees:enter(Dst, any, Forest0),
- bopt_tree(Is, Forest, [Bif|Pre]);
-bopt_tree([], Forest, Pre) ->
- {reverse(Pre),[R || {_,V}=R <- gb_trees:to_list(Forest), V =/= any]}.
-
-safe_bool_op(N, Ar) ->
- erl_internal:new_type_test(N, Ar) orelse erl_internal:comp_op(N, Ar).
-
-bopt_bool_args([V0,V0], Forest0) ->
- {V,Forest} = bopt_bool_arg(V0, Forest0),
- {[V,V],Forest};
-bopt_bool_args(As, Forest) ->
- mapfoldl(fun bopt_bool_arg/2, Forest, As).
-
-bopt_bool_arg({T,_}=R, Forest) when T =:= x; T =:= y; T =:= tmp ->
- Val = case gb_trees:lookup(R, Forest) of
- {value,any} -> {test,is_eq_exact,fail,[R,{atom,true}]};
- {value,Val0} -> Val0;
- none -> throw(mixed)
- end,
- {Val,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({Tag,_}=X, Regs) when Tag =:= x; Tag =:= tmp ->
- case gb_trees:lookup(X, Regs) of
- {value,any} -> ok;
- {value,_} -> throw(mixed);
- none -> throw(protected_barrier)
- end;
-bopt_good_arg(_, _) -> ok.
-
-bif_to_test(_, N, As) ->
- beam_utils:bif_to_test(N, As, fail).
-
-make_and_node(Is) ->
- AndList0 = make_and_list(Is),
- case simplify_and_list(AndList0) of
- [] -> {atom,true};
- [Op] -> Op;
- AndList -> {'and',AndList}
- 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([]) -> [].
-
-simplify_and_list([{atom,true}|T]) ->
- simplify_and_list(T);
-simplify_and_list([{atom,false}=False|_]) ->
- [False];
-simplify_and_list([H|T]) ->
- [H|simplify_and_list(T)];
-simplify_and_list([]) -> [].
-
-make_or_node(Is) ->
- OrList0 = make_or_list(Is),
- case simplify_or_list(OrList0) of
- [] -> {atom,false};
- [Op] -> Op;
- OrList -> {'or',OrList}
- end.
-
-make_or_list([{'or',As}|Is]) ->
- make_or_list(As++Is);
-make_or_list([I|Is]) ->
- [I|make_or_list(Is)];
-make_or_list([]) -> [].
-
-simplify_or_list([{atom,false}|T]) ->
- simplify_or_list(T);
-simplify_or_list([{atom,true}=True|_]) ->
- [True];
-simplify_or_list([H|T]) ->
- [H|simplify_or_list(T)];
-simplify_or_list([]) -> [].
-
-%% Code generation for a boolean tree.
-
-bopt_cg({'not',Arg}, Fail, Rs, Acc, St) ->
- I = bopt_cg_not(Arg),
- bopt_cg(I, Fail, Rs, Acc, St);
-bopt_cg({'and',As}, Fail, Rs, Acc, St) ->
- bopt_cg_and(As, Fail, Rs, Acc, St);
-bopt_cg({'or',As}, Fail, Rs, Acc, St0) ->
- {Succ,St} = new_label(St0),
- bopt_cg_or(As, Succ, Fail, Rs, Acc, St);
-bopt_cg({test,N,fail,As0}, Fail, Rs, Acc, St) ->
- As = rename_sources(As0, Rs),
- Test = {test,N,{f,Fail},As},
- {[Test|Acc],St};
-bopt_cg({inverted_test,N,fail,As0}, Fail, Rs, Acc, St0) ->
- As = rename_sources(As0, Rs),
- {Lbl,St} = new_label(St0),
- {[{label,Lbl},{jump,{f,Fail}},{test,N,{f,Lbl},As}|Acc],St};
-bopt_cg({prot,Pre0,Tree}, Fail, Rs0, Acc, St0) ->
- Pre1 = update_fail_label(Pre0, Fail, []),
- {Pre,Rs} = rename_regs(Pre1, Rs0),
- bopt_cg(Tree, Fail, Rs, make_block(Pre, Acc), St0);
-bopt_cg({atom,true}, _Fail, _Rs, Acc, St) ->
- {Acc,St};
-bopt_cg({atom,false}, Fail, _Rs, Acc, St) ->
- {[{jump,{f,Fail}}|Acc],St};
-bopt_cg(_, _, _, _, _) ->
- throw(not_boolean_expr).
-
-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({'not',Arg}) ->
- bopt_cg_not_not(Arg);
-bopt_cg_not({test,Test,Fail,As}) ->
- {inverted_test,Test,Fail,As};
-bopt_cg_not({atom,Bool}) when is_boolean(Bool) ->
- {atom,not Bool};
-bopt_cg_not(_) ->
- throw(not_boolean_expr).
-
-bopt_cg_not_not({'and',As}) ->
- {'and',[bopt_cg_not_not(A) || A <- As]};
-bopt_cg_not_not({'or',As}) ->
- {'or',[bopt_cg_not_not(A) || A <- As]};
-bopt_cg_not_not({'not',Arg}) ->
- bopt_cg_not(Arg);
-bopt_cg_not_not(Leaf) -> Leaf.
-
-bopt_cg_and([I|Is], Fail, Rs, Acc0, St0) ->
- {Acc,St} = bopt_cg(I, Fail, Rs, Acc0, St0),
- bopt_cg_and(Is, Fail, Rs, Acc, St);
-bopt_cg_and([], _, _, Acc, St) -> {Acc,St}.
-
-bopt_cg_or([I], Succ, Fail, Rs, Acc0, St0) ->
- {Acc,St} = bopt_cg(I, Fail, Rs, Acc0, St0),
- {[{label,Succ}|Acc],St};
-bopt_cg_or([I|Is], Succ, Fail, Rs, Acc0, St0) ->
- {Lbl,St1} = new_label(St0),
- {Acc,St} = bopt_cg(I, Lbl, Rs, Acc0, St1),
- bopt_cg_or(Is, Succ, Fail, Rs, [{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, E).
-
-free_vars_1([{set,Ds,As,{bif,_,_}}|Is], F0, N0, A) ->
- F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)),
- N = gb_sets:union(N0, var_list(Ds)),
- free_vars_1(Is, F, N, A);
-free_vars_1([{set,Ds,As,{alloc,Regs,{gc_bif,_,_}}}|Is], F0, N0, A0) ->
- A = gb_sets:union(A0, gb_sets:from_list(free_vars_regs(Regs))),
- F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)),
- N = gb_sets:union(N0, var_list(Ds)),
- free_vars_1(Is, F, N, A);
-free_vars_1([{protected,_,Pa,_}|Is], F, N, A) ->
- free_vars_1(Pa++Is, F, N, A);
-free_vars_1([], F0, N, A) ->
- F = case gb_sets:is_empty(A) of
- true ->
- %% No GC BIFs.
- {x,X} = gb_sets:smallest(N),
- P = ordsets:from_list(free_vars_regs(X)),
- ordsets:union(gb_sets:to_list(F0), P);
- false ->
- %% At least one GC BIF.
- gb_sets:to_list(gb_sets:union(F0, gb_sets:difference(A, N)))
- end,
- gb_trees:from_orddict([{K,any} || K <- F]).
-
-var_list(Is) ->
- var_list_1(Is, gb_sets:empty()).
-
-var_list_1([{Tag,_}=X|Is], D) when Tag =:= x; Tag =:= y ->
- var_list_1(Is, gb_sets:add(X, D));
-var_list_1([_|Is], D) ->
- var_list_1(Is, D);
-var_list_1([], D) -> D.
-
-free_vars_regs(0) -> [];
-free_vars_regs(X) -> [{x,X-1}|free_vars_regs(X-1)].
-
-rename_regs(Is, Regs) ->
- rename_regs(Is, Regs, []).
-
-rename_regs([{set,[Dst0],Ss0,{alloc,_,Info}}|Is], Regs0, Acc) ->
- Live = live_regs(Regs0),
- Ss = rename_sources(Ss0, Regs0),
- Regs = put_reg(Dst0, Regs0),
- Dst = fetch_reg(Dst0, Regs),
- rename_regs(Is, Regs, [{set,[Dst],Ss,{alloc,Live,Info}}|Acc]);
-rename_regs([{set,[Dst0],Ss0,Info}|Is], Regs0, Acc) ->
- Ss = rename_sources(Ss0, Regs0),
- Regs = put_reg(Dst0, Regs0),
- Dst = fetch_reg(Dst0, Regs),
- rename_regs(Is, Regs, [{set,[Dst],Ss,Info}|Acc]);
-rename_regs([], Regs, Acc) -> {reverse(Acc),Regs}.
-
-rename_sources(Ss, Regs) ->
- map(fun({x,_}=R) -> fetch_reg(R, Regs);
- ({tmp,_}=R) -> fetch_reg(R, Regs);
- (E) -> E
- end, Ss).
-
-%%%
-%%% Keeping track of register assignments.
-%%%
-
-init_regs(Free) ->
- init_regs_1(Free, 0).
-
-init_regs_1([{x,I}=V|T], I) ->
- [{I,V}|init_regs_1(T, I+1)];
-init_regs_1([{x,X}|_]=T, I) when I < X ->
- [{I,reserved}|init_regs_1(T, I+1)];
-init_regs_1([{y,_}|_], _) -> [];
-init_regs_1([], _) -> [].
-
-put_reg(V, Rs) -> put_reg_1(V, Rs, 0).
-
-put_reg_1(V, [R|Rs], I) -> [R|put_reg_1(V, Rs, I+1)];
-put_reg_1(V, [], I) -> [{I,V}].
-
-fetch_reg(V, [{I,V}|_]) -> {x,I};
-fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs).
-
-live_regs([{_,reserved}|_]) ->
- %% We are not sure that this register is initialized, so we must
- %% abort the optimization.
- throw(gc_bif_alloc_failure);
-live_regs([{I,_}]) ->
- I+1;
-live_regs([{_,_}|Regs]) ->
- live_regs(Regs);
-live_regs([]) ->
- 0.
-
-
-%%%
-%%% Convert a block to Static Single Assignment (SSA) form.
-%%%
-
--record(ssa,
- {live=0, %Variable counter.
- sub=gb_trees:empty(), %Substitution table.
- prot=gb_sets:empty(), %Targets assigned by protecteds.
- in_prot=false %Inside a protected.
- }).
-
-ssa_block(Is0) ->
- {Is,_} = ssa_block_1(Is0, #ssa{}, []),
- Is.
-
-ssa_block_1([{protected,[_],Pa0,Pb}|Is], Sub0, Acc) ->
- {Pa,Sub1} = ssa_block_1(Pa0, Sub0#ssa{in_prot=true}, []),
- Dst = ssa_last_target(Pa),
- Sub = Sub1#ssa{prot=gb_sets:insert(Dst, Sub1#ssa.prot),
- in_prot=Sub0#ssa.in_prot},
- 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) ->
- {NewReg,Ssa} = ssa_new_reg(Ssa0),
- case gb_trees:is_defined(R, Sub0) of
- false ->
- Sub = gb_trees:insert(R, NewReg, Sub0),
- Ssa#ssa{sub=Sub};
- true ->
- Sub1 = gb_trees:update(R, NewReg, Sub0),
- Sub = gb_trees:insert(NewReg, NewReg, Sub1),
- Ssa#ssa{sub=Sub}
- end.
-
-ssa_sub_list(List, Sub) ->
- [ssa_sub(E, Sub) || E <- List].
-
-ssa_sub(R0, #ssa{sub=Sub,prot=Prot,in_prot=InProt}) ->
- case gb_trees:lookup(R0, Sub) of
- none -> R0;
- {value,R} ->
- case InProt andalso gb_sets:is_element(R, Prot) of
- true ->
- throw(protected_violation);
- false ->
- R
- end
- end.
-
-ssa_new_reg(#ssa{live=Reg}=Ssa) ->
- {{tmp,Reg},Ssa#ssa{live=Reg+1}}.
-
-ssa_last_target([{set,[Dst],_,_}]) -> Dst;
-ssa_last_target([_|Is]) -> ssa_last_target(Is).
-
-%% is_killed(Register, [Instruction], FailLabel, 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, Label, #st{ll=Ll}) ->
- beam_utils:is_killed(R, Is, Ll) andalso
- beam_utils:is_killed_at(R, Label, Ll).
-
-%% is_not_used(Register, [Instruction], FailLabel, 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, Label, #st{ll=Ll}) ->
- beam_utils:is_not_used(R, Is, Ll) andalso
- beam_utils:is_not_used_at(R, Label, Ll).
-
-%% initialized_regs([Instruction]) -> [Register])
-%% Given a REVERSED instruction sequence, return a list of the registers
-%% that are guaranteed to be initialized (not contain garbage).
-
-initialized_regs(Is) ->
- initialized_regs(Is, ordsets:new()).
-
-initialized_regs([{set,Dst,_Src,{alloc,Live,_}}|_], Regs0) ->
- Regs = add_init_regs(free_vars_regs(Live), Regs0),
- add_init_regs(Dst, Regs);
-initialized_regs([{set,Dst,Src,_}|Is], Regs) ->
- initialized_regs(Is, add_init_regs(Dst, add_init_regs(Src, Regs)));
-initialized_regs([{test,_,_,Src}|Is], Regs) ->
- initialized_regs(Is, add_init_regs(Src, Regs));
-initialized_regs([{block,Bl}|Is], Regs) ->
- initialized_regs(reverse(Bl, Is), Regs);
-initialized_regs([{bs_context_to_binary,Src}|Is], Regs) ->
- initialized_regs(Is, add_init_regs([Src], Regs));
-initialized_regs([{label,_},{func_info,_,_,Arity}|_], Regs) ->
- InitRegs = free_vars_regs(Arity),
- add_init_regs(InitRegs, Regs);
-initialized_regs([_|_], Regs) -> Regs.
-
-add_init_regs([{x,_}=X|T], Regs) ->
- add_init_regs(T, ordsets:add_element(X, Regs));
-add_init_regs([_|T], Regs) ->
- add_init_regs(T, Regs);
-add_init_regs([], Regs) -> Regs.
diff --git a/lib/compiler/src/beam_bs.erl b/lib/compiler/src/beam_bs.erl
index 2aed98d4e7..beb055b23d 100644
--- a/lib/compiler/src/beam_bs.erl
+++ b/lib/compiler/src/beam_bs.erl
@@ -25,6 +25,9 @@
-export([module/2]).
-import(lists, [mapfoldl/3,reverse/1]).
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc0}, _Opt) ->
{Fs,Lc} = mapfoldl(fun function/2, Lc0, Fs0),
{ok,{Mod,Exp,Attr,Fs,Lc}}.
diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl
index ae1b34ba49..9a4e7fb133 100644
--- a/lib/compiler/src/beam_bsm.erl
+++ b/lib/compiler/src/beam_bsm.erl
@@ -60,19 +60,26 @@
%%% data structures or passed to BIFs.
%%%
+-type label() :: beam_asm:label().
+-type func_info() :: {beam_asm:reg(),boolean()}.
+
-record(btb,
- {f, %Gbtrees for all functions.
- index, %{Label,Code} index (for liveness).
- ok_br, %Labels that are OK.
- must_not_save, %Must not save position when
- % optimizing (reaches
- % bs_context_to_binary).
- must_save %Must save position when optimizing.
+ {f :: gb_trees:tree(label(), func_info()),
+ index :: beam_utils:code_index(), %{Label,Code} index (for liveness).
+ ok_br=gb_sets:empty() :: gb_sets:set(label()), %Labels that are OK.
+ must_not_save=false :: boolean(), %Must not save position when
+ % optimizing (reaches
+ % bs_context_to_binary).
+ must_save=false :: boolean() %Must save position when optimizing.
}).
+
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, Opts) ->
- D = #btb{f=btb_index(Fs0)},
- Fs = [function(F, D) || F <- Fs0],
+ FIndex = btb_index(Fs0),
+ Fs = [function(F, FIndex) || F <- Fs0],
Code = {Mod,Exp,Attr,Fs,Lc},
case proplists:get_bool(bin_opt_info, Opts) of
true ->
@@ -92,10 +99,10 @@ format_error({no_bin_opt,Reason}) ->
%%% Local functions.
%%%
-function({function,Name,Arity,Entry,Is}, D0) ->
+function({function,Name,Arity,Entry,Is}, FIndex) ->
try
Index = beam_utils:index_labels(Is),
- D = D0#btb{index=Index},
+ D = #btb{f=FIndex,index=Index},
{function,Name,Arity,Entry,btb_opt_1(Is, D, [])}
catch
Class:Error ->
@@ -179,15 +186,14 @@ btb_gen_save(false, _, Acc) -> Acc.
%% a bs_context_to_binary instruction.
%%
-btb_reaches_match(Is, RegList, D0) ->
+btb_reaches_match(Is, RegList, D) ->
try
Regs = btb_regs_from_list(RegList),
- D = D0#btb{ok_br=gb_sets:empty(),must_not_save=false,must_save=false},
#btb{must_not_save=MustNotSave,must_save=MustSave} =
- btb_reaches_match_1(Is, Regs, D),
- case MustNotSave and MustSave of
+ btb_reaches_match_1(Is, Regs, D),
+ case MustNotSave andalso MustSave of
true -> btb_error(must_and_must_not_save);
- _ -> {ok,MustSave}
+ false -> {ok,MustSave}
end
catch
throw:{error,_}=Error -> Error
diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl
index 10805a3c36..b736d39f9c 100644
--- a/lib/compiler/src/beam_clean.erl
+++ b/lib/compiler/src/beam_clean.erl
@@ -26,6 +26,9 @@
-export([clean_labels/1]).
-import(lists, [map/2,foldl/3,reverse/1,filter/2]).
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,_}, Opts) ->
Order = [Lbl || {function,_,_,Lbl,_} <- Fs0],
All = foldl(fun({function,_,_,Lbl,_}=Func,D) -> dict:store(Lbl, Func, D) end,
@@ -39,6 +42,10 @@ module({Mod,Exp,Attr,Fs0,_}, Opts) ->
{ok,{Mod,Exp,Attr,Fs,Lc}}.
%% Remove all bs_save2/2 instructions not referenced by a bs_restore2/2.
+
+-spec bs_clean_saves([beam_utils:instruction()]) ->
+ [beam_utils:instruction()].
+
bs_clean_saves(Is) ->
Needed = bs_restores(Is, []),
bs_clean_saves_1(Is, gb_sets:from_list(Needed), []).
@@ -98,13 +105,18 @@ add_to_work_list(F, {Fs,Used}=Sets) ->
%%% 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
+-type label() :: beam_asm:label().
+
+-record(st, {lmap :: [{label(),label()}], %Translation tables for labels.
+ entry :: beam_asm:label(), %Number of entry label.
+ lc :: non_neg_integer() %Label counter
}).
+-spec clean_labels([beam_utils:instruction()]) ->
+ {[beam_utils:instruction()],pos_integer()}.
+
clean_labels(Fs0) ->
- St0 = #st{lmap=[],lc=1},
+ St0 = #st{lmap=[],entry=1,lc=1},
{Fs1,#st{lmap=Lmap0,lc=Lc}} = function_renumber(Fs0, St0, []),
Lmap = gb_trees:from_orddict(ordsets:from_list(Lmap0)),
Fs = function_replace(Fs1, Lmap, []),
diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl
index 6f6d742293..d379fdc4eb 100644
--- a/lib/compiler/src/beam_dead.erl
+++ b/lib/compiler/src/beam_dead.erl
@@ -29,6 +29,10 @@
-import(lists, [mapfoldl/3,reverse/1]).
+
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,_}, _Opts) ->
{Fs1,Lc1} = beam_clean:clean_labels(Fs0),
{Fs,Lc} = mapfoldl(fun function/2, Lc1, Fs1),
@@ -266,20 +270,42 @@ backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) ->
false -> backward([Move|Is], D, [Jump|Acc]);
true -> backward([Jump|Is], D, Acc)
end;
-backward([{jump,{f,To}}=J|[{bif,Op,_,Ops,Reg}|Is]=Is0], D, Acc) ->
+backward([{jump,{f,To}}=J|[{bif,Op,{f,BifFail},Ops,Reg}|Is]=Is0], D, Acc) ->
try replace_comp_op(To, Reg, Op, Ops, D) of
I -> backward(Is, D, I++Acc)
catch
- throw:not_possible -> backward(Is0, D, [J|Acc])
+ throw:not_possible ->
+ case To =:= BifFail of
+ true ->
+ %% The bif instruction is redundant. See the comment
+ %% in the next clause for why there is no need to
+ %% test for liveness of Reg at label To.
+ backward([J|Is], D, Acc);
+ false ->
+ backward(Is0, D, [J|Acc])
+ end
end;
-backward([{test,bs_start_match2,F,_,[R,_],Ctxt}=I|Is], D,
+backward([{jump,{f,To}}=J|[{gc_bif,_,{f,To},_,_,_Dst}|Is]], D, Acc) ->
+ %% The gc_bif instruction is redundant, since either the gc_bif
+ %% instruction itself or the jump instruction will transfer control
+ %% to label To. Note that a gc_bif instruction does not assign its
+ %% destination register if the failure branch is taken; therefore,
+ %% the code at label To is not allowed to assume that the destination
+ %% register is initialized, and it is therefore no need to test
+ %% for liveness of the destination register at label To.
+ backward([J|Is], D, Acc);
+backward([{test,bs_start_match2,F,Live,[R,_]=Args,Ctxt}|Is], D,
[{test,bs_match_string,F,[Ctxt,Bs]},
{test,bs_test_tail2,F,[Ctxt,0]}|Acc0]=Acc) ->
+ {f,To0} = F,
case beam_utils:is_killed(Ctxt, Acc0, D) of
true ->
- Eq = {test,is_eq_exact,F,[R,{literal,Bs}]},
+ To = shortcut_bs_context_to_binary(To0, R, D),
+ Eq = {test,is_eq_exact,{f,To},[R,{literal,Bs}]},
backward(Is, D, [Eq|Acc0]);
false ->
+ To = shortcut_bs_start_match(To0, R, D),
+ I = {test,bs_start_match2,{f,To},Live,Args,Ctxt},
backward(Is, D, [I|Acc])
end;
backward([{test,bs_start_match2,{f,To0},Live,[Src|_]=Info,Dst}|Is], D, Acc) ->
@@ -357,6 +383,14 @@ backward([{kill,_}=I|Is], D, [{line,_},Exit|_]=Acc) ->
false -> backward(Is, D, [I|Acc]);
true -> backward(Is, D, Acc)
end;
+backward([{bif,'or',{f,To0},[Dst,{atom,false}],Dst}=I|Is], D,
+ [{test,is_eq_exact,{f,To},[Dst,{atom,true}]}|_]=Acc) ->
+ case shortcut_label(To0, D) of
+ To ->
+ backward(Is, D, Acc);
+ _ ->
+ backward(Is, D, [I|Acc])
+ end;
backward([I|Is], D, Acc) ->
backward(Is, D, [I|Acc]);
backward([], _D, Acc) -> Acc.
@@ -375,6 +409,8 @@ shortcut_select_list([Lit,{f,To0}|T], Reg, D, Acc) ->
shortcut_select_list(T, Reg, D, [{f,To},Lit|Acc]);
shortcut_select_list([], _, _, Acc) -> reverse(Acc).
+shortcut_label(0, _) ->
+ 0;
shortcut_label(To0, D) ->
case beam_utils:code_at(To0, D) of
[{jump,{f,To}}|_] -> shortcut_label(To, D);
@@ -551,6 +587,21 @@ shortcut_bs_start_match_1([{test,bs_start_match2,{f,To},_,[Reg|_],_}|_],
shortcut_bs_start_match_1(_, _, To, _) ->
To.
+%% shortcut_bs_context_to_binary(TargetLabel, Reg) -> TargetLabel
+%% If a bs_start_match2 instruction has been eliminated, the
+%% bs_context_to_binary instruction can be eliminated too.
+
+shortcut_bs_context_to_binary(To, Reg, D) ->
+ shortcut_bs_ctb_1(beam_utils:code_at(To, D), Reg, To, D).
+
+shortcut_bs_ctb_1([{bs_context_to_binary,Reg}|Is], Reg, To, D) ->
+ shortcut_bs_ctb_1(Is, Reg, To, D);
+shortcut_bs_ctb_1([{jump,{f,To}}|_], Reg, _, D) ->
+ Code = beam_utils:code_at(To, D),
+ shortcut_bs_ctb_1(Code, Reg, To, D);
+shortcut_bs_ctb_1(_, _, To, _) ->
+ To.
+
%% shortcut_rel_op(FailLabel, Operator, [Operand], D) -> FailLabel'
%% Try to shortcut the given test instruction. Example:
%%
diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl
index 9565ab74c4..990e86062a 100644
--- a/lib/compiler/src/beam_dict.erl
+++ b/lib/compiler/src/beam_dict.erl
@@ -24,11 +24,11 @@
-export([new/0,opcode/2,highest_opcode/1,
atom/2,local/4,export/4,import/4,
string/2,lambda/3,literal/2,line/2,fname/2,
- atom_table/1,local_table/1,export_table/1,import_table/1,
+ atom_table/2,local_table/1,export_table/1,import_table/1,
string_table/1,lambda_table/1,literal_table/1,
line_table/1]).
--type label() :: non_neg_integer().
+-type label() :: beam_asm:label().
-type index() :: non_neg_integer().
@@ -38,13 +38,16 @@
-type line_tab() :: #{{Fname :: index(), Line :: term()} => index()}.
-type literal_tab() :: dict:dict(Literal :: term(), index()).
+-type lambda_info() :: {label(),{index(),label(),non_neg_integer()}}.
+-type lambda_tab() :: {non_neg_integer(),[lambda_info()]}.
+
-record(asm,
{atoms = #{} :: atom_tab(),
exports = [] :: [{label(), arity(), label()}],
locals = [] :: [{label(), arity(), label()}],
imports = gb_trees:empty() :: import_tab(),
strings = <<>> :: binary(), %String pool
- lambdas = {0,[]}, %[{...}]
+ lambdas = {0,[]} :: lambda_tab(),
literals = dict:new() :: literal_tab(),
fnames = #{} :: fname_tab(),
lines = #{} :: line_tab(),
@@ -148,10 +151,7 @@ string(Str, Dict) when is_list(Str) ->
lambda(Lbl, NumFree, #asm{lambdas={OldIndex,Lambdas0}}=Dict) ->
%% Set Index the same as OldIndex.
Index = OldIndex,
- %% Initialize OldUniq to 0. It will be set to an unique value
- %% based on the MD5 checksum of the BEAM code for the module.
- OldUniq = 0,
- Lambdas = [{Lbl,{OldIndex,Lbl,Index,NumFree,OldUniq}}|Lambdas0],
+ Lambdas = [{Lbl,{Index,Lbl,NumFree}}|Lambdas0],
{OldIndex,Dict#asm{lambdas={OldIndex+1,Lambdas}}}.
%% Returns the index for a literal (adding it to the literal table if necessary).
@@ -185,6 +185,9 @@ line([{location,Name,Line}], #asm{lines=Lines,num_lines=N}=Dict0) ->
{Index, Dict1#asm{lines=Lines#{Key=>Index},num_lines=N+1}}
end.
+-spec fname(nonempty_string(), bdict()) ->
+ {non_neg_integer(), bdict()}.
+
fname(Name, #asm{fnames=Fnames}=Dict) ->
case Fnames of
#{Name := Index} -> {Index,Dict};
@@ -194,15 +197,15 @@ fname(Name, #asm{fnames=Fnames}=Dict) ->
end.
%% Returns the atom table.
-%% atom_table(Dict) -> {LastIndex,[Length,AtomString...]}
--spec atom_table(bdict()) -> {non_neg_integer(), [[non_neg_integer(),...]]}.
+%% atom_table(Dict, Encoding) -> {LastIndex,[Length,AtomString...]}
+-spec atom_table(bdict(), latin1 | utf8) -> {non_neg_integer(), [[non_neg_integer(),...]]}.
-atom_table(#asm{atoms=Atoms}) ->
+atom_table(#asm{atoms=Atoms}, Encoding) ->
NumAtoms = maps:size(Atoms),
Sorted = lists:keysort(2, maps:to_list(Atoms)),
{NumAtoms,[begin
- L = atom_to_list(A),
- [length(L)|L]
+ L = atom_to_binary(A, Encoding),
+ [byte_size(L),L]
end || {A,_} <- Sorted]}.
%% Returns the table of local functions.
@@ -239,8 +242,11 @@ lambda_table(#asm{locals=Loc0,lambdas={NumLambdas,Lambdas0}}) ->
Lambdas1 = sofs:relation(Lambdas0),
Loc = sofs:relation([{Lbl,{F,A}} || {F,A,Lbl} <- Loc0]),
Lambdas2 = sofs:relative_product1(Lambdas1, Loc),
+ %% Initialize OldUniq to 0. It will be set to an unique value
+ %% based on the MD5 checksum of the BEAM code for the module.
+ OldUniq = 0,
Lambdas = [<<F:32,A:32,Lbl:32,Index:32,NumFree:32,OldUniq:32>> ||
- {{_,Lbl,Index,NumFree,OldUniq},{F,A}} <- sofs:to_external(Lambdas2)],
+ {{Index,Lbl,NumFree},{F,A}} <- sofs:to_external(Lambdas2)],
{NumLambdas,Lambdas}.
%% Returns the literal table.
diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index c699672db1..8fd0b36d05 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -815,6 +815,9 @@ resolve_inst({is_tuple=I,Args0},_,_,_) ->
resolve_inst({test_arity=I,Args0},_,_,_) ->
[L|Args] = resolve_args(Args0),
{test,I,L,Args};
+resolve_inst({is_tagged_tuple=I,Args0},_,_,_) ->
+ [F|Args] = resolve_args(Args0),
+ {test,I,F,Args};
resolve_inst({select_val,Args},_,_,_) ->
[Reg,FLbl,{{z,1},{u,_Len},List0}] = Args,
List = resolve_args(List0),
diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl
index 4a181c1923..9801c68ee2 100644
--- a/lib/compiler/src/beam_except.erl
+++ b/lib/compiler/src/beam_except.erl
@@ -33,6 +33,9 @@
-import(lists, [reverse/1]).
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
Fs = [function(F) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
@@ -49,9 +52,9 @@ function({function,Name,Arity,CLabel,Is0}) ->
end.
-record(st,
- {lbl, %func_info label
- loc, %location for func_info
- arity %arity for function
+ {lbl :: beam_asm:label(), %func_info label
+ loc :: [_], %location for func_info
+ arity :: arity() %arity for function
}).
function_1(Is0) ->
diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl
index c9ff07b496..a4d45a4ca6 100644
--- a/lib/compiler/src/beam_flatten.erl
+++ b/lib/compiler/src/beam_flatten.erl
@@ -25,6 +25,9 @@
-import(lists, [reverse/1,reverse/2]).
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs,Lc}, _Opt) ->
{ok,{Mod,Exp,Attr,[function(F) || F <- Fs],Lc}}.
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl
index 48b5a32814..4365451356 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -23,7 +23,7 @@
-export([module/2,
is_unreachable_after/1,is_exit_instruction/1,
- remove_unused_labels/1,is_label_used_in/2]).
+ remove_unused_labels/1]).
%%% The following optimisations are done:
%%%
@@ -130,6 +130,11 @@
-import(lists, [reverse/1,reverse/2,foldl/3]).
+-type instruction() :: beam_utils:instruction().
+
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
Fs = [function(F) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
@@ -155,9 +160,7 @@ share(Is0) ->
Is = eliminate_fallthroughs(Is0, []),
share_1(Is, #{}, [], []).
-share_1([{label,_}=Lbl|Is], Dict, [], Acc) ->
- share_1(Is, Dict, [], [Lbl|Acc]);
-share_1([{label,L}=Lbl|Is], Dict0, Seq, Acc) ->
+share_1([{label,L}=Lbl|Is], Dict0, [_|_]=Seq, Acc) ->
case maps:find(Seq, Dict0) of
error ->
Dict = maps:put(Seq, L, Dict0),
@@ -208,21 +211,18 @@ sharable_with_try([]) -> true.
%% Eliminate all fallthroughs. Return the result reversed.
-eliminate_fallthroughs([I,{label,L}=Lbl|Is], Acc) ->
- case is_unreachable_after(I) orelse is_label(I) of
+eliminate_fallthroughs([{label,L}=Lbl|Is], [I|_]=Acc) ->
+ case is_unreachable_after(I) of
false ->
%% Eliminate fallthrough.
- eliminate_fallthroughs(Is, [Lbl,{jump,{f,L}},I|Acc]);
+ eliminate_fallthroughs(Is, [Lbl,{jump,{f,L}}|Acc]);
true ->
- eliminate_fallthroughs(Is, [Lbl,I|Acc])
+ eliminate_fallthroughs(Is, [Lbl|Acc])
end;
eliminate_fallthroughs([I|Is], Acc) ->
eliminate_fallthroughs(Is, [I|Acc]);
eliminate_fallthroughs([], Acc) -> Acc.
-is_label({label,_}) -> true;
-is_label(_) -> false.
-
%%%
%%% (2) Move short code sequences ending in an instruction that causes an exit
%%% to the end of the function.
@@ -274,9 +274,9 @@ extract_seq_1(_, _) -> no.
-record(st,
{
- entry, %Entry label (must not be moved).
- mlbl, %Moved labels.
- labels :: cerl_sets:set() %Set of referenced labels.
+ entry :: beam_asm:label(), %Entry label (must not be moved).
+ mlbl :: #{beam_asm:label() := [beam_asm:label()]}, %Moved labels.
+ labels :: cerl_sets:set() %Set of referenced labels.
}).
opt(Is0, CLabel) ->
@@ -458,6 +458,8 @@ is_label_used(L, St) ->
%% is_unreachable_after(Instruction) -> boolean()
%% Test whether the code after Instruction is unreachable.
+-spec is_unreachable_after(instruction()) -> boolean().
+
is_unreachable_after({func_info,_M,_F,_A}) -> true;
is_unreachable_after(return) -> true;
is_unreachable_after({jump,_Lbl}) -> true;
@@ -470,6 +472,8 @@ is_unreachable_after(I) -> is_exit_instruction(I).
%% Test whether the instruction Instruction always
%% causes an exit/failure.
+-spec is_exit_instruction(instruction()) -> boolean().
+
is_exit_instruction({call_ext,_,{extfunc,M,F,A}}) ->
erl_bifs:is_exit_bif(M, F, A);
is_exit_instruction(if_end) -> true;
@@ -478,40 +482,12 @@ is_exit_instruction({try_case_end,_}) -> true;
is_exit_instruction({badmatch,_}) -> true;
is_exit_instruction(_) -> false.
-%% is_label_used_in(LabelNumber, [Instruction]) -> boolean()
-%% Check whether the label is used in the instruction sequence
-%% (including inside blocks).
-
-is_label_used_in(Lbl, Is) ->
- is_label_used_in_1(Is, Lbl, cerl_sets:new()).
-
-is_label_used_in_1([{block,Block}|Is], Lbl, Empty) ->
- lists:any(fun(I) -> is_label_used_in_block(I, Lbl) end, Block)
- orelse is_label_used_in_1(Is, Lbl, Empty);
-is_label_used_in_1([I|Is], Lbl, Empty) ->
- Used = ulbl(I, Empty),
- cerl_sets:is_element(Lbl, Used) orelse is_label_used_in_1(Is, Lbl, Empty);
-is_label_used_in_1([], _, _) -> false.
-
-is_label_used_in_block({set,_,_,Info}, Lbl) ->
- case Info of
- {bif,_,{f,F}} -> F =:= Lbl;
- {alloc,_,{gc_bif,_,{f,F}}} -> F =:= Lbl;
- {alloc,_,{put_map,_,{f,F}}} -> F =:= Lbl;
- {get_map_elements,{f,F}} -> F =:= Lbl;
- {try_catch,_,{f,F}} -> F =:= Lbl;
- {alloc,_,_} -> false;
- {put_tuple,_} -> false;
- {get_tuple_element,_} -> false;
- {set_tuple_element,_} -> false;
- {line,_} -> false;
- _ when is_atom(Info) -> false
- end.
-
%% remove_unused_labels(Instructions0) -> Instructions
%% Remove all unused labels. Also remove unreachable
%% instructions following labels that are removed.
+-spec remove_unused_labels([instruction()]) -> [instruction()].
+
remove_unused_labels(Is) ->
Used0 = initial_labels(Is),
Used = foldl(fun ulbl/2, Used0, Is),
diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl
index ce566373bb..94b47cf568 100644
--- a/lib/compiler/src/beam_listing.erl
+++ b/lib/compiler/src/beam_listing.erl
@@ -21,14 +21,24 @@
-export([module/2]).
+-include("core_parse.hrl").
+-include("v3_kernel.hrl").
-include("v3_life.hrl").
-import(lists, [foreach/2]).
-module(File, Core) when element(1, Core) == c_module ->
+-type code() :: cerl:c_module()
+ | beam_utils:module_code()
+ | #k_mdef{}
+ | {module(),_,_,_} %v3_life
+ | [_]. %form-based format
+
+-spec module(file:io_device(), code()) -> 'ok'.
+
+module(File, #c_module{}=Core) ->
%% This is a core module.
io:put_chars(File, core_pp:format(Core));
-module(File, Kern) when element(1, Kern) == k_mdef ->
+module(File, #k_mdef{}=Kern) ->
%% This is a kernel module.
io:put_chars(File, v3_kernel_pp:format(Kern));
%%io:put_chars(File, io_lib:format("~p~n", [Kern]));
@@ -49,10 +59,6 @@ module(Stream, {Mod,Exp,Attr,Code,NumLabels}) ->
[Name, Arity, Entry]),
io:put_chars(Stream, format_asm(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).
diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl
index c8bef31824..6df5c02334 100644
--- a/lib/compiler/src/beam_peep.erl
+++ b/lib/compiler/src/beam_peep.erl
@@ -24,6 +24,9 @@
-import(lists, [reverse/1,member/2]).
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,_}, _Opts) ->
%% First coalesce adjacent labels.
{Fs1,Lc} = beam_clean:clean_labels(Fs0),
diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl
index 89cafe27ce..1403e1e05e 100644
--- a/lib/compiler/src/beam_receive.erl
+++ b/lib/compiler/src/beam_receive.erl
@@ -65,6 +65,9 @@
%%% as the SomeUniqInteger.
%%%
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
Fs = [function(F) || F <- Fs0],
Code = {Mod,Exp,Attr,Fs,Lc},
diff --git a/lib/compiler/src/beam_record.erl b/lib/compiler/src/beam_record.erl
new file mode 100644
index 0000000000..419089b1bc
--- /dev/null
+++ b/lib/compiler/src/beam_record.erl
@@ -0,0 +1,106 @@
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014-2017. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% File: beam_record.erl
+%% Author: Björn-Egil Dahlberg
+%% Created: 2014-09-03
+%%
+
+-module(beam_record).
+-export([module/2]).
+
+%% Rewrite the instruction stream on tagged tuple tests.
+%% Tagged tuples means a tuple of any arity with an atom as its first element.
+%% Typically records, ok-tuples and error-tuples.
+%%
+%% from:
+%% ...
+%% {test,is_tuple,Fail,[Src]}.
+%% {test,test_arity,Fail,[Src,Sz]}.
+%% ...
+%% {get_tuple_element,Src,0,Dst}.
+%% ...
+%% {test,is_eq_exact,Fail,[Dst,Atom]}.
+%% ...
+%% to:
+%% ...
+%% {test,is_tagged_tuple,Fail,[Src,Sz,Atom]}.
+%% ...
+
+
+-import(lists, [reverse/1]).
+
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
+module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
+ Fs = [function(F) || F <- Fs0],
+ {ok,{Mod,Exp,Attr,Fs,Lc}}.
+
+function({function,Name,Arity,CLabel,Is}) ->
+ try
+ Idx = beam_utils:index_labels(Is),
+ {function,Name,Arity,CLabel,rewrite(Is,Idx)}
+ catch
+ Class:Error ->
+ Stack = erlang:get_stacktrace(),
+ io:fwrite("Function: ~w/~w\n", [Name,Arity]),
+ erlang:raise(Class, Error, Stack)
+ end.
+
+rewrite(Is,Idx) ->
+ rewrite(Is,Idx,[]).
+
+rewrite([{test,is_tuple,Fail,[Src]}=I1,
+ {test,test_arity,Fail,[Src,N]}=I2|Is],Idx,Acc) ->
+ case is_tagged_tuple(Is,Fail,Src,Idx) of
+ no ->
+ rewrite(Is,Idx,[I2,I1|Acc]);
+ {Atom,[{block,[]}|Is1]} ->
+ rewrite(Is1,Idx,[{test,is_tagged_tuple,Fail,[Src,N,Atom]}|Acc]);
+ {Atom,Is1} ->
+ rewrite(Is1,Idx,[{test,is_tagged_tuple,Fail,[Src,N,Atom]}|Acc])
+ end;
+rewrite([I|Is],Idx,Acc) ->
+ rewrite(Is,Idx,[I|Acc]);
+rewrite([],_,Acc) -> reverse(Acc).
+
+is_tagged_tuple([{block,[{set,[Dst],[Src],{get_tuple_element,0}}=B|Bs]},
+ {test,is_eq_exact,Fail,[Dst,{atom,_}=Atom]}|Is],Fail,Src,Idx) ->
+
+ %% if Dst is killed in the instruction stream and at fail label,
+ %% we can safely remove get_tuple_element.
+ %%
+ %% if Dst is not killed in the stream, we cannot remove get_tuple_element
+ %% since it is referenced.
+
+ case is_killed(Dst,Is,Fail,Idx) of
+ true -> {Atom,[{block,Bs}|Is]};
+ false -> {Atom,[{block,[B|Bs]}|Is]}
+ end;
+is_tagged_tuple([{block,[{set,_,_,_}=B|Bs]},
+ {test,is_eq_exact,_,_}=I|Is],Fail,Src,Idx) ->
+ case is_tagged_tuple([{block,Bs},I|Is],Fail,Src,Idx) of
+ {Atom,[{block,Bsr}|Isr]} -> {Atom,[{block,[B|Bsr]}|Isr]};
+ no -> no
+ end;
+is_tagged_tuple(_Is,_Fail,_Src,_Idx) ->
+ no.
+
+is_killed(Dst,Is,{_,Lbl},Idx) ->
+ beam_utils:is_killed(Dst,Is,Idx) andalso
+ beam_utils:is_killed_at(Dst,Lbl,Idx).
diff --git a/lib/compiler/src/beam_reorder.erl b/lib/compiler/src/beam_reorder.erl
index 6a7c033ec6..910b7f6b0a 100644
--- a/lib/compiler/src/beam_reorder.erl
+++ b/lib/compiler/src/beam_reorder.erl
@@ -23,6 +23,9 @@
-export([module/2]).
-import(lists, [member/2,reverse/1]).
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
Fs = [function(F) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl
index feeab0af50..d041f18806 100644
--- a/lib/compiler/src/beam_split.erl
+++ b/lib/compiler/src/beam_split.erl
@@ -23,6 +23,9 @@
-import(lists, [reverse/1]).
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
Fs = [split_blocks(F) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl
index a8dc6805bc..4da0985085 100644
--- a/lib/compiler/src/beam_trim.erl
+++ b/lib/compiler/src/beam_trim.erl
@@ -24,10 +24,13 @@
-import(lists, [reverse/1,reverse/2,splitwith/2,sort/1]).
-record(st,
- {safe, %Safe labels.
- lbl %Code at each label.
+ {safe :: gb_sets:set(beam_asm:label()), %Safe labels.
+ lbl :: beam_utils:code_index() %Code at each label.
}).
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
Fs = [function(F) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
@@ -230,7 +233,7 @@ safe_labels([], Acc) -> gb_sets:from_list(Acc).
frame_layout(Is, Kills, #st{safe=Safe,lbl=D}) ->
N = frame_size(Is, Safe),
- IsKilled = fun(R) -> beam_utils:is_killed(R, Is, D) end,
+ IsKilled = fun(R) -> beam_utils:is_not_used(R, Is, D) end,
{N,frame_layout_1(Kills, 0, N, IsKilled, [])}.
frame_layout_1([{kill,{y,Y}}=I|Ks], Y, N, IsKilled, Acc) ->
diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl
index acaf3ede66..3d842a6fd3 100644
--- a/lib/compiler/src/beam_type.erl
+++ b/lib/compiler/src/beam_type.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -26,6 +26,11 @@
-import(lists, [filter/2,foldl/3,keyfind/3,member/2,
reverse/1,reverse/2,sort/1]).
+-define(UNICODE_INT, {integer,{0,16#10FFFF}}).
+
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
Fs = [function(F) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
@@ -34,7 +39,8 @@ function({function,Name,Arity,CLabel,Asm0}) ->
try
Asm1 = beam_utils:live_opt(Asm0),
Asm2 = opt(Asm1, [], tdb_new()),
- Asm = beam_utils:delete_live_annos(Asm2),
+ Asm3 = beam_utils:live_opt(Asm2),
+ Asm = beam_utils:delete_live_annos(Asm3),
{function,Name,Arity,CLabel,Asm}
catch
Class:Error ->
@@ -490,6 +496,10 @@ update({test,test_arity,_Fail,[Src,Arity]}, Ts0) ->
tdb_update([{Src,{tuple,Arity,[]}}], Ts0);
update({test,is_map,_Fail,[Src]}, Ts0) ->
tdb_update([{Src,map}], Ts0);
+update({get_map_elements,_,Src,{list,Elems0}}, Ts0) ->
+ {_Ss,Ds} = beam_utils:split_even(Elems0),
+ Elems = [{Dst,kill} || Dst <- Ds],
+ tdb_update([{Src,map}|Elems], Ts0);
update({test,is_nonempty_list,_Fail,[Src]}, Ts0) ->
tdb_update([{Src,nonempty_list}], Ts0);
update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) ->
@@ -503,10 +513,39 @@ update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) ->
end;
update({test,is_record,_Fail,[Src,Tag,{integer,Arity}]}, Ts) ->
tdb_update([{Src,{tuple,Arity,[Tag]}}], Ts);
-update({test,_Test,_Fail,_Other}, Ts) ->
- Ts;
+
+%% Binary matching
+
update({test,bs_get_integer2,_,_,Args,Dst}, Ts) ->
tdb_update([{Dst,get_bs_integer_type(Args)}], Ts);
+update({test,bs_get_utf8,_,_,_,Dst}, Ts) ->
+ tdb_update([{Dst,?UNICODE_INT}], Ts);
+update({test,bs_get_utf16,_,_,_,Dst}, Ts) ->
+ tdb_update([{Dst,?UNICODE_INT}], Ts);
+update({test,bs_get_utf32,_,_,_,Dst}, Ts) ->
+ tdb_update([{Dst,?UNICODE_INT}], Ts);
+update({bs_init,_,_,_,_,Dst}, Ts) ->
+ tdb_update([{Dst,kill}], Ts);
+update({bs_put,_,_,_}, Ts) ->
+ Ts;
+update({bs_save2,_,_}, Ts) ->
+ Ts;
+update({bs_restore2,_,_}, Ts) ->
+ Ts;
+update({bs_context_to_binary,Dst}, Ts) ->
+ tdb_update([{Dst,kill}], Ts);
+update({test,bs_start_match2,_,_,_,Dst}, Ts) ->
+ tdb_update([{Dst,kill}], Ts);
+update({test,bs_get_binary2,_,_,_,Dst}, Ts) ->
+ tdb_update([{Dst,kill}], Ts);
+update({test,bs_get_float2,_,_,_,Dst}, Ts) ->
+ tdb_update([{Dst,float}], Ts);
+
+update({test,_Test,_Fail,_Other}, Ts) ->
+ Ts;
+
+%% Calls
+
update({call_ext,Ar,{extfunc,math,Math,Ar}}, Ts) ->
case is_math_bif(Math, Ar) of
true -> tdb_update([{{x,0},float}], Ts);
@@ -533,9 +572,10 @@ update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) ->
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);
+update({call_fun, _}, Ts) -> tdb_kill_xregs(Ts);
+update({apply, _}, Ts) -> tdb_kill_xregs(Ts);
+
update({line,_}, Ts) -> Ts;
-update({bs_save2,_,_}, Ts) -> Ts;
-update({bs_restore2,_,_}, Ts) -> Ts;
%% The instruction is unknown. Kill all information.
update(_I, _Ts) -> tdb_new().
@@ -592,6 +632,9 @@ 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(ceil, 1) -> true;
+is_math_bif(floor, 1) -> true;
+is_math_bif(fmod, 2) -> true;
is_math_bif(pi, 0) -> true;
is_math_bif(_, _) -> false.
@@ -676,6 +719,9 @@ op_type('bsr') -> integer;
op_type('div') -> integer;
op_type(_) -> unknown.
+flush(Rs, [{set,[_],[_,_,_],{bif,is_record,_}}|_]=Is0, Acc0) ->
+ Acc = flush_all(Rs, Is0, Acc0),
+ {[],Acc};
flush(Rs, [{set,[_],[],{put_tuple,_}}|_]=Is0, Acc0) ->
Acc = flush_all(Rs, Is0, Acc0),
{[],Acc};
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index 249d9395ca..e39fbdc3b7 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -22,18 +22,37 @@
-module(beam_utils).
-export([is_killed_block/2,is_killed/3,is_killed_at/3,
- is_not_used/3,is_not_used_at/3,
+ is_not_used/3,
empty_label_index/0,index_label/3,index_labels/1,
code_at/2,bif_to_test/3,is_pure_test/1,
live_opt/1,delete_live_annos/1,combine_heap_needs/2,
split_even/1]).
+-export_type([code_index/0,module_code/0,instruction/0]).
+
-import(lists, [member/2,sort/1,reverse/1,splitwith/2]).
+%% instruction() describes all instructions that are used during optimzation
+%% (from beam_a to beam_z).
+-type instruction() :: atom() | tuple().
+
+-type code_index() :: gb_trees:tree(beam_asm:label(), [instruction()]).
+
+-type int_function() :: {'function',beam_asm:function_name(),arity(),
+ beam_asm:label(),[instruction()]}.
+
+-type module_code() ::
+ {module(),[_],[_],[int_function()],pos_integer()}.
+
+%% Internal types.
+-type fail() :: beam_asm:fail() | 'fail'.
+-type test() :: {'test',atom(),fail(),[beam_asm:src()]} |
+ {'test',atom(),fail(),integer(),list(),beam_asm:reg()}.
+-type result_cache() :: gb_trees:tree(beam_asm:label(), 'killed' | 'used').
+
-record(live,
- {bl, %Block check fun.
- lbl, %Label to code index.
- res}). %Result cache for each label.
+ {lbl :: code_index(), %Label to code index.
+ res :: result_cache()}). %Result cache for each label.
%% is_killed_block(Register, [Instruction]) -> true|false
@@ -45,12 +64,18 @@
%% i.e. it is OK to enter the instruction sequence with Register
%% containing garbage.
-is_killed_block(R, Is) ->
- case check_killed_block(R, Is) of
- killed -> true;
- used -> false;
- transparent -> false
- end.
+-spec is_killed_block(beam_asm:reg(), [instruction()]) -> boolean().
+
+is_killed_block({x,X}, [{set,_,_,{alloc,Live,_}}|_]) ->
+ X >= Live;
+is_killed_block(R, [{set,Ds,Ss,_Op}|Is]) ->
+ not member(R, Ss) andalso (member(R, Ds) orelse is_killed_block(R, Is));
+is_killed_block(R, [{'%live',_,Regs}|Is]) ->
+ case R of
+ {x,X} when (Regs bsr X) band 1 =:= 0 -> true;
+ _ -> is_killed_block(R, Is)
+ end;
+is_killed_block(_, []) -> false.
%% is_killed(Register, [Instruction], State) -> true|false
%% Determine whether a register is killed by the instruction sequence.
@@ -62,21 +87,25 @@ is_killed_block(R, Is) ->
%% The state (constructed by index_instructions/1) is used to allow us
%% to determine the kill state across branches.
+-spec is_killed(beam_asm:reg(), [instruction()], code_index()) -> boolean().
+
is_killed(R, Is, D) ->
- St = #live{bl=check_killed_block_fun(),lbl=D,res=gb_trees:empty()},
+ St = #live{lbl=D,res=gb_trees:empty()},
case check_liveness(R, Is, St) of
{killed,_} -> true;
- {used,_} -> false
+ {_,_} -> false
end.
%% is_killed_at(Reg, Lbl, State) -> true|false
%% Determine whether Reg is killed at label Lbl.
+-spec is_killed_at(beam_asm:reg(), beam_asm:label(), code_index()) -> boolean().
+
is_killed_at(R, Lbl, D) when is_integer(Lbl) ->
- St0 = #live{bl=check_killed_block_fun(),lbl=D,res=gb_trees:empty()},
+ St0 = #live{lbl=D,res=gb_trees:empty()},
case check_liveness_at(R, Lbl, St0) of
{killed,_} -> true;
- {used,_} -> false
+ {_,_} -> false
end.
%% is_not_used(Register, [Instruction], State) -> true|false
@@ -86,43 +115,38 @@ is_killed_at(R, Lbl, D) when is_integer(Lbl) ->
%% The state is used to allow us to determine the usage state
%% across branches.
+-spec is_not_used(beam_asm:reg(), [instruction()], code_index()) -> boolean().
+
is_not_used(R, Is, D) ->
- St = #live{bl=fun check_used_block/3,lbl=D,res=gb_trees:empty()},
+ St = #live{lbl=D,res=gb_trees:empty()},
case check_liveness(R, Is, St) of
- {killed,_} -> true;
- {used,_} -> false
- end.
-
-%% is_not_used(Register, [Instruction], State) -> true|false
-%% Determine whether a register is never used in the instruction sequence
-%% (it could still be referenced by an allocate instruction, meaning that
-%% it MUST be initialized, but that its value does not matter).
-%% The state is used to allow us to determine the usage state
-%% across branches.
-
-is_not_used_at(R, Lbl, D) ->
- St = #live{bl=fun check_used_block/3,lbl=D,res=gb_trees:empty()},
- case check_liveness_at(R, Lbl, St) of
- {killed,_} -> true;
- {used,_} -> false
+ {used,_} -> false;
+ {_,_} -> true
end.
%% index_labels(FunctionIs) -> State
%% Index the instruction sequence so that we can quickly
%% look up the instruction following a specific label.
+-spec index_labels([instruction()]) -> code_index().
+
index_labels(Is) ->
index_labels_1(Is, []).
%% empty_label_index() -> State
%% Create an empty label index.
+-spec empty_label_index() -> code_index().
+
empty_label_index() ->
gb_trees:empty().
%% index_label(Label, [Instruction], State) -> State
%% Add an index for a label.
+-spec index_label(beam_asm:label(), [instruction()], code_index()) ->
+ code_index().
+
index_label(Lbl, Is0, Acc) ->
Is = drop_labels(Is0),
gb_trees:enter(Lbl, Is, Acc).
@@ -131,12 +155,16 @@ index_label(Lbl, Is0, Acc) ->
%% code_at(Label, State) -> [I].
%% Retrieve the code at the given label.
+-spec code_at(beam_asm:label(), code_index()) -> [instruction()].
+
code_at(L, Ll) ->
gb_trees:get(L, Ll).
%% bif_to_test(Bif, [Op], Fail) -> {test,Test,Fail,[Op]}
%% Convert a BIF to a test. Fail if not possible.
+-spec bif_to_test(atom(), list(), fail()) -> test().
+
bif_to_test(is_atom, [_]=Ops, Fail) -> {test,is_atom,Fail,Ops};
bif_to_test(is_boolean, [_]=Ops, Fail) -> {test,is_boolean,Fail,Ops};
bif_to_test(is_binary, [_]=Ops, Fail) -> {test,is_binary,Fail,Ops};
@@ -169,6 +197,9 @@ bif_to_test(is_record, [_,_,_]=Ops, Fail) -> {test,is_record,Fail,Ops}.
%% Return 'true' if the test instruction does not modify any
%% registers and/or bit syntax matching state.
%%
+
+-spec is_pure_test(test()) -> boolean().
+
is_pure_test({test,is_eq,_,[_,_]}) -> true;
is_pure_test({test,is_ne,_,[_,_]}) -> true;
is_pure_test({test,is_eq_exact,_,[_,_]}) -> true;
@@ -191,7 +222,9 @@ is_pure_test({test,Op,_,Ops}) ->
%% whose destination is a register that will not be used.
%% Also insert {'%live',Live,Regs} annotations at the beginning
%% and end of each block.
-%%
+
+-spec live_opt([instruction()]) -> [instruction()].
+
live_opt(Is0) ->
{[{label,Fail}|_]=Bef,[Fi|Is]} =
splitwith(fun({func_info,_,_,_}) -> false;
@@ -204,7 +237,9 @@ live_opt(Is0) ->
%% delete_live_annos([Instruction]) -> [Instruction].
%% Delete all live annotations.
-%%
+
+-spec delete_live_annos([instruction()]) -> [instruction()].
+
delete_live_annos([{block,Bl0}|Is]) ->
case delete_live_annos(Bl0) of
[] -> delete_live_annos(Is);
@@ -219,6 +254,8 @@ delete_live_annos([]) -> [].
%% combine_heap_needs(HeapNeed1, HeapNeed2) -> HeapNeed
%% Combine the heap need for two allocation instructions.
+-spec combine_heap_needs(term(), term()) -> term().
+
combine_heap_needs({alloc,Alloc1}, {alloc,Alloc2}) ->
{alloc,combine_alloc_lists(Alloc1, Alloc2)};
combine_heap_needs({alloc,Alloc}, Words) when is_integer(Words) ->
@@ -231,6 +268,8 @@ combine_heap_needs(H1, H2) when is_integer(H1), is_integer(H2) ->
%% split_even/1
%% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]}
+-spec split_even(list()) -> {list(),list()}.
+
split_even(Rs) -> split_even(Rs, [], []).
@@ -240,15 +279,19 @@ split_even(Rs) -> split_even(Rs, [], []).
%% check_liveness(Reg, [Instruction], #live{}) ->
-%% {killed | used, #live{}}
+%% {killed | not_used | used, #live{}}
%% Find out whether Reg is used or killed in instruction sequence.
-%% 'killed' means that Reg is assigned a new value or killed by an
-%% allocation instruction. 'used' means that Reg is used in some way.
+%%
+%% killed - Reg is assigned or killed by an allocation instruction.
+%% not_used - the value of Reg is not used, but Reg must not be garbage
+%% used - Reg is used
-check_liveness(R, [{block,Blk}|Is], #live{bl=BlockCheck}=St0) ->
- case BlockCheck(R, Blk, St0) of
- {transparent,St} -> check_liveness(R, Is, St);
- {Other,_}=Res when is_atom(Other) -> Res
+check_liveness(R, [{block,Blk}|Is], St0) ->
+ case check_liveness_block(R, Blk, St0) of
+ {transparent,St1} ->
+ check_liveness(R, Is, St1);
+ {Other,_}=Res when is_atom(Other) ->
+ Res
end;
check_liveness(R, [{label,_}|Is], St) ->
check_liveness(R, Is, St);
@@ -258,8 +301,12 @@ check_liveness(R, [{test,_,{f,Fail},As}|Is], St0) ->
{used,St0};
false ->
case check_liveness_at(R, Fail, St0) of
- {killed,St} -> check_liveness(R, Is, St);
- {_,_}=Other -> Other
+ {killed,St1} ->
+ check_liveness(R, Is, St1);
+ {not_used,St1} ->
+ not_used(check_liveness(R, Is, St1));
+ {used,_}=Used ->
+ Used
end
end;
check_liveness(R, [{test,Op,Fail,Live,Ss,Dst}|Is], St) ->
@@ -329,7 +376,7 @@ check_liveness(R, [{call,Live,_}|Is], St) ->
case R of
{x,X} when X < Live -> {used,St};
{x,_} -> {killed,St};
- {y,_} -> check_liveness(R, Is, St)
+ {y,_} -> not_used(check_liveness(R, Is, St))
end;
check_liveness(R, [{call_ext,Live,_}=I|Is], St) ->
case R of
@@ -340,7 +387,7 @@ check_liveness(R, [{call_ext,Live,_}=I|Is], St) ->
{y,_} ->
case beam_jump:is_exit_instruction(I) of
false ->
- check_liveness(R, Is, St);
+ not_used(check_liveness(R, Is, St));
true ->
%% We must make sure we don't check beyond this
%% instruction or we will fall through into random
@@ -352,43 +399,20 @@ check_liveness(R, [{call_fun,Live}|Is], St) ->
case R of
{x,X} when X =< Live -> {used,St};
{x,_} -> {killed,St};
- {y,_} -> check_liveness(R, Is, St)
+ {y,_} -> not_used(check_liveness(R, Is, St))
end;
check_liveness(R, [{apply,Args}|Is], St) ->
case R of
{x,X} when X < Args+2 -> {used,St};
{x,_} -> {killed,St};
- {y,_} -> check_liveness(R, Is, St)
- end;
-check_liveness(R, [{bif,Op,{f,Fail},Ss,D}|Is], St0) ->
- case check_liveness_fail(R, Op, Ss, Fail, St0) of
- {killed,St} = Killed ->
- case member(R, Ss) of
- true -> {used,St};
- false when R =:= D -> Killed;
- false -> check_liveness(R, Is, St)
- end;
- Other ->
- Other
- end;
-check_liveness(R, [{gc_bif,Op,{f,Fail},Live,Ss,D}|Is], St0) ->
- case R of
- {x,X} when X >= Live ->
- {killed,St0};
- {x,_} ->
- {used,St0};
- _ ->
- case check_liveness_fail(R, Op, Ss, Fail, St0) of
- {killed,St}=Killed ->
- case member(R, Ss) of
- true -> {used,St};
- false when R =:= D -> Killed;
- false -> check_liveness(R, Is, St)
- end;
- Other ->
- Other
- end
- end;
+ {y,_} -> not_used(check_liveness(R, Is, St))
+ end;
+check_liveness(R, [{bif,Op,Fail,Ss,D}|Is], St) ->
+ Set = {set,[D],Ss,{bif,Op,Fail}},
+ check_liveness(R, [{block,[Set]}|Is], St);
+check_liveness(R, [{gc_bif,Op,{f,Fail},Live,Ss,D}|Is], St) ->
+ Set = {set,[D],Ss,{alloc,Live,{gc_bif,Op,Fail}}},
+ check_liveness(R, [{block,[Set]}|Is], St);
check_liveness(R, [{bs_put,{f,0},_,Ss}|Is], St) ->
case member(R, Ss) of
true -> {used,St};
@@ -414,7 +438,7 @@ check_liveness(R, [{make_fun2,_,_,_,NumFree}|Is], St) ->
case R of
{x,X} when X < NumFree -> {used,St};
{x,_} -> {killed,St};
- _ -> check_liveness(R, Is, St)
+ {y,_} -> not_used(check_liveness(R, Is, St))
end;
check_liveness({x,_}=R, [{'catch',_,_}|Is], St) ->
%% All x registers will be killed if an exception occurs.
@@ -483,18 +507,9 @@ check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) ->
Other
end
end;
-check_liveness(R, [{put_map,{f,_},_,Src,_D,Live,{list,_}}|_], St0) ->
- case R of
- Src ->
- {used,St0};
- {x,X} when X < Live ->
- {used,St0};
- {x,_} ->
- {killed,St0};
- {y,_} ->
- %% Conservatively mark it as used.
- {used,St0}
- end;
+check_liveness(R, [{put_map,F,Op,S,D,Live,{list,Puts}}|Is], St) ->
+ Set = {set,[D],[S|Puts],{alloc,Live,{put_map,Op,F}}},
+ check_liveness(R, [{block,[Set]}||Is], St);
check_liveness(R, [{test_heap,N,Live}|Is], St) ->
I = {block,[{set,[],[],{alloc,Live,{nozero,nostack,N,[]}}}]},
check_liveness(R, [I|Is], St);
@@ -507,16 +522,24 @@ check_liveness(R, [{get_list,S,D1,D2}|Is], St) ->
check_liveness(_R, Is, St) when is_list(Is) ->
%% Not implemented. Conservatively assume that the register is used.
{used,St}.
-
-check_liveness_everywhere(R, [{f,Lbl}|T], St0) ->
- case check_liveness_at(R, Lbl, St0) of
- {killed,St} -> check_liveness_everywhere(R, T, St);
- {_,_}=Other -> Other
+
+check_liveness_everywhere(R, Lbls, St0) ->
+ check_liveness_everywhere_1(R, Lbls, killed, St0).
+
+check_liveness_everywhere_1(R, [{f,Lbl}|T], Res0, St0) ->
+ {Res1,St} = check_liveness_at(R, Lbl, St0),
+ Res = case Res1 of
+ killed -> Res0;
+ _ -> Res1
+ end,
+ case Res of
+ used -> {used,St};
+ _ -> check_liveness_everywhere_1(R, T, Res, St)
end;
-check_liveness_everywhere(R, [_|T], St) ->
- check_liveness_everywhere(R, T, St);
-check_liveness_everywhere(_, [], St) ->
- {killed,St}.
+check_liveness_everywhere_1(R, [_|T], Res, St) ->
+ check_liveness_everywhere_1(R, T, Res, St);
+check_liveness_everywhere_1(_, [], Res, St) ->
+ {Res,St}.
check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) ->
case gb_trees:lookup(Lbl, ResMemorized) of
@@ -530,56 +553,20 @@ check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) ->
{Res,St#live{res=gb_trees:insert(Lbl, Res, St#live.res)}}
end.
+not_used({killed,St}) -> {not_used,St};
+not_used({_,_}=Res) -> Res.
+
check_liveness_ret(R, R, St) -> {used,St};
check_liveness_ret(_, _, St) -> {killed,St}.
-check_liveness_fail(_, _, _, 0, St) ->
- {killed,St};
-check_liveness_fail(R, Op, Args, Fail, St) ->
- Arity = length(Args),
- case erl_internal:comp_op(Op, Arity) orelse
- erl_internal:new_type_test(Op, Arity) of
- true -> {killed,St};
- false -> check_liveness_at(R, Fail, St)
- end.
-
-%% check_killed_block(Reg, [Instruction], State) -> killed | transparent | used
-%% Finds out how Reg is used in the instruction sequence inside a block.
-%% Returns one of:
-%% killed - Reg is assigned a new value or killed by an allocation instruction
-%% transparent - Reg is neither used nor killed
-%% used - Reg is used or referenced by an allocation instruction.
-%%
-%% (Unknown instructions will cause an exception.)
-
-check_killed_block_fun() ->
- fun(R, Is, St) -> {check_killed_block(R, Is),St} end.
-
-check_killed_block({x,X}, [{set,_,_,{alloc,Live,_}}|_]) ->
- if
- X >= Live -> killed;
- true -> used
- end;
-check_killed_block(R, [{set,Ds,Ss,_Op}|Is]) ->
- case member(R, Ss) of
- true -> used;
- false ->
- case member(R, Ds) of
- true -> killed;
- false -> check_killed_block(R, Is)
- end
- end;
-check_killed_block(R, [{'%live',_,Regs}|Is]) ->
- case R of
- {x,X} when (Regs bsr X) band 1 =:= 0 -> killed;
- _ -> check_killed_block(R, Is)
- end;
-check_killed_block(_, []) -> transparent.
-
-%% check_used_block(Reg, [Instruction], State) -> killed | transparent | used
+%% check_liveness_block(Reg, [Instruction], State) ->
+%% {killed | not_used | used | transparent,State'}
%% Finds out how Reg is used in the instruction sequence inside a block.
%% Returns one of:
-%% killed - Reg is assigned a new value or killed by an allocation instruction
+%% killed - Reg is assigned a new value or killed by an
+%% allocation instruction
+%% not_used - The value is not used, but the register is referenced
+%% e.g. by an allocation instruction
%% transparent - Reg is neither used nor killed
%% used - Reg is explicitly used by an instruction
%%
@@ -587,45 +574,64 @@ check_killed_block(_, []) -> transparent.
%%
%% (Unknown instructions will cause an exception.)
-check_used_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St) ->
+check_liveness_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St0) ->
if
- X >= Live -> {killed,St};
- true -> check_used_block_1(R, Ss, Ds, Op, Is, St)
+ X >= Live ->
+ {killed,St0};
+ true ->
+ case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of
+ {killed,St} -> {not_used,St};
+ {transparent,St} -> {not_used,St};
+ {_,_}=Res -> Res
+ end
end;
-check_used_block(R, [{set,Ds,Ss,Op}|Is], St) ->
- check_used_block_1(R, Ss, Ds, Op, Is, St);
-check_used_block(_, [], St) -> {transparent,St}.
+check_liveness_block({y,_}=R, [{set,Ds,Ss,{alloc,_Live,Op}}|Is], St) ->
+ check_liveness_block_1(R, Ss, Ds, Op, Is, St);
+check_liveness_block(R, [{set,Ds,Ss,Op}|Is], St) ->
+ check_liveness_block_1(R, Ss, Ds, Op, Is, St);
+check_liveness_block(_, [], St) -> {transparent,St}.
-check_used_block_1(R, Ss, Ds, Op, Is, St0) ->
+check_liveness_block_1(R, Ss, Ds, Op, Is, St0) ->
case member(R, Ss) of
true ->
{used,St0};
false ->
- case is_reg_used_at(R, Op, St0) of
- {true,St} ->
- {used,St};
- {false,St} ->
+ case check_liveness_block_2(R, Op, Ss, St0) of
+ {killed,St} ->
case member(R, Ds) of
true -> {killed,St};
- false -> check_used_block(R, Is, St)
- end
+ false -> check_liveness_block(R, Is, St)
+ end;
+ {not_used,St} ->
+ not_used(case member(R, Ds) of
+ true -> {killed,St};
+ false -> check_liveness_block(R, Is, St)
+ end);
+ {used,St} ->
+ {used,St}
end
end.
-is_reg_used_at(R, {gc_bif,_,{f,Lbl}}, St) ->
- is_reg_used_at_1(R, Lbl, St);
-is_reg_used_at(R, {bif,_,{f,Lbl}}, St) ->
- is_reg_used_at_1(R, Lbl, St);
-is_reg_used_at(_, _, St) ->
- {false,St}.
+check_liveness_block_2(R, {gc_bif,_Op,{f,Lbl}}, _Ss, St) ->
+ check_liveness_block_3(R, Lbl, St);
+check_liveness_block_2(R, {bif,Op,{f,Lbl}}, Ss, St) ->
+ Arity = length(Ss),
+ case erl_internal:comp_op(Op, Arity) orelse
+ erl_internal:new_type_test(Op, Arity) of
+ true ->
+ {killed,St};
+ false ->
+ check_liveness_block_3(R, Lbl, St)
+ end;
+check_liveness_block_2(R, {put_map,_Op,{f,Lbl}}, _Ss, St) ->
+ check_liveness_block_3(R, Lbl, St);
+check_liveness_block_2(_, _, _, St) ->
+ {killed,St}.
-is_reg_used_at_1(_, 0, St) ->
- {false,St};
-is_reg_used_at_1(R, Lbl, St0) ->
- case check_liveness_at(R, Lbl, St0) of
- {killed,St} -> {false,St};
- {used,St} -> {true,St}
- end.
+check_liveness_block_3(_, 0, St) ->
+ {killed,St};
+check_liveness_block_3(R, Lbl, St0) ->
+ check_liveness_at(R, Lbl, St0).
index_labels_1([{label,Lbl}|Is0], Acc) ->
Is = drop_labels(Is0),
@@ -783,37 +789,48 @@ live_opt([{recv_mark,_}=I|Is], Regs, D, Acc) ->
live_opt([], _, _, Acc) -> Acc.
-live_opt_block([{set,Ds,Ss,Op}=I0|Is], Regs0, D, Acc) ->
+live_opt_block([{set,Ds,Ss,Op0}|Is], Regs0, D, Acc) ->
Regs1 = x_live(Ss, x_dead(Ds, Regs0)),
- {I,Regs} = case Op of
- {alloc,Live0,Alloc} ->
- %% The life-time analysis used by the code generator
- %% is sometimes too conservative, so it may be
- %% possible to lower the number of live registers
- %% based on the exact liveness information.
- %% The main benefit is that more optimizations that
- %% depend on liveness information (such as the
- %% beam_bool and beam_dead passes) may be applied.
- Live = live_regs(Regs1),
- true = Live =< Live0, %Assertion.
- I1 = {set,Ds,Ss,{alloc,Live,Alloc}},
- {I1,live_call(Live)};
- _ ->
- {I0,Regs1}
- end,
+ {Op, Regs} = live_opt_block_op(Op0, Regs1, D),
+ I = {set, Ds, Ss, Op},
+
case Ds of
- [{x,X}] ->
- case (not is_live(X, Regs0)) andalso Op =:= move of
- true ->
- live_opt_block(Is, Regs0, D, Acc);
- false ->
- live_opt_block(Is, Regs, D, [I|Acc])
- end;
- _ ->
- live_opt_block(Is, Regs, D, [I|Acc])
- end;
+ [{x,X}] ->
+ case (not is_live(X, Regs0)) andalso Op =:= move of
+ true ->
+ live_opt_block(Is, Regs0, D, Acc);
+ false ->
+ live_opt_block(Is, Regs, D, [I|Acc])
+ end;
+ _ ->
+ live_opt_block(Is, Regs, D, [I|Acc])
+ end;
+live_opt_block([{'%live',_,_}|Is], Regs, D, Acc) ->
+ live_opt_block(Is, Regs, D, Acc);
live_opt_block([], Regs, _, Acc) -> {Acc,Regs}.
+live_opt_block_op({alloc,Live0,AllocOp}, Regs0, D) ->
+ Regs =
+ case AllocOp of
+ {Kind, _N, Fail} when Kind =:= gc_bif; Kind =:= put_map ->
+ live_join_label(Fail, D, Regs0);
+ _ ->
+ Regs0
+ end,
+
+ %% The life-time analysis used by the code generator is sometimes too
+ %% conservative, so it may be possible to lower the number of live
+ %% registers based on the exact liveness information. The main benefit is
+ %% that more optimizations that depend on liveness information (such as the
+ %% beam_bool and beam_dead passes) may be applied.
+ Live = live_regs(Regs),
+ true = Live =< Live0,
+ {{alloc,Live,AllocOp}, live_call(Live)};
+live_opt_block_op({bif,_N,Fail} = Op, Regs, D) ->
+ {Op, live_join_label(Fail, D, Regs)};
+live_opt_block_op(Op, Regs, _D) ->
+ {Op, Regs}.
+
live_join_labels([{f,L}|T], D, Regs0) when L =/= 0 ->
Regs = gb_trees:get(L, D) bor Regs0,
live_join_labels(T, D, Regs);
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 16dba35adc..622e00bb2b 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -32,6 +32,10 @@
-import(lists, [reverse/1,foldl/3,foreach/2,dropwhile/2]).
%% To be called by the compiler.
+
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts)
when is_atom(Mod), is_list(Exp), is_list(Attr), is_integer(Lc) ->
case validate(Mod, Fs) of
@@ -619,17 +623,17 @@ valfun_4({test,bs_skip_utf16,{f,Fail},[Ctx,Live,_]}, Vst) ->
valfun_4({test,bs_skip_utf32,{f,Fail},[Ctx,Live,_]}, Vst) ->
validate_bs_skip_utf(Fail, Ctx, Live, Vst);
valfun_4({test,bs_get_integer2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, Dst, Vst);
+ validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst);
valfun_4({test,bs_get_float2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, Dst, Vst);
+ validate_bs_get(Fail, Ctx, Live, {float, []}, Dst, Vst);
valfun_4({test,bs_get_binary2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, Dst, Vst);
+ validate_bs_get(Fail, Ctx, Live, term, Dst, Vst);
valfun_4({test,bs_get_utf8,{f,Fail},Live,[Ctx,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, Dst, Vst);
+ validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst);
valfun_4({test,bs_get_utf16,{f,Fail},Live,[Ctx,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, Dst, Vst);
+ validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst);
valfun_4({test,bs_get_utf32,{f,Fail},Live,[Ctx,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, Dst, Vst);
+ validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst);
valfun_4({bs_save2,Ctx,SavePoint}, Vst) ->
bsm_save(Ctx, SavePoint, Vst);
valfun_4({bs_restore2,Ctx,SavePoint}, Vst) ->
@@ -649,6 +653,9 @@ valfun_4({test,is_nonempty_list,{f,Lbl},[Cons]}, Vst) ->
valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) ->
assert_type(tuple, Tuple, Vst),
set_type_reg({tuple,Sz}, Tuple, branch_state(Lbl, Vst));
+valfun_4({test,is_tagged_tuple,{f,Lbl},[Src,Sz,_Atom]}, Vst) ->
+ validate_src([Src], Vst),
+ set_type_reg({tuple, Sz}, Src, branch_state(Lbl, Vst));
valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) ->
assert_type(map, Src, Vst),
assert_unique_map_keys(List),
@@ -787,12 +794,12 @@ verify_put_map(Fail, Src, Dst, Live, List, Vst0) ->
%%
%% Common code for validating bs_get* instructions.
%%
-validate_bs_get(Fail, Ctx, Live, Dst, Vst0) ->
+validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst0) ->
bsm_validate_context(Ctx, Vst0),
verify_live(Live, Vst0),
Vst1 = prune_x_regs(Live, Vst0),
Vst = branch_state(Fail, Vst1),
- set_type_reg(term, Dst, Vst).
+ set_type_reg(Type, Dst, Vst).
%%
%% Common code for validating bs_skip_utf* instructions.
@@ -909,7 +916,7 @@ all_ms_in_x_regs(Live0, Vst) ->
ms_in_y_regs(Id, #vst{current=#st{y=Ys0}}) ->
Ys = gb_trees:to_list(Ys0),
- [Y || {Y,#ms{id=OtherId}} <- Ys, OtherId =:= Id].
+ [{y,Y} || {Y,#ms{id=OtherId}} <- Ys, OtherId =:= Id].
verify_call_match_context(Lbl, Ctx, #vst{ft=Ft}) ->
case gb_trees:lookup(Lbl, Ft) of
@@ -921,9 +928,9 @@ verify_call_match_context(Lbl, Ctx, #vst{ft=Ft}) ->
error({unsuitable_bs_start_match2,I})
end.
-allocate(Zero, Stk, Heap, Live, #vst{current=#st{numy=none}=St}=Vst0) ->
+allocate(Zero, Stk, Heap, Live, #vst{current=#st{numy=none}}=Vst0) ->
verify_live(Live, Vst0),
- Vst = prune_x_regs(Live, Vst0),
+ Vst = #vst{current=St} = prune_x_regs(Live, Vst0),
Ys = init_regs(Stk, case Zero of
true -> initialized;
false -> uninitialized
@@ -1508,7 +1515,9 @@ bif_type(abs, [Num], Vst) ->
bif_type(float, _, _) -> {float,[]};
bif_type('/', _, _) -> {float,[]};
%% Integer operations.
+bif_type(ceil, [_], _) -> {integer,[]};
bif_type('div', [_,_], _) -> {integer,[]};
+bif_type(floor, [_], _) -> {integer,[]};
bif_type('rem', [_,_], _) -> {integer,[]};
bif_type(length, [_], _) -> {integer,[]};
bif_type(size, [_], _) -> {integer,[]};
@@ -1642,6 +1651,9 @@ 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(ceil, 1) -> {float,[]};
+return_type_math(floor, 1) -> {float,[]};
+return_type_math(fmod, 2) -> {float,[]};
return_type_math(pi, 0) -> {float,[]};
return_type_math(F, A) when is_atom(F), is_integer(A), A >= 0 -> term.
diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl
index 6c7f8543c2..787e33c142 100644
--- a/lib/compiler/src/beam_z.erl
+++ b/lib/compiler/src/beam_z.erl
@@ -26,6 +26,9 @@
-import(lists, [dropwhile/2]).
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_asm:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
Fs = [function(F) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index 61abae344c..6b936a7687 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -1,8 +1,3 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
-%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -15,9 +10,8 @@
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
-%% %CopyrightEnd%
-
-%% =====================================================================
+%% @copyright 1999-2002 Richard Carlsson
+%% @author Richard Carlsson <[email protected]>
%% @doc Core Erlang abstract syntax trees.
%%
%% <p> This module defines an abstract data type for representing Core
@@ -1590,6 +1584,8 @@ ann_make_list(_, [], Node) ->
%% @doc Returns <code>true</code> if <code>Node</code> is an abstract
%% map constructor, otherwise <code>false</code>.
+-type map_op() :: #c_literal{val::'assoc'} | #c_literal{val::'exact'}.
+
-spec is_c_map(cerl()) -> boolean().
is_c_map(#c_map{}) ->
@@ -1685,8 +1681,16 @@ update_c_map(#c_map{is_pat=true}=Old, M, Es) ->
update_c_map(#c_map{is_pat=false}=Old, M, Es) ->
ann_c_map(get_ann(Old), M, Es).
+-spec map_pair_key(c_map_pair()) -> cerl().
+
map_pair_key(#c_map_pair{key=K}) -> K.
+
+-spec map_pair_val(c_map_pair()) -> cerl().
+
map_pair_val(#c_map_pair{val=V}) -> V.
+
+-spec map_pair_op(c_map_pair()) -> map_op().
+
map_pair_op(#c_map_pair{op=Op}) -> Op.
-spec c_map_pair(cerl(), cerl()) -> c_map_pair().
@@ -1705,6 +1709,8 @@ c_map_pair_exact(Key,Val) ->
ann_c_map_pair(As,Op,K,V) ->
#c_map_pair{op=Op, key = K, val=V, anno = As}.
+-spec update_c_map_pair(c_map_pair(), map_op(), cerl(), cerl()) -> c_map_pair().
+
update_c_map_pair(Old,Op,K,V) ->
#c_map_pair{op=Op, key=K, val=V, anno = get_ann(Old)}.
diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl
index 805095e30c..7d6518c3c6 100644
--- a/lib/compiler/src/cerl_clauses.erl
+++ b/lib/compiler/src/cerl_clauses.erl
@@ -1,8 +1,3 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
-%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -15,8 +10,8 @@
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
-%% %CopyrightEnd%
-
+%% @copyright 1999-2002 Richard Carlsson
+%% @author Richard Carlsson <[email protected]>
%% @doc Utility functions for Core Erlang case/receive clauses.
%%
%% <p>Syntax trees are defined in the module <a
diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl
index 2a8cf2e758..f5afa75b16 100644
--- a/lib/compiler/src/cerl_inline.erl
+++ b/lib/compiler/src/cerl_inline.erl
@@ -1,8 +1,3 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
-%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -15,9 +10,9 @@
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
-%% %CopyrightEnd%
-%%
-%% Core Erlang inliner.
+%% @copyright 1999-2002 Richard Carlsson
+%% @author Richard Carlsson <[email protected]>
+%% @doc Core Erlang inliner.
%% =====================================================================
%%
diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl
index b3decbec1f..f30a0b33ac 100644
--- a/lib/compiler/src/cerl_trees.erl
+++ b/lib/compiler/src/cerl_trees.erl
@@ -1,8 +1,3 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
-%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -15,8 +10,8 @@
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
-%% %CopyrightEnd%
-
+%% @copyright 1999-2002 Richard Carlsson.
+%% @author Richard Carlsson <[email protected]>
%% @doc Basic functions on Core Erlang abstract syntax trees.
%%
%% <p>Syntax trees are defined in the module <a
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index e37ca31704..aa2d224bb4 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -147,8 +147,8 @@ env_compiler_options() -> env_default_opts().
%% Local functions
%%
--define(pass(P), {P,fun P/1}).
--define(pass(P,T), {P,fun T/1,fun P/1}).
+-define(pass(P), {P,fun P/2}).
+-define(pass(P,T), {P,fun T/1,fun P/2}).
env_default_opts() ->
Key = "ERL_COMPILER_OPTIONS",
@@ -198,9 +198,9 @@ expand_opts(Opts0) ->
%% {debug_info_key,Key} implies debug_info.
Opts = case {proplists:get_value(debug_info_key, Opts0),
proplists:get_value(encrypt_debug_info, Opts0),
- proplists:get_bool(debug_info, Opts0)} of
+ proplists:get_value(debug_info, Opts0)} of
{undefined,undefined,_} -> Opts0;
- {_,_,false} -> [debug_info|Opts0];
+ {_,_,undefined} -> [debug_info|Opts0];
{_,_,_} -> Opts0
end,
foldr(fun expand_opt/2, [], Opts).
@@ -213,12 +213,14 @@ expand_opt(report, Os) ->
[report_errors,report_warnings|Os];
expand_opt(return, Os) ->
[return_errors,return_warnings|Os];
-expand_opt(r12, Os) ->
- [no_recv_opt,no_line_info|Os];
-expand_opt(r13, Os) ->
- [no_recv_opt,no_line_info|Os];
-expand_opt(r14, Os) ->
- [no_line_info|Os];
+expand_opt(r16, Os) ->
+ [no_record_opt,no_utf8_atoms|Os];
+expand_opt(r17, Os) ->
+ [no_record_opt,no_utf8_atoms|Os];
+expand_opt(r18, Os) ->
+ [no_record_opt,no_utf8_atoms|Os];
+expand_opt(r19, Os) ->
+ [no_record_opt,no_utf8_atoms|Os];
expand_opt({debug_info_key,_}=O, Os) ->
[encrypt_debug_info,O|Os];
expand_opt(no_float_opt, Os) ->
@@ -228,6 +230,8 @@ expand_opt(O, Os) -> [O|Os].
%% format_error(ErrorDescriptor) -> string()
+-spec format_error(term()) -> iolist().
+
format_error(no_native_support) ->
"this system is not configured for native-code compilation.";
format_error(no_crypto) ->
@@ -260,9 +264,9 @@ format_error({delete_temp,File,Error}) ->
io_lib:format("failed to delete temporary file ~ts: ~ts",
[File,file:format_error(Error)]);
format_error({parse_transform,M,R}) ->
- io_lib:format("error in parse transform '~s': ~tp", [M, R]);
+ io_lib:format("error in parse transform '~ts': ~tp", [M, R]);
format_error({undef_parse_transform,M}) ->
- io_lib:format("undefined parse transform '~s'", [M]);
+ io_lib:format("undefined parse transform '~ts'", [M]);
format_error({core_transform,M,R}) ->
io_lib:format("error in core transform '~s': ~tp", [M, R]);
format_error({crash,Pass,Reason}) ->
@@ -288,34 +292,41 @@ format_error_reason({Reason, Stack}) when is_list(Stack) ->
format_error_reason(Reason) ->
io_lib:format("~tp", [Reason]).
+-type err_warn_info() :: tuple().
+
%% The compile state record.
-record(compile, {filename="" :: file:filename(),
dir="" :: file:filename(),
base="" :: file:filename(),
ifile="" :: file:filename(),
ofile="" :: file:filename(),
- module=[],
- code=[],
- core_code=[],
- abstract_code=[], %Abstract code for debugger.
- options=[] :: [option()], %Options for compilation
+ module=[] :: module() | [],
+ core_code=[] :: cerl:c_module() | [],
+ abstract_code=[] :: abstract_code(), %Abstract code for debugger.
+ options=[] :: [option()], %Options for compilation
mod_options=[] :: [option()], %Options for module_info
encoding=none :: none | epp:source_encoding(),
- errors=[],
- warnings=[]}).
+ errors=[] :: [err_warn_info()],
+ warnings=[] :: [err_warn_info()],
+ extra_chunks=[] :: [{binary(), binary()}]}).
internal({forms,Forms}, Opts0) ->
{_,Ps} = passes(forms, Opts0),
Source = proplists:get_value(source, Opts0, ""),
Opts1 = proplists:delete(source, Opts0),
- Compile = #compile{code=Forms,options=Opts1,mod_options=Opts1},
- internal_comp(Ps, Source, "", Compile);
+ Compile = build_compile(Opts1),
+ internal_comp(Ps, Forms, Source, "", Compile);
internal({file,File}, Opts) ->
{Ext,Ps} = passes(file, Opts),
- Compile = #compile{options=Opts,mod_options=Opts},
- internal_comp(Ps, File, Ext, Compile).
+ Compile = build_compile(Opts),
+ internal_comp(Ps, none, File, Ext, Compile).
-internal_comp(Passes, File, Suffix, St0) ->
+build_compile(Opts0) ->
+ ExtraChunks = proplists:get_value(extra_chunks, Opts0, []),
+ Opts1 = proplists:delete(extra_chunks, Opts0),
+ #compile{options=Opts1,mod_options=Opts1,extra_chunks=ExtraChunks}.
+
+internal_comp(Passes, Code0, File, Suffix, St0) ->
Dir = filename:dirname(File),
Base = filename:basename(File, Suffix),
St1 = St0#compile{filename=File, dir=Dir, base=Base,
@@ -325,36 +336,41 @@ internal_comp(Passes, File, Suffix, St0) ->
Run0 = case member(time, Opts) of
true ->
io:format("Compiling ~tp\n", [File]),
- fun run_tc/2;
- false -> fun({_Name,Fun}, St) -> catch Fun(St) end
+ fun run_tc/3;
+ false ->
+ fun({_Name,Fun}, Code, St) ->
+ catch Fun(Code, St)
+ end
end,
Run = case keyfind(eprof, 1, Opts) of
{eprof,EprofPass} ->
- fun(P, St) ->
- run_eprof(P, EprofPass, St)
+ fun(P, Code, St) ->
+ run_eprof(P, Code, EprofPass, St)
end;
false ->
Run0
end,
- case fold_comp(Passes, Run, St1) of
- {ok,St2} -> comp_ret_ok(St2);
+ case fold_comp(Passes, Run, Code0, St1) of
+ {ok,Code,St2} -> comp_ret_ok(Code, St2);
{error,St2} -> comp_ret_err(St2)
end.
-fold_comp([{delay,Ps0}|Passes], Run, #compile{options=Opts}=St) ->
+fold_comp([{delay,Ps0}|Passes], Run, Code, #compile{options=Opts}=St) ->
Ps = select_passes(Ps0, Opts) ++ Passes,
- fold_comp(Ps, Run, St);
-fold_comp([{Name,Test,Pass}|Ps], Run, St) ->
+ fold_comp(Ps, Run, Code, St);
+fold_comp([{Name,Test,Pass}|Ps], Run, Code, St) ->
case Test(St) of
false -> %Pass is not needed.
- fold_comp(Ps, Run, St);
+ fold_comp(Ps, Run, Code, St);
true -> %Run pass in the usual way.
- fold_comp([{Name,Pass}|Ps], Run, St)
+ fold_comp([{Name,Pass}|Ps], Run, Code, 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 -> Error;
+fold_comp([{Name,Pass}|Ps], Run, Code0, St0) ->
+ case Run({Name,Pass}, Code0, St0) of
+ {ok,Code,St1} ->
+ fold_comp(Ps, Run, Code, St1);
+ {error,_St1}=Error ->
+ Error;
{'EXIT',Reason} ->
Es = [{St0#compile.ifile,[{none,?MODULE,{crash,Name,Reason}}]}],
{error,St0#compile{errors=St0#compile.errors ++ Es}};
@@ -362,30 +378,30 @@ fold_comp([{Name,Pass}|Ps], Run, St0) ->
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}.
+fold_comp([], _Run, Code, St) -> {ok,Code,St}.
-run_tc({Name,Fun}, St) ->
+run_tc({Name,Fun}, Code, St) ->
T1 = erlang:monotonic_time(),
- Val = (catch Fun(St)),
+ Val = (catch Fun(Code, St)),
T2 = erlang:monotonic_time(),
- Elapsed = erlang:convert_time_unit(T2 - T1, native, milli_seconds),
+ Elapsed = erlang:convert_time_unit(T2 - T1, native, millisecond),
Mem0 = erts_debug:flat_size(Val)*erlang:system_info(wordsize),
Mem = lists:flatten(io_lib:format("~.1f kB", [Mem0/1024])),
io:format(" ~-30s: ~10.3f s ~12s\n",
[Name,Elapsed/1000,Mem]),
Val.
-run_eprof({Name,Fun}, Name, St) ->
+run_eprof({Name,Fun}, Code, Name, St) ->
io:format("~p: Running eprof\n", [Name]),
c:appcall(tools, eprof, start_profiling, [[self()]]),
- Val = (catch Fun(St)),
+ Val = (catch Fun(Code, St)),
c:appcall(tools, eprof, stop_profiling, []),
c:appcall(tools, eprof, analyze, []),
Val;
-run_eprof({_,Fun}, _, St) ->
- catch Fun(St).
+run_eprof({_,Fun}, Code, _, St) ->
+ catch Fun(Code, St).
-comp_ret_ok(#compile{code=Code,warnings=Warn0,module=Mod,options=Opts}=St) ->
+comp_ret_ok(Code, #compile{warnings=Warn0,module=Mod,options=Opts}=St) ->
case werror(St) of
true ->
case member(report_warnings, Opts) of
@@ -451,8 +467,10 @@ mpf(Ms) ->
passes(Type, Opts) ->
{Ext,Passes0} = passes_1(Opts),
Passes1 = case Type of
- file -> Passes0;
- forms -> tl(Passes0)
+ file ->
+ Passes0;
+ forms ->
+ fix_first_pass(Passes0)
end,
Passes = select_passes(Passes1, Opts),
@@ -489,6 +507,22 @@ pass(from_beam) ->
{".beam",[?pass(read_beam_file)|binary_passes()]};
pass(_) -> none.
+%% For compilation from forms, replace the first pass with a pass
+%% that retrieves the module name. The module name is needed for
+%% proper diagnostics and for compilation to native code.
+
+fix_first_pass([{parse_core,_}|Passes]) ->
+ [?pass(get_module_name_from_core)|Passes];
+fix_first_pass([{beam_consult_asm,_}|Passes]) ->
+ [?pass(get_module_name_from_asm)|Passes];
+fix_first_pass([{read_beam_file,_}|Passes]) ->
+ [?pass(get_module_name_from_beam)|Passes];
+fix_first_pass([_|Passes]) ->
+ %% When compiling from abstract code, the module name
+ %% will be set after running the v3_core pass.
+ Passes.
+
+
%% select_passes([Command], Opts) -> [{Name,Function}]
%% Interpret the lists of commands to return a pure list of passes.
%%
@@ -540,21 +574,21 @@ pass(_) -> none.
%%
select_passes([{pass,Mod}|Ps], Opts) ->
- F = fun(St) ->
- case catch Mod:module(St#compile.code, St#compile.options) of
+ F = fun(Code0, St) ->
+ case catch Mod:module(Code0, St#compile.options) of
{ok,Code} ->
- {ok,St#compile{code=Code}};
+ {ok,Code,St};
{ok,Code,Ws} ->
- {ok,St#compile{code=Code,warnings=St#compile.warnings++Ws}};
+ {ok,Code,St#compile{warnings=St#compile.warnings++Ws}};
{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}];
+ [{listing,fun (Code, St) -> src_listing(Ext, Code, St) end}];
select_passes([{listing,Ext}|_], _Opts) ->
- [{listing,fun (St) -> listing(Ext, St) end}];
+ [{listing,fun (Code, St) -> listing(Ext, Code, St) end}];
select_passes([done|_], _Opts) ->
[];
select_passes([{done,Ext}|_], Opts) ->
@@ -654,13 +688,13 @@ standard_passes() ->
{iff,'dabstr',{listing,"abstr"}},
{iff,debug_info,?pass(save_abstract_code)},
- ?pass(expand_module),
+ ?pass(expand_records),
{iff,'dexp',{listing,"expand"}},
{iff,'E',{src_listing,"E"}},
{iff,'to_exp',{done,"E"}},
%% Conversion to Core Erlang.
- {pass,v3_core},
+ ?pass(core),
{iff,'dcore',{listing,"core"}},
{iff,'to_core0',{done,"core"}}
| core_passes()].
@@ -670,22 +704,24 @@ core_passes() ->
[{iff,clint0,?pass(core_lint_module)},
{delay,
[{unless,no_copt,
- [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/1},
+ [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/2},
{iff,doldinline,{listing,"oldinline"}},
{pass,sys_core_fold},
{iff,dcorefold,{listing,"corefold"}},
- {core_inline_module,fun test_core_inliner/1,fun core_inline_module/1},
+ {core_inline_module,fun test_core_inliner/1,fun core_inline_module/2},
{iff,dinline,{listing,"inline"}},
{core_fold_after_inlining,fun test_any_inliner/1,
- fun core_fold_module_after_inlining/1},
+ fun core_fold_module_after_inlining/2},
?pass(core_transforms)]},
{iff,dcopt,{listing,"copt"}},
{iff,'to_core',{done,"core"}}]}
| kernel_passes()].
kernel_passes() ->
- %% Destructive setelement/3 optimization and core lint.
- [{pass,sys_core_dsetel},
+ %% Optimizations that must be done after all other optimizations.
+ [{pass,sys_core_bsm},
+ {iff,dcbsm,{listing,"core_bsm"}},
+ {pass,sys_core_dsetel},
{iff,dsetel,{listing,"dsetel"}},
{iff,clint,?pass(core_lint_module)},
@@ -715,8 +751,6 @@ asm_passes() ->
{iff,dexcept,{listing,"except"}},
{unless,no_bs_opt,{pass,beam_bs}},
{iff,dbs,{listing,"bs"}},
- {unless,no_bopt,{pass,beam_bool}},
- {iff,dbool,{listing,"bool"}},
{unless,no_topt,{pass,beam_type}},
{iff,dtype,{listing,"type"}},
{pass,beam_split},
@@ -733,6 +767,8 @@ asm_passes() ->
{iff,dbsm,{listing,"bsm"}},
{unless,no_recv_opt,{pass,beam_receive}},
{iff,drecv,{listing,"recv"}},
+ {unless,no_record_opt,{pass,beam_record}},
+ {iff,drecord,{listing,"record"}},
{unless,no_stack_trimming,{pass,beam_trim}},
{iff,dtrim,{listing,"trim"}},
{pass,beam_flatten}]},
@@ -751,7 +787,7 @@ asm_passes() ->
| binary_passes()].
binary_passes() ->
- [{native_compile,fun test_native/1,fun native_compile/1},
+ [{native_compile,fun test_native/1,fun native_compile/2},
{unless,binary,?pass(save_binary,not_werror)}].
%%%
@@ -759,9 +795,9 @@ binary_passes() ->
%%%
%% Remove the target file so we don't have an old one if the compilation fail.
-remove_file(St) ->
+remove_file(Code, St) ->
_ = file:delete(St#compile.ofile),
- {ok,St}.
+ {ok,Code,St}.
-record(asm_module, {module,
exports,
@@ -809,34 +845,50 @@ collect_asm([{attributes, Attr} | Rest], R) ->
collect_asm([X | Rest], R) ->
collect_asm(Rest, R#asm_module{code=R#asm_module.code++[X]}).
-beam_consult_asm(St) ->
+beam_consult_asm(_Code, St) ->
case file:consult(St#compile.ifile) of
- {ok, Forms0} ->
+ {ok,Forms0} ->
Encoding = epp:read_encoding(St#compile.ifile),
- {Module, Forms} = preprocess_asm_forms(Forms0),
- {ok,St#compile{module=Module, code=Forms, encoding=Encoding}};
+ {Module,Forms} = preprocess_asm_forms(Forms0),
+ {ok,Forms,St#compile{module=Module,encoding=Encoding}};
{error,E} ->
Es = [{St#compile.ifile,[{none,?MODULE,{open,E}}]}],
{error,St#compile{errors=St#compile.errors ++ Es}}
end.
-read_beam_file(St) ->
+get_module_name_from_asm({Mod,_,_,_,_}=Asm, St) ->
+ {ok,Asm,St#compile{module=Mod}};
+get_module_name_from_asm(Asm, St) ->
+ %% Invalid Beam assembly code. Let it crash in a later pass.
+ {ok,Asm,St}.
+
+read_beam_file(_Code, St) ->
case file:read_file(St#compile.ifile) of
{ok,Beam} ->
Infile = St#compile.ifile,
case no_native_compilation(Infile, St) of
true ->
- {ok,St#compile{module=none,code=none}};
+ {ok,none,St#compile{module=none}};
false ->
Mod0 = filename:rootname(filename:basename(Infile)),
Mod = list_to_atom(Mod0),
- {ok,St#compile{module=Mod,code=Beam,ofile=Infile}}
+ {ok,Beam,St#compile{module=Mod,ofile=Infile}}
end;
{error,E} ->
Es = [{St#compile.ifile,[{none,?MODULE,{open,E}}]}],
{error,St#compile{errors=St#compile.errors ++ Es}}
end.
+get_module_name_from_beam(Beam, St) ->
+ case beam_lib:info(Beam) of
+ {error,beam_lib,Error} ->
+ Es = [{"((forms))",[{none,beam_lib,Error}]}],
+ {error,St#compile{errors=St#compile.errors ++ Es}};
+ Info ->
+ {module,Mod} = keyfind(module, 1, Info),
+ {ok,Beam,St#compile{module=Mod}}
+ end.
+
no_native_compilation(BeamFile, #compile{options=Opts0}) ->
case beam_lib:chunks(BeamFile, ["CInf"]) of
{ok,{_,[{"CInf",Term0}]}} ->
@@ -849,17 +901,17 @@ no_native_compilation(BeamFile, #compile{options=Opts0}) ->
_ -> false
end.
-parse_module(St0) ->
+parse_module(_Code, St0) ->
case do_parse_module(utf8, St0) of
- {ok,_}=Ret ->
+ {ok,_,_}=Ret ->
Ret;
{error,_}=Ret ->
Ret;
{invalid_unicode,File,Line} ->
case do_parse_module(latin1, St0) of
- {ok,St} ->
+ {ok,Code,St} ->
Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}],
- {ok,St#compile{warnings=Es++St#compile.warnings}};
+ {ok,Code,St#compile{warnings=Es++St#compile.warnings}};
{error,St} ->
Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}],
{error,St#compile{errors=Es++St#compile.errors}}
@@ -877,13 +929,13 @@ do_parse_module(DefEncoding, #compile{ifile=File,options=Opts,dir=Dir}=St) ->
Encoding = proplists:get_value(encoding, Extra),
case find_invalid_unicode(Forms, File) of
none ->
- {ok,St#compile{code=Forms,encoding=Encoding}};
+ {ok,Forms,St#compile{encoding=Encoding}};
{invalid_unicode,_,_}=Ret ->
case Encoding of
none ->
Ret;
_ ->
- {ok,St#compile{code=Forms,encoding=Encoding}}
+ {ok,Forms,St#compile{encoding=Encoding}}
end
end;
{error,E} ->
@@ -902,7 +954,7 @@ find_invalid_unicode([H|T], File0) ->
end;
find_invalid_unicode([], _) -> none.
-parse_core(St) ->
+parse_core(_Code, St) ->
case file:read_file(St#compile.ifile) of
{ok,Bin} ->
case core_scan:string(binary_to_list(Bin)) of
@@ -910,7 +962,7 @@ parse_core(St) ->
case core_parse:parse(Toks) of
{ok,Mod} ->
Name = (Mod#c_module.name)#c_literal.val,
- {ok,St#compile{module=Name,code=Mod}};
+ {ok,Mod,St#compile{module=Name}};
{error,E} ->
Es = [{St#compile.ifile,[E]}],
{error,St#compile{errors=St#compile.errors ++ Es}}
@@ -924,6 +976,16 @@ parse_core(St) ->
{error,St#compile{errors=St#compile.errors ++ Es}}
end.
+get_module_name_from_core(Core, St) ->
+ try
+ Mod = cerl:concrete(cerl:module_name(Core)),
+ {ok,Core,St#compile{module=Mod}}
+ catch
+ _:_ ->
+ %% Invalid Core Erlang code. Let it crash in a later pass.
+ {ok,Core,St}
+ end.
+
compile_options([{attribute,_L,compile,C}|Fs]) when is_list(C) ->
C ++ compile_options(Fs);
compile_options([{attribute,_L,compile,C}|Fs]) ->
@@ -947,31 +1009,36 @@ clean_parse_transforms_1([], Acc) -> reverse(Acc).
transforms(Os) -> [ M || {parse_transform,M} <- Os ].
-transform_module(#compile{options=Opt,code=Code0}=St0) ->
+transform_module(Code0, #compile{options=Opt}=St) ->
%% Extract compile options from code into options field.
case transforms(Opt ++ compile_options(Code0)) of
- [] -> {ok,St0}; %No parse transforms.
+ [] ->
+ %% No parse transforms.
+ {ok,Code0,St};
Ts ->
%% Remove parse_transform attributes from the abstract code to
%% prevent parse transforms to be run more than once.
Code = clean_parse_transforms(Code0),
- St = St0#compile{code=Code},
- foldl_transform(St, Ts)
+ foldl_transform(Ts, Code, St)
end.
-foldl_transform(St, [T|Ts]) ->
+foldl_transform([T|Ts], Code0, St) ->
Name = "transform " ++ atom_to_list(T),
case code:ensure_loaded(T) =:= {module,T} andalso
- erlang:function_exported(T, parse_transform, 2) of
+ erlang:function_exported(T, parse_transform, 2) of
true ->
- Fun = fun(S) ->
- T:parse_transform(S#compile.code, S#compile.options)
+ Fun = fun(Code, S) ->
+ T:parse_transform(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
+ true ->
+ fun run_tc/3;
+ false ->
+ fun({_Name,F}, Code, S) ->
+ catch F(Code, S)
+ end
end,
- case Run({Name, Fun}, St) of
+ case Run({Name, Fun}, Code0, St) of
{error,Es,Ws} ->
{error,St#compile{warnings=St#compile.warnings ++ Ws,
errors=St#compile.errors ++ Es}};
@@ -980,41 +1047,44 @@ foldl_transform(St, [T|Ts]) ->
{parse_transform,T,R}}]}],
{error,St#compile{errors=St#compile.errors ++ Es}};
{warning, Forms, Ws} ->
- foldl_transform(
- St#compile{code=Forms,
- warnings=St#compile.warnings ++ Ws}, Ts);
+ foldl_transform(Ts, Forms,
+ St#compile{warnings=St#compile.warnings ++ Ws});
Forms ->
- foldl_transform(St#compile{code=Forms}, Ts)
+ foldl_transform(Ts, Forms, St)
end;
false ->
Es = [{St#compile.ifile,[{none,compile,
{undef_parse_transform,T}}]}],
{error,St#compile{errors=St#compile.errors ++ Es}}
end;
-foldl_transform(St, []) -> {ok,St}.
+foldl_transform([], Code, St) -> {ok,Code,St}.
get_core_transforms(Opts) -> [M || {core_transform,M} <- Opts].
-core_transforms(St) ->
+core_transforms(Code, 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(Ts, Code, St).
-foldl_core_transforms(St, [T|Ts]) ->
+foldl_core_transforms([T|Ts], Code0, St) ->
Name = "core transform " ++ atom_to_list(T),
- Fun = fun(S) -> T:core_transform(S#compile.code, S#compile.options) end,
+ Fun = fun(Code, S) -> T:core_transform(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
+ true ->
+ fun run_tc/3;
+ false ->
+ fun({_Name,F}, Code, S) ->
+ catch F(Code, S)
+ end
end,
- case Run({Name, Fun}, St) of
+ case Run({Name, Fun}, Code0, 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)
+ foldl_core_transforms(Ts, Forms, St)
end;
-foldl_core_transforms(St, []) -> {ok,St}.
+foldl_core_transforms([], Code, St) -> {ok,Code,St}.
%%% Fetches the module name from a list of forms. The module attribute must
%%% be present.
@@ -1035,31 +1105,28 @@ add_default_base(St, Forms) ->
St
end.
-lint_module(St) ->
- case erl_lint:module(St#compile.code,
- St#compile.ifile, St#compile.options) of
+lint_module(Code, St) ->
+ case erl_lint:module(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}};
+ St1 = add_default_base(St, Code),
+ {ok,Code,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
+core_lint_module(Code, St) ->
+ case core_lint:module(Code, St#compile.options) of
{ok,Ws} ->
- {ok,St#compile{warnings=St#compile.warnings ++ Ws}};
+ {ok,Code,St#compile{warnings=St#compile.warnings ++ Ws}};
{error,Es,Ws} ->
{error,St#compile{warnings=St#compile.warnings ++ Ws,
errors=St#compile.errors ++ Es}}
end.
-makedep(#compile{code=Code,options=Opts}=St) ->
- Ifile = St#compile.ifile,
- Ofile = St#compile.ofile,
+makedep(Code0, #compile{ifile=Ifile,ofile=Ofile,options=Opts}=St) ->
%% Get the target of the Makefile rule.
Target0 =
@@ -1091,7 +1158,7 @@ makedep(#compile{code=Code,options=Opts}=St) ->
%% List the dependencies (includes) for this target.
{MainRule,PhonyRules} = makedep_add_headers(
Ifile, % The input file name.
- Code, % The parsed source.
+ Code0, % The parsed source.
[], % The list of dependencies already added.
length(Target), % The current line length.
Target, % The target.
@@ -1111,7 +1178,8 @@ makedep(#compile{code=Code,options=Opts}=St) ->
true -> MainRule ++ PhonyRules;
_ -> MainRule
end,
- {ok,St#compile{code=iolist_to_binary([Makefile,"\n"])}}.
+ Code = iolist_to_binary([Makefile,"\n"]),
+ {ok,Code,St}.
makedep_add_headers(Ifile, [{attribute,_,file,{File,_}}|Rest],
Included, LineLen, MainTarget, Phony, Opts) ->
@@ -1176,7 +1244,7 @@ makedep_add_header(Ifile, Included, LineLen, MainTarget, Phony, File) ->
end
end.
-makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) ->
+makedep_output(Code, #compile{options=Opts,ofile=Ofile}=St) ->
%% Write this Makefile (Code) to the selected output.
%% If no output is specified, the default is to write to a file named after
%% the output file.
@@ -1218,7 +1286,7 @@ makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) ->
CloseOutput -> ok = file:close(Output1);
true -> ok
end,
- {ok,St}
+ {ok,Code,St}
catch
error:_ ->
%% Couldn't write to output Makefile.
@@ -1235,29 +1303,33 @@ makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) ->
{error,St#compile{errors=St#compile.errors++[Err]}}
end.
-%% expand_module(State) -> State'
-%% Do the common preprocessing of the input forms.
+expand_records(Code0, #compile{options=Opts}=St) ->
+ Code = erl_expand_records:module(Code0, Opts),
+ {ok,Code,St}.
-expand_module(#compile{code=Code,options=Opts0}=St0) ->
- {Mod,Exp,Forms,Opts1} = sys_pre_expand:module(Code, Opts0),
+core(Forms, #compile{options=Opts0}=St) ->
+ Opts1 = lists:flatten([C || {attribute,_,compile,C} <- Forms] ++ Opts0),
Opts = expand_opts(Opts1),
- {ok,St0#compile{module=Mod,options=Opts,code={Mod,Exp,Forms}}}.
+ {ok,Core,Ws} = v3_core:module(Forms, Opts),
+ Mod = cerl:concrete(cerl:module_name(Core)),
+ {ok,Core,St#compile{module=Mod,options=Opts,
+ warnings=St#compile.warnings++Ws}}.
-core_fold_module_after_inlining(#compile{code=Code0,options=Opts}=St) ->
+core_fold_module_after_inlining(Code0, #compile{options=Opts}=St) ->
%% Inlining may produce code that generates spurious warnings.
%% Ignore all warnings.
{ok,Code,_Ws} = sys_core_fold:module(Code0, Opts),
- {ok,St#compile{code=Code}}.
+ {ok,Code,St}.
-v3_kernel(#compile{code=Code0,options=Opts,warnings=Ws0}=St) ->
+v3_kernel(Code0, #compile{options=Opts,warnings=Ws0}=St) ->
{ok,Code,Ws} = v3_kernel:module(Code0, Opts),
case Ws =:= [] orelse test_core_inliner(St) of
false ->
- {ok,St#compile{code=Code,warnings=Ws0++Ws}};
+ {ok,Code,St#compile{warnings=Ws0++Ws}};
true ->
%% cerl_inline may produce code that generates spurious
%% warnings. Ignore any such warnings.
- {ok,St#compile{code=Code}}
+ {ok,Code,St}
end.
test_old_inliner(#compile{options=Opts}) ->
@@ -1281,52 +1353,51 @@ test_core_inliner(#compile{options=Opts}) ->
test_any_inliner(St) ->
test_old_inliner(St) orelse test_core_inliner(St).
-core_old_inliner(#compile{code=Code0,options=Opts}=St) ->
+core_old_inliner(Code0, #compile{options=Opts}=St) ->
{ok,Code} = sys_core_inline:module(Code0, Opts),
- {ok,St#compile{code=Code}}.
+ {ok,Code,St}.
-core_inline_module(#compile{code=Code0,options=Opts}=St) ->
+core_inline_module(Code0, #compile{options=Opts}=St) ->
Code = cerl_inline:core_transform(Code0, Opts),
- {ok,St#compile{code=Code}}.
-
-save_abstract_code(#compile{ifile=File}=St) ->
- case abstract_code(St) of
- {ok,Code} ->
- {ok,St#compile{abstract_code=Code}};
- {error,Es} ->
- {error,St#compile{errors=St#compile.errors ++ [{File,Es}]}}
- end.
+ {ok,Code,St}.
+
+save_abstract_code(Code, St) ->
+ {ok,Code,St#compile{abstract_code=erl_parse:anno_to_term(Code)}}.
+
+debug_info(#compile{module=Module,mod_options=Opts0,ofile=OFile,abstract_code=Abst}) ->
+ AbstOpts = cleanup_compile_options(Opts0),
+ Opts1 = proplists:delete(debug_info, Opts0),
+ {Backend,Metadata,Opts2} =
+ case proplists:get_value(debug_info, Opts0, false) of
+ {OptBackend,OptMetadata} when is_atom(OptBackend) -> {OptBackend,OptMetadata,Opts1};
+ false -> {erl_abstract_code,{none,AbstOpts},Opts1};
+ true -> {erl_abstract_code,{Abst,AbstOpts},[debug_info | Opts1]}
+ end,
+ DebugInfo = erlang:term_to_binary({debug_info_v1,Backend,Metadata}, [compressed]),
-abstract_code(#compile{code=Code0,options=Opts,ofile=OFile}) ->
- Code = erl_parse:anno_to_term(Code0),
- Abstr = erlang:term_to_binary({raw_abstract_v1,Code}, [compressed]),
- case member(encrypt_debug_info, Opts) of
+ case member(encrypt_debug_info, Opts2) of
true ->
- case keyfind(debug_info_key, 1, Opts) of
- {_,Key} ->
- encrypt_abs_code(Abstr, Key);
+ case lists:keytake(debug_info_key, 1, Opts2) of
+ {value,{_, Key},Opts3} ->
+ encrypt_debug_info(DebugInfo, Key, [{debug_info_key,'********'} | Opts3]);
false ->
- %% Note: #compile.module has not been set yet.
- %% Here is an approximation that should work for
- %% all valid cases.
- Module = list_to_atom(filename:rootname(filename:basename(OFile))),
- Mode = proplists:get_value(crypto_mode, Opts, des3_cbc),
+ Mode = proplists:get_value(crypto_mode, Opts2, des3_cbc),
case beam_lib:get_crypto_key({debug_info, Mode, Module, OFile}) of
error ->
{error, [{none,?MODULE,no_crypto_key}]};
Key ->
- encrypt_abs_code(Abstr, {Mode, Key})
+ encrypt_debug_info(DebugInfo, {Mode, Key}, Opts2)
end
end;
false ->
- {ok, Abstr}
+ {ok,DebugInfo,Opts2}
end.
-encrypt_abs_code(Abstr, Key0) ->
+encrypt_debug_info(DebugInfo, Key, Opts) ->
try
- RealKey = generate_key(Key0),
+ RealKey = generate_key(Key),
case start_crypto() of
- ok -> {ok,encrypt(RealKey, Abstr)};
+ ok -> {ok,encrypt(RealKey, DebugInfo),Opts};
{error,_}=E -> E
end
catch
@@ -1334,6 +1405,18 @@ encrypt_abs_code(Abstr, Key0) ->
{error,[{none,?MODULE,bad_crypto_key}]}
end.
+cleanup_compile_options(Opts) ->
+ lists:filter(fun keep_compile_option/1, Opts).
+
+%% We are storing abstract, not asm or core.
+keep_compile_option(from_asm) -> false;
+keep_compile_option(from_core) -> false;
+%% Parse transform and macros have already been applied.
+keep_compile_option({parse_transform, _}) -> false;
+keep_compile_option({d, _, _}) -> false;
+%% Do not affect compilation result on future calls.
+keep_compile_option(Option) -> effects_code_generation(Option).
+
start_crypto() ->
try crypto:start() of
{error,{already_started,crypto}} -> ok;
@@ -1357,18 +1440,19 @@ encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) ->
TypeString = atom_to_list(Type),
list_to_binary([0,length(TypeString),TypeString,Bin]).
-save_core_code(St) ->
- {ok,St#compile{core_code=cerl:from_records(St#compile.code)}}.
-
-beam_asm(#compile{ifile=File,code=Code0,
- abstract_code=Abst,mod_options=Opts0}=St) ->
- Source = paranoid_absname(File),
- Opts1 = lists:map(fun({debug_info_key,_}) -> {debug_info_key,'********'};
- (Other) -> Other
- end, Opts0),
- Opts2 = [O || O <- Opts1, effects_code_generation(O)],
- case beam_asm:module(Code0, Abst, Source, Opts2) of
- {ok,Code} -> {ok,St#compile{code=Code,abstract_code=[]}}
+save_core_code(Code, St) ->
+ {ok,Code,St#compile{core_code=cerl:from_records(Code)}}.
+
+beam_asm(Code0, #compile{ifile=File,extra_chunks=ExtraChunks,options=CompilerOpts}=St) ->
+ case debug_info(St) of
+ {ok,DebugInfo,Opts0} ->
+ Source = paranoid_absname(File),
+ Opts1 = [O || O <- Opts0, effects_code_generation(O)],
+ Chunks = [{<<"Dbgi">>, DebugInfo} | ExtraChunks],
+ {ok,Code} = beam_asm:module(Code0, Chunks, Source, Opts1, CompilerOpts),
+ {ok,Code,St#compile{abstract_code=[]}};
+ {error,Es} ->
+ {error,St#compile{errors=St#compile.errors ++ [{File,Es}]}}
end.
paranoid_absname(""=File) ->
@@ -1392,17 +1476,17 @@ is_native_enabled([no_native|_]) -> false;
is_native_enabled([_|Opts]) -> is_native_enabled(Opts);
is_native_enabled([]) -> false.
-native_compile(#compile{code=none}=St) -> {ok,St};
-native_compile(St) ->
+native_compile(none, St) -> {ok,none,St};
+native_compile(Code, 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}};
+ {ok,Code,St#compile{warnings=St#compile.warnings ++ Ws}};
_ ->
- native_compile_1(St)
+ native_compile_1(Code, St)
end.
-native_compile_1(St) ->
+native_compile_1(Code, St) ->
Opts0 = St#compile.options,
IgnoreErrors = member(ignore_native_errors, Opts0),
Opts = case keyfind(hipe, 1, Opts0) of
@@ -1412,10 +1496,10 @@ native_compile_1(St) ->
end,
try hipe:compile(St#compile.module,
St#compile.core_code,
- St#compile.code,
+ Code,
Opts) of
{ok,{_Type,Bin}=T} when is_binary(Bin) ->
- {ok,embed_native_code(St, T)};
+ {ok,embed_native_code(Code, T),St};
{error,R} ->
case IgnoreErrors of
true ->
@@ -1438,13 +1522,13 @@ native_compile_1(St) ->
end
end.
-embed_native_code(St, {Architecture,NativeCode}) ->
- {ok, _, Chunks0} = beam_lib:all_chunks(St#compile.code),
+embed_native_code(Code, {Architecture,NativeCode}) ->
+ {ok, _, Chunks0} = beam_lib:all_chunks(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}.
+ {ok,BeamPlusNative} = beam_lib:build_module(Chunks),
+ BeamPlusNative.
%% effects_code_generation(Option) -> true|false.
%% Determine whether the option could have any effect on the
@@ -1452,30 +1536,31 @@ embed_native_code(St, {Architecture,NativeCode}) ->
%% errors will be reported).
effects_code_generation(Option) ->
- case Option of
+ case Option of
beam -> false;
report_warnings -> false;
report_errors -> false;
return_errors-> false;
return_warnings-> false;
+ warnings_as_errors -> false;
binary -> false;
verbose -> false;
{cwd,_} -> false;
+ {outdir, _} -> false;
_ -> true
end.
-save_binary(#compile{code=none}=St) -> {ok,St};
-save_binary(#compile{module=Mod,ofile=Outfile,
- options=Opts}=St) ->
+save_binary(none, St) -> {ok,none,St};
+save_binary(Code, #compile{module=Mod,ofile=Outfile,options=Opts}=St) ->
%% Test that the module name and output file name match.
case member(no_error_module_mismatch, Opts) of
true ->
- save_binary_1(St);
+ save_binary_1(Code, St);
false ->
Base = filename:rootname(filename:basename(Outfile)),
case atom_to_list(Mod) of
Base ->
- save_binary_1(St);
+ save_binary_1(Code, St);
_ ->
Es = [{St#compile.ofile,
[{none,?MODULE,{module_name,Mod,Base}}]}],
@@ -1483,14 +1568,14 @@ save_binary(#compile{module=Mod,ofile=Outfile,
end
end.
-save_binary_1(St) ->
+save_binary_1(Code, St) ->
Ofile = St#compile.ofile,
Tfile = tmpfile(Ofile), %Temp working file
- case write_binary(Tfile, St#compile.code, St) of
+ case write_binary(Tfile, Code, St) of
ok ->
case file:rename(Tfile, Ofile) of
ok ->
- {ok,St};
+ {ok,none,St};
{error,RenameError} ->
Es0 = [{Ofile,[{none,?MODULE,{rename,Tfile,Ofile,
RenameError}}]}],
@@ -1590,6 +1675,9 @@ list_errors(_F, []) -> ok.
%% tmpfile(ObjFile) -> TmpFile
%% Work out the correct input and output file names.
+-spec iofile(atom() | file:filename_all()) ->
+ {file:name_all(),file:name_all()}.
+
iofile(File) when is_atom(File) ->
iofile(atom_to_list(File));
iofile(File) ->
@@ -1630,29 +1718,29 @@ pre_defs([]) -> [].
inc_paths(Opts) ->
[ P || {i,P} <- Opts, is_list(P) ].
-src_listing(Ext, St) ->
+src_listing(Ext, Code, St) ->
listing(fun (Lf, {_Mod,_Exp,Fs}) -> do_src_listing(Lf, Fs);
(Lf, Fs) -> do_src_listing(Lf, Fs) end,
- Ext, St).
+ Ext, Code, St).
do_src_listing(Lf, Fs) ->
Opts = [lists:keyfind(encoding, 1, io:getopts(Lf))],
foreach(fun (F) -> io:put_chars(Lf, [erl_pp:form(F, Opts),"\n"]) end,
Fs).
-listing(Ext, St0) ->
+listing(Ext, Code, St0) ->
St = St0#compile{encoding = none},
- listing(fun(Lf, Fs) -> beam_listing:module(Lf, Fs) end, Ext, St).
+ listing(fun(Lf, Fs) -> beam_listing:module(Lf, Fs) end, Ext, Code, St).
-listing(LFun, Ext, St) ->
+listing(LFun, Ext, Code, St) ->
Lfile = outfile(St#compile.base, Ext, St#compile.options),
case file:open(Lfile, [write,delayed_write]) of
{ok,Lf} ->
- Code = restore_expanded_types(Ext, St#compile.code),
+ Code = restore_expanded_types(Ext, Code),
output_encoding(Lf, St),
LFun(Lf, Code),
ok = file:close(Lf),
- {ok,St};
+ {ok,Code,St};
{error,Error} ->
Es = [{Lfile,[{none,compile,{write_error,Error}}]}],
{error,St#compile{errors=St#compile.errors ++ Es}}
@@ -1724,6 +1812,8 @@ help(_) ->
%% compile(AbsFileName, Outfilename, Options)
%% Compile entry point for erl_compile.
+-spec compile(file:filename(), _, #options{}) -> 'ok' | 'error'.
+
compile(File0, _OutFile, Options) ->
pre_load(),
File = shorten_filename(File0),
@@ -1732,6 +1822,8 @@ compile(File0, _OutFile, Options) ->
Other -> Other
end.
+-spec compile_beam(file:filename(), _, #options{}) -> 'ok' | 'error'.
+
compile_beam(File0, _OutFile, Opts) ->
File = shorten_filename(File0),
case file(File, [from_beam|make_erl_options(Opts)]) of
@@ -1739,6 +1831,8 @@ compile_beam(File0, _OutFile, Opts) ->
Other -> Other
end.
+-spec compile_asm(file:filename(), _, #options{}) -> 'ok' | 'error'.
+
compile_asm(File0, _OutFile, Opts) ->
File = shorten_filename(File0),
case file(File, [from_asm|make_erl_options(Opts)]) of
@@ -1746,6 +1840,8 @@ compile_asm(File0, _OutFile, Opts) ->
Other -> Other
end.
+-spec compile_core(file:filename(), _, #options{}) -> 'ok' | 'error'.
+
compile_core(File0, _OutFile, Opts) ->
File = shorten_filename(File0),
case file(File, [from_core|make_erl_options(Opts)]) of
@@ -1795,7 +1891,6 @@ pre_load() ->
L = [beam_a,
beam_asm,
beam_block,
- beam_bool,
beam_bs,
beam_bsm,
beam_clean,
@@ -1807,6 +1902,7 @@ pre_load() ->
beam_opcodes,
beam_peep,
beam_receive,
+ beam_record,
beam_reorder,
beam_split,
beam_trim,
@@ -1825,9 +1921,9 @@ pre_load() ->
erl_lint,
erl_parse,
erl_scan,
+ sys_core_bsm,
sys_core_dsetel,
sys_core_fold,
- sys_pre_expand,
v3_codegen,
v3_core,
v3_kernel,
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index 1fd7800e85..3139d68902 100644
--- a/lib/compiler/src/compiler.app.src
+++ b/lib/compiler/src/compiler.app.src
@@ -1,7 +1,7 @@
% This is an -*- erlang -*- file.
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -24,7 +24,6 @@
beam_a,
beam_asm,
beam_block,
- beam_bool,
beam_bs,
beam_bsm,
beam_clean,
@@ -39,6 +38,7 @@
beam_peep,
beam_receive,
beam_reorder,
+ beam_record,
beam_split,
beam_trim,
beam_type,
@@ -58,12 +58,12 @@
core_lib,
erl_bifs,
rec_env,
+ sys_core_bsm,
sys_core_dsetel,
sys_core_fold,
sys_core_fold_lists,
sys_core_inline,
sys_pre_attributes,
- sys_pre_expand,
v3_codegen,
v3_core,
v3_kernel,
@@ -73,5 +73,5 @@
{registered, []},
{applications, [kernel, stdlib]},
{env, []},
- {runtime_dependencies, ["stdlib-2.5","kernel-4.0","hipe-3.12","erts-7.0",
+ {runtime_dependencies, ["stdlib-2.5","kernel-4.0","hipe-3.12","erts-9.0",
"crypto-3.6"]}]}.
diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl
index 8028aa99bb..79a7cccd98 100644
--- a/lib/compiler/src/core_parse.yrl
+++ b/lib/compiler/src/core_parse.yrl
@@ -432,6 +432,21 @@ timeout ->
%% ====================================================================== %%
+Header
+"%% This file was automatically generated from the file \"core_parse.yrl\"."
+"%%"
+"%% Copyright Ericsson AB 1999-2009. All Rights Reserved."
+"%%"
+"%% Licensed under the Apache License, Version 2.0 (the \"License\"); you may"
+"%% not use this file except in compliance with the License. You may obtain"
+"%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0>"
+"%%"
+"%% Unless required by applicable law or agreed to in writing, software"
+"%% distributed under the License is distributed on an \"AS IS\" BASIS,"
+"%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied."
+"%% See the License for the specific language governing permissions and"
+"%% limitations under the License."
+"".
Erlang code.
diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl
index 67209d06be..cff6c7098b 100644
--- a/lib/compiler/src/core_pp.erl
+++ b/lib/compiler/src/core_pp.erl
@@ -179,7 +179,7 @@ format_1(#c_tuple{es=Es}, Ctxt) ->
format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
$}
];
-format_1(#c_map{arg=#c_literal{anno=[],val=M},es=Es}, Ctxt)
+format_1(#c_map{arg=#c_literal{val=M},es=Es}, Ctxt)
when is_map(M), map_size(M) =:= 0 ->
["~{",
format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl
index 11b52f6c5f..9f0676538f 100644
--- a/lib/compiler/src/core_scan.erl
+++ b/lib/compiler/src/core_scan.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -49,13 +49,37 @@
-import(lists, [reverse/1]).
+-type location() :: integer().
+-type category() :: atom().
+-type symbol() :: atom() | float() | integer() | string().
+-type token() :: {category(), Anno :: location(), symbol()}
+ | {category(), Anno :: location()}.
+-type tokens() :: [token()].
+-type error_description() :: term().
+-type error_info() :: {erl_anno:location(), module(), error_description()}.
+
%% string([Char]) ->
%% string([Char], StartPos) ->
%% {ok, [Tok], EndPos} |
%% {error, {Pos,core_scan,What}, EndPos}
+-spec string(String) -> Return when
+ String :: string(),
+ Return :: {'ok', Tokens :: tokens(), EndLocation}
+ | {'error', ErrorInfo :: error_info(), ErrorLocation},
+ EndLocation :: location(),
+ ErrorLocation :: location().
+
string(Cs) -> string(Cs, 1).
+-spec string(String, StartLocation) -> Return when
+ String :: string(),
+ Return :: {'ok', Tokens :: tokens(), EndLocation}
+ | {'error', ErrorInfo :: error_info(), ErrorLocation},
+ StartLocation :: location(),
+ EndLocation :: location(),
+ ErrorLocation :: location().
+
string(Cs, Sp) ->
%% Add an 'eof' to always get correct handling.
case string_pre_scan(Cs, [], Sp) of
@@ -259,10 +283,12 @@ scan1([$$|Cs0], Toks, Pos) -> %Character constant
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
+ try binary_to_atom(list_to_binary(S), utf8) of
A when is_atom(A) ->
- scan1(Cs1, [{atom,Pos,A}|Toks], Pos1);
- _Error -> scan_error({illegal,atom}, Pos)
+ scan1(Cs1, [{atom,Pos,A}|Toks], Pos1)
+ catch
+ error:_ ->
+ scan_error({illegal,atom}, Pos)
end;
scan1([$"|Cs0], Toks, Pos) -> %String
{S,Cs1,Pos1} = scan_string(Cs0, $", Pos),
diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl
index 6b2d781a76..bafa9d75b7 100644
--- a/lib/compiler/src/erl_bifs.erl
+++ b/lib/compiler/src/erl_bifs.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -75,11 +75,12 @@ is_pure(erlang, binary_to_list, 1) -> true;
is_pure(erlang, binary_to_list, 3) -> true;
is_pure(erlang, bit_size, 1) -> true;
is_pure(erlang, byte_size, 1) -> true;
+is_pure(erlang, ceil, 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, float_to_binary, 1) -> true;
-is_pure(erlang, hash, 2) -> false;
+is_pure(erlang, floor, 1) -> true;
is_pure(erlang, hd, 1) -> true;
is_pure(erlang, integer_to_binary, 1) -> true;
is_pure(erlang, integer_to_list, 1) -> true;
@@ -129,11 +130,14 @@ 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, ceil, 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, floor, 1) -> true;
+is_pure(math, fmod, 2) -> true;
is_pure(math, log, 1) -> true;
is_pure(math, log2, 1) -> true;
is_pure(math, log10, 1) -> true;
@@ -203,7 +207,6 @@ 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(error_logger, warning_map, 0) -> true;
is_safe(_, _, _) -> false.
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index dcbdeb32e6..b5688de339 100755
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1998-2016. All Rights Reserved.
+# Copyright Ericsson AB 1998-2017. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
@@ -537,3 +537,11 @@ BEAM_FORMAT_NUMBER=0
156: is_map/2
157: has_map_fields/3
158: get_map_elements/3
+
+# OTP 20
+
+## @spec is_tagged_tuple Lbl Reg N Atom
+## @doc Test the type of Reg and jumps to Lbl if it is not a tuple.
+## Test the arity of Reg and jumps to Lbl if it is not N.
+## Test the first element of the tuple and jumps to Lbl if it is not Atom.
+159: is_tagged_tuple/4
diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl
index cdc513e57c..48d39776dc 100644
--- a/lib/compiler/src/rec_env.erl
+++ b/lib/compiler/src/rec_env.erl
@@ -1,8 +1,3 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
-%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -15,10 +10,8 @@
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
-%% %CopyrightEnd%
-%%
-%% @author Richard Carlsson <[email protected]>
%% @copyright 1999-2004 Richard Carlsson
+%% @author Richard Carlsson <[email protected]>
%% @doc Abstract environments, supporting self-referential bindings and
%% automatic new-key generation.
diff --git a/lib/compiler/src/sys_core_bsm.erl b/lib/compiler/src/sys_core_bsm.erl
new file mode 100644
index 0000000000..3e04cc33df
--- /dev/null
+++ b/lib/compiler/src/sys_core_bsm.erl
@@ -0,0 +1,355 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Purpose : Optimize bit syntax matching.
+
+
+-module(sys_core_bsm).
+-export([module/2,format_error/1]).
+
+-include("core_parse.hrl").
+-import(lists, [member/2,nth/2,reverse/1,usort/1]).
+
+-spec module(cerl:c_module(), [compile:option()]) -> {'ok', cerl:c_module()}.
+
+module(#c_module{defs=Ds0}=Mod, Opts) ->
+ {Ds,Ws0} = function(Ds0, [], []),
+ case member(bin_opt_info, Opts) of
+ false ->
+ {ok,Mod#c_module{defs=Ds}};
+ true ->
+ Ws1 = [make_warning(Where, What) || {Where,What} <- Ws0],
+ Ws = usort(Ws1),
+ {ok,Mod#c_module{defs=Ds},Ws}
+ end.
+
+function([{#c_var{name={F,Arity}}=Name,B0}|Fs], FsAcc, Ws0) ->
+ try cerl_trees:mapfold(fun bsm_an/2, Ws0, B0) of
+ {B,Ws} ->
+ function(Fs, [{Name,B}|FsAcc], Ws)
+ catch
+ Class:Error ->
+ Stack = erlang:get_stacktrace(),
+ io:fwrite("Function: ~w/~w\n", [F,Arity]),
+ erlang:raise(Class, Error, Stack)
+ end;
+function([], Fs, Ws) ->
+ {reverse(Fs),Ws}.
+
+-type error() :: atom().
+-spec format_error(error()) -> nonempty_string().
+
+format_error(bin_opt_alias) ->
+ "INFO: the '=' operator will prevent delayed sub binary optimization";
+format_error(bin_partition) ->
+ "INFO: matching non-variables after a previous clause matching a variable "
+ "will prevent delayed sub binary optimization";
+format_error(bin_left_var_used_in_guard) ->
+ "INFO: a variable to the left of the binary pattern is used in a guard; "
+ "will prevent delayed sub binary optimization";
+format_error(bin_argument_order) ->
+ "INFO: matching anything else but a plain variable to the left of "
+ "binary pattern will prevent delayed sub binary optimization; "
+ "SUGGEST changing argument order";
+format_error(bin_var_used) ->
+ "INFO: using a matched out sub binary will prevent "
+ "delayed sub binary optimization";
+format_error(orig_bin_var_used_in_guard) ->
+ "INFO: using the original binary variable in a guard will prevent "
+ "delayed sub binary optimization";
+format_error(bin_var_used_in_guard) ->
+ "INFO: using a matched out sub binary in a guard will prevent "
+ "delayed sub binary optimization".
+
+
+%%%
+%%% Annotate bit syntax matching to faciliate optimization in further passes.
+%%%
+
+bsm_an(Core0, Ws0) ->
+ case bsm_an(Core0) of
+ {ok,Core} ->
+ {Core,Ws0};
+ {ok,Core,W} ->
+ {Core,[W|Ws0]}
+ end.
+
+bsm_an(#c_case{arg=#c_var{}=V}=Case) ->
+ bsm_an_1([V], Case);
+bsm_an(#c_case{arg=#c_values{es=Es}}=Case) ->
+ bsm_an_1(Es, Case);
+bsm_an(Other) ->
+ {ok,Other}.
+
+bsm_an_1(Vs, #c_case{clauses=Cs}=Case) ->
+ case bsm_leftmost(Cs) of
+ none -> {ok,Case};
+ Pos -> bsm_an_2(Vs, Cs, Case, Pos)
+ end.
+
+bsm_an_2(Vs, Cs, Case, Pos) ->
+ case bsm_nonempty(Cs, Pos) of
+ true -> bsm_an_3(Vs, Cs, Case, Pos);
+ false -> {ok,Case}
+ end.
+
+bsm_an_3(Vs, Cs, Case, Pos) ->
+ try
+ bsm_ensure_no_partition(Cs, Pos),
+ {ok,bsm_do_an(Vs, Pos, Cs, Case)}
+ catch
+ throw:{problem,Where,What} ->
+ {ok,Case,{Where,What}}
+ end.
+
+bsm_do_an(Vs0, Pos, Cs0, Case) ->
+ case nth(Pos, Vs0) of
+ #c_var{name=Vname}=V0 ->
+ Cs = bsm_do_an_var(Vname, Pos, Cs0, []),
+ V = bsm_annotate_for_reuse(V0),
+ Bef = lists:sublist(Vs0, Pos-1),
+ Aft = lists:nthtail(Pos, Vs0),
+ case Bef ++ [V|Aft] of
+ [_] ->
+ Case#c_case{arg=V,clauses=Cs};
+ Vs ->
+ Case#c_case{arg=#c_values{es=Vs},clauses=Cs}
+ end;
+ _ ->
+ Case
+ end.
+
+bsm_do_an_var(V, S, [#c_clause{pats=Ps,guard=G,body=B0}=C0|Cs], Acc) ->
+ case nth(S, Ps) of
+ #c_var{name=VarName} ->
+ case core_lib:is_var_used(V, G) of
+ true -> bsm_problem(C0, orig_bin_var_used_in_guard);
+ false -> ok
+ end,
+ case core_lib:is_var_used(VarName, G) of
+ true -> bsm_problem(C0, bin_var_used_in_guard);
+ false -> ok
+ end,
+ B1 = bsm_maybe_ctx_to_binary(VarName, B0),
+ B = bsm_maybe_ctx_to_binary(V, B1),
+ C = C0#c_clause{body=B},
+ bsm_do_an_var(V, S, Cs, [C|Acc]);
+ #c_alias{}=P ->
+ case bsm_could_match_binary(P) of
+ false ->
+ bsm_do_an_var(V, S, Cs, [C0|Acc]);
+ true ->
+ bsm_problem(C0, bin_opt_alias)
+ end;
+ P ->
+ case bsm_could_match_binary(P) andalso bsm_is_var_used(V, G, B0) of
+ false ->
+ bsm_do_an_var(V, S, Cs, [C0|Acc]);
+ true ->
+ bsm_problem(C0, bin_var_used)
+ end
+ end;
+bsm_do_an_var(_, _, [], Acc) -> reverse(Acc).
+
+bsm_annotate_for_reuse(#c_var{anno=Anno}=Var) ->
+ Var#c_var{anno=[reuse_for_context|Anno]}.
+
+bsm_is_var_used(V, G, B) ->
+ core_lib:is_var_used(V, G) orelse core_lib:is_var_used(V, B).
+
+bsm_maybe_ctx_to_binary(V, B) ->
+ case core_lib:is_var_used(V, B) andalso not previous_ctx_to_binary(V, B) of
+ false ->
+ B;
+ true ->
+ #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary},
+ args=[#c_var{name=V}]},
+ body=B}
+ end.
+
+previous_ctx_to_binary(V, Core) ->
+ case Core of
+ #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary},
+ args=[#c_var{name=V}]}} ->
+ true;
+ _ ->
+ false
+ end.
+
+%% bsm_leftmost(Cs) -> none | ArgumentNumber
+%% Find the leftmost argument that does binary matching. Return
+%% the number of the argument (1-N).
+
+bsm_leftmost(Cs) ->
+ bsm_leftmost_1(Cs, none).
+
+bsm_leftmost_1([#c_clause{pats=Ps}|Cs], Pos) ->
+ bsm_leftmost_2(Ps, Cs, 1, Pos);
+bsm_leftmost_1([], Pos) -> Pos.
+
+bsm_leftmost_2(_, Cs, Pos, Pos) ->
+ bsm_leftmost_1(Cs, Pos);
+bsm_leftmost_2([#c_binary{}|_], Cs, N, _) ->
+ bsm_leftmost_1(Cs, N);
+bsm_leftmost_2([_|Ps], Cs, N, Pos) ->
+ bsm_leftmost_2(Ps, Cs, N+1, Pos);
+bsm_leftmost_2([], Cs, _, Pos) ->
+ bsm_leftmost_1(Cs, Pos).
+
+%% bsm_nonempty(Cs, Pos) -> true|false
+%% Check if at least one of the clauses matches a non-empty
+%% binary in the given argument position.
+%%
+bsm_nonempty([#c_clause{pats=Ps}|Cs], Pos) ->
+ case nth(Pos, Ps) of
+ #c_binary{segments=[_|_]} ->
+ true;
+ _ ->
+ bsm_nonempty(Cs, Pos)
+ end;
+bsm_nonempty([], _ ) -> false.
+
+%% bsm_ensure_no_partition(Cs, Pos) -> ok (exception if problem)
+%% We must make sure that matching is not partitioned between
+%% variables like this:
+%% foo(<<...>>) -> ...
+%% foo(<Variable>) when ... -> ...
+%% foo(<Any non-variable pattern>) ->
+%% If there is such partition, we are not allowed to reuse the binary variable
+%% for the match context.
+%%
+%% Also, arguments to the left of the argument that is matched
+%% against a binary, are only allowed to be simple variables, not
+%% used in guards. The reason is that we must know that the binary is
+%% only matched in one place (i.e. there must be only one bs_start_match2
+%% instruction emitted).
+
+bsm_ensure_no_partition(Cs, Pos) ->
+ bsm_ensure_no_partition_1(Cs, Pos, before).
+
+%% Loop through each clause.
+bsm_ensure_no_partition_1([#c_clause{pats=Ps,guard=G}|Cs], Pos, State0) ->
+ State = bsm_ensure_no_partition_2(Ps, Pos, G, simple_vars, State0),
+ case State of
+ 'after' ->
+ bsm_ensure_no_partition_after(Cs, Pos);
+ _ ->
+ ok
+ end,
+ bsm_ensure_no_partition_1(Cs, Pos, State);
+bsm_ensure_no_partition_1([], _, _) -> ok.
+
+%% Loop through each pattern for this clause.
+bsm_ensure_no_partition_2([#c_binary{}=Where|_], 1, _, Vstate, State) ->
+ case State of
+ before when Vstate =:= simple_vars -> within;
+ before -> bsm_problem(Where, Vstate);
+ within when Vstate =:= simple_vars -> within;
+ within -> bsm_problem(Where, Vstate)
+ end;
+bsm_ensure_no_partition_2([#c_alias{}=Alias|_], 1, N, Vstate, State) ->
+ %% Retrieve the real pattern that the alias refers to and check that.
+ P = bsm_real_pattern(Alias),
+ bsm_ensure_no_partition_2([P], 1, N, Vstate, State);
+bsm_ensure_no_partition_2([_|_], 1, _, _Vstate, before=State) ->
+ %% No binary matching yet - therefore no partition.
+ State;
+bsm_ensure_no_partition_2([P|_], 1, _, Vstate, State) ->
+ case bsm_could_match_binary(P) of
+ false ->
+ %% If clauses can be freely arranged (Vstate =:= simple_vars),
+ %% a clause that cannot match a binary will not partition the clause.
+ %% Example:
+ %%
+ %% a(Var, <<>>) -> ...
+ %% a(Var, []) -> ...
+ %% a(Var, <<B>>) -> ...
+ %%
+ %% But if the clauses can't be freely rearranged, as in
+ %%
+ %% b(Var, <<X>>) -> ...
+ %% b(1, 2) -> ...
+ %%
+ %% we do have a problem.
+ %%
+ case Vstate of
+ simple_vars -> State;
+ _ -> bsm_problem(P, Vstate)
+ end;
+ true ->
+ %% The pattern P *may* match a binary, so we must update the state.
+ %% (P must be a variable.)
+ case State of
+ within -> 'after';
+ 'after' -> 'after'
+ end
+ end;
+bsm_ensure_no_partition_2([#c_var{name=V}|Ps], N, G, Vstate, S) ->
+ case core_lib:is_var_used(V, G) of
+ false ->
+ bsm_ensure_no_partition_2(Ps, N-1, G, Vstate, S);
+ true ->
+ bsm_ensure_no_partition_2(Ps, N-1, G, bin_left_var_used_in_guard, S)
+ end;
+bsm_ensure_no_partition_2([_|Ps], N, G, _, S) ->
+ bsm_ensure_no_partition_2(Ps, N-1, G, bin_argument_order, S).
+
+bsm_ensure_no_partition_after([#c_clause{pats=Ps}=C|Cs], Pos) ->
+ case nth(Pos, Ps) of
+ #c_var{} ->
+ bsm_ensure_no_partition_after(Cs, Pos);
+ _ ->
+ bsm_problem(C, bin_partition)
+ end;
+bsm_ensure_no_partition_after([], _) -> ok.
+
+bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P);
+bsm_could_match_binary(#c_cons{}) -> false;
+bsm_could_match_binary(#c_tuple{}) -> false;
+bsm_could_match_binary(#c_literal{val=Lit}) -> is_bitstring(Lit);
+bsm_could_match_binary(_) -> true.
+
+bsm_real_pattern(#c_alias{pat=P}) -> bsm_real_pattern(P);
+bsm_real_pattern(P) -> P.
+
+bsm_problem(Where, What) ->
+ throw({problem,Where,What}).
+
+make_warning(Core, Term) ->
+ case should_suppress_warning(Core) of
+ true ->
+ ok;
+ false ->
+ Anno = cerl:get_ann(Core),
+ Line = get_line(Anno),
+ File = get_file(Anno),
+ {File,[{Line,?MODULE,Term}]}
+ end.
+
+should_suppress_warning(Core) ->
+ Ann = cerl:get_ann(Core),
+ member(compiler_generated, Ann).
+
+get_line([Line|_]) when is_integer(Line) -> Line;
+get_line([_|T]) -> get_line(T);
+get_line([]) -> none.
+
+get_file([{file,File}|_]) -> File;
+get_file([_|T]) -> get_file(T);
+get_file([]) -> "no_file". % should not happen
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 4922953407..d73060fb7e 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -71,7 +71,7 @@
-export([module/2,format_error/1]).
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2,
- reverse/1,reverse/2,member/2,nth/2,flatten/1,
+ reverse/1,reverse/2,member/2,flatten/1,
unzip/1,keyfind/3]).
-import(cerl, [ann_c_cons/3,ann_c_map/3,ann_c_tuple/2]).
@@ -83,10 +83,11 @@
-ifdef(DEBUG).
-define(ASSERT(E),
case E of
- true -> ok;
+ true ->
+ ok;
false ->
io:format("~p, line ~p: assertion failed\n", [?MODULE,?LINE]),
- exit(assertion_failed)
+ error(assertion_failed)
end).
-else.
-define(ASSERT(E), ignore).
@@ -106,7 +107,6 @@
{'ok', cerl:c_module(), [_]}.
module(#c_module{defs=Ds0}=Mod, Opts) ->
- put(bin_opt_info, member(bin_opt_info, Opts)),
put(no_inline_list_funcs, not member(inline_list_funcs, Opts)),
case get(new_var_num) of
undefined -> put(new_var_num, 0);
@@ -115,12 +115,14 @@ module(#c_module{defs=Ds0}=Mod, Opts) ->
init_warnings(),
Ds1 = [function_1(D) || D <- Ds0],
erase(no_inline_list_funcs),
- erase(bin_opt_info),
{ok,Mod#c_module{defs=Ds1},get_warnings()}.
function_1({#c_var{name={F,Arity}}=Name,B0}) ->
try
- B = expr(B0, value, sub_new()), %This must be a fun!
+ B = find_fixpoint(fun(Core) ->
+ %% This must be a fun!
+ expr(Core, value, sub_new())
+ end, B0, 20),
{Name,B}
catch
Class:Error ->
@@ -129,6 +131,14 @@ function_1({#c_var{name={F,Arity}}=Name,B0}) ->
erlang:raise(Class, Error, Stack)
end.
+find_fixpoint(_OptFun, Core, 0) ->
+ Core;
+find_fixpoint(OptFun, Core0, Max) ->
+ case OptFun(Core0) of
+ Core0 -> Core0;
+ Core -> find_fixpoint(OptFun, Core, Max-1)
+ end.
+
%% body(Expr, Sub) -> Expr.
%% body(Expr, Context, Sub) -> Expr.
%% No special handling of anything except values.
@@ -160,13 +170,23 @@ guard(Expr, Sub) ->
%%
opt_guard_try(#c_seq{arg=Arg,body=Body0}=Seq) ->
Body = opt_guard_try(Body0),
- case {Arg,Body} of
- {#c_call{module=#c_literal{val=Mod},
- name=#c_literal{val=Name},
- args=Args},#c_literal{val=false}} ->
+ WillFail = case Body of
+ #c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=error},
+ args=[_]} ->
+ true;
+ #c_literal{val=false} ->
+ true;
+ _ ->
+ false
+ end,
+ case Arg of
+ #c_call{module=#c_literal{val=Mod},
+ name=#c_literal{val=Name},
+ args=Args} when WillFail ->
%% We have sequence consisting of a call (evaluated
%% for a possible exception and/or side effect only),
- %% followed by 'false'.
+ %% followed by 'false' or a call to error/1.
%% Since the sequence is inside a try block that will
%% default to 'false' if any exception occurs, not
%% evalutating the call will not change the behaviour
@@ -181,7 +201,7 @@ opt_guard_try(#c_seq{arg=Arg,body=Body0}=Seq) ->
%% be safely removed.
Body
end;
- {_,_} ->
+ _ ->
Seq#c_seq{body=Body}
end;
opt_guard_try(#c_case{clauses=Cs}=Term) ->
@@ -239,7 +259,7 @@ expr(#c_cons{anno=Anno,hd=H0,tl=T0}=Cons, Ctxt, Sub) ->
case Ctxt of
effect ->
add_warning(Cons, useless_building),
- expr(make_effect_seq([H1,T1], Sub), Ctxt, Sub);
+ make_effect_seq([H1,T1], Sub);
value ->
ann_c_cons(Anno, H1, T1)
end;
@@ -248,7 +268,7 @@ expr(#c_tuple{anno=Anno,es=Es0}=Tuple, Ctxt, Sub) ->
case Ctxt of
effect ->
add_warning(Tuple, useless_building),
- expr(make_effect_seq(Es, Sub), Ctxt, Sub);
+ make_effect_seq(Es, Sub);
value ->
ann_c_tuple(Anno, Es)
end;
@@ -257,7 +277,7 @@ expr(#c_map{anno=Anno,arg=V0,es=Es0}=Map, Ctxt, Sub) ->
case Ctxt of
effect ->
add_warning(Map, useless_building),
- expr(make_effect_seq(Es, Sub), Ctxt, Sub);
+ make_effect_seq(Es, Sub);
value ->
V = expr(V0, Ctxt, Sub),
ann_c_map(Anno,V,Es)
@@ -310,7 +330,7 @@ expr(#c_let{}=Let0, Ctxt, Sub) ->
Expr ->
%% The let body was successfully moved into the let argument.
%% Now recursively re-process the new expression.
- expr(Expr, Ctxt, sub_new_preserve_types(Sub))
+ Expr
end;
expr(#c_letrec{body=#c_var{}}=Letrec, effect, _Sub) ->
%% This is named fun in an 'effect' context. Warn and ignore.
@@ -351,7 +371,7 @@ expr(#c_case{}=Case0, Ctxt, Sub) ->
%% (in addition to any warnings that may have been emitted
%% according to the rules above).
%%
- case opt_bool_case(Case0) of
+ case opt_bool_case(Case0, Sub) of
#c_case{arg=Arg0,clauses=Cs0}=Case1 ->
Arg1 = body(Arg0, value, Sub),
LitExpr = cerl:is_literal(Arg1),
@@ -361,10 +381,8 @@ expr(#c_case{}=Case0, Ctxt, Sub) ->
warn_no_clause_match(Case1, Case),
Expr = eval_case(Case, Sub),
case move_case_into_arg(Case, Sub) of
- impossible ->
- bsm_an(Expr);
- Other ->
- expr(Other, Ctxt, sub_new_preserve_types(Sub))
+ impossible -> Expr;
+ Other -> Other
end;
Other ->
expr(Other, Ctxt, Sub)
@@ -377,10 +395,10 @@ expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) ->
expr(#c_apply{anno=Anno,op=Op0,args=As0}=App, _, Sub) ->
Op1 = expr(Op0, value, Sub),
As1 = expr_list(As0, value, Sub),
- case Op1 of
- #c_var{} ->
+ case cerl:is_data(Op1) of
+ false ->
App#c_apply{op=Op1,args=As1};
- _ ->
+ true ->
add_warning(App, invalid_call),
Err = #c_call{anno=Anno,
module=#c_literal{val=erlang},
@@ -1403,9 +1421,6 @@ sub_new() -> #sub{v=orddict:new(),s=cerl_sets:new(),t=#{}}.
sub_new(#sub{}=Sub) ->
Sub#sub{v=orddict:new(),t=#{}}.
-sub_new_preserve_types(#sub{}=Sub) ->
- Sub#sub{v=orddict:new()}.
-
sub_get_var(#c_var{name=V}=Var, #sub{v=S}) ->
case orddict:find(V, S) of
{ok,Val} -> Val;
@@ -1443,8 +1458,19 @@ sub_add_scope(Vs, #sub{s=Scope0}=Sub) ->
Sub#sub{s=Scope}.
sub_subst_scope(#sub{v=S0,s=Scope}=Sub) ->
- S = [{-1,#c_var{name=Sv}} || Sv <- cerl_sets:to_list(Scope)]++S0,
- Sub#sub{v=S}.
+ Initial = case S0 of
+ [{NegInt,_}|_] when is_integer(NegInt), NegInt < 0 ->
+ NegInt - 1;
+ _ ->
+ -1
+ end,
+ S = sub_subst_scope_1(cerl_sets:to_list(Scope), Initial, S0),
+ Sub#sub{v=orddict:from_list(S)}.
+
+%% The keys in an orddict must be unique. Make them so!
+sub_subst_scope_1([H|T], Key, Acc) ->
+ sub_subst_scope_1(T, Key-1, [{Key,#c_var{name=H}}|Acc]);
+sub_subst_scope_1([], _, Acc) -> Acc.
sub_is_val(#c_var{name=V}, #sub{v=S,s=Scope}) ->
%% When the bottleneck in sub_del_var/2 was eliminated, this
@@ -1535,9 +1561,11 @@ will_match(E, [P]) ->
will_match_1({false,_}) -> maybe;
will_match_1({true,_}) -> yes.
-%% opt_bool_case(CoreExpr) - CoreExpr'.
-%% Do various optimizations to case statement that has a
-%% boolean case expression.
+%% opt_bool_case(CoreExpr, Sub) - CoreExpr'.
+%%
+%% In bodies, do various optimizations to case statements that have
+%% boolean case expressions. We don't do the optimizations in guards,
+%% because they would thwart the optimization in v3_kernel.
%%
%% We start with some simple optimizations and normalization
%% to facilitate later optimizations.
@@ -1546,7 +1574,7 @@ will_match_1({true,_}) -> yes.
%% (or fail), we can remove any clause that cannot
%% possibly match 'true' or 'false'. Also, any clause
%% following both 'true' and 'false' clause can
-%% be removed. If successful, we will end up this:
+%% be removed. If successful, we will end up like this:
%%
%% case BoolExpr of case BoolExpr of
%% true -> false ->
@@ -1557,8 +1585,11 @@ will_match_1({true,_}) -> yes.
%%
%% We give up if there are clauses with guards, or if there
%% is a variable clause that matches anything.
-%%
-opt_bool_case(#c_case{arg=Arg}=Case0) ->
+
+opt_bool_case(#c_case{}=Case, #sub{in_guard=true}) ->
+ %% v3_kernel does a better job without "help".
+ Case;
+opt_bool_case(#c_case{arg=Arg}=Case0, #sub{in_guard=false}) ->
case is_bool_expr(Arg) of
false ->
Case0;
@@ -1570,8 +1601,7 @@ opt_bool_case(#c_case{arg=Arg}=Case0) ->
impossible ->
Case0
end
- end;
-opt_bool_case(Core) -> Core.
+ end.
opt_bool_clauses(#c_case{clauses=Cs}=Case) ->
Case#c_case{clauses=opt_bool_clauses(Cs, false, false)}.
@@ -1587,16 +1617,14 @@ opt_bool_clauses(Cs, true, true) ->
[]
end;
opt_bool_clauses([#c_clause{pats=[#c_literal{val=Lit}],
- guard=#c_literal{val=true},
- body=B}=C0|Cs], SeenT, SeenF) ->
+ guard=#c_literal{val=true}}=C|Cs], SeenT, SeenF) ->
case is_boolean(Lit) of
false ->
%% Not a boolean - this clause can't match.
- add_warning(C0, nomatch_clause_type),
+ add_warning(C, nomatch_clause_type),
opt_bool_clauses(Cs, SeenT, SeenF);
true ->
%% This clause will match.
- C = C0#c_clause{body=opt_bool_case(B)},
case {Lit,SeenT,SeenF} of
{false,_,false} ->
[C|opt_bool_clauses(Cs, SeenT, true)];
@@ -1872,10 +1900,10 @@ case_opt_arg_1(E0, Cs0, LitExpr) ->
true ->
E = case_opt_compiler_generated(E0),
Cs = case_opt_nomatch(E, Cs0, LitExpr),
- case cerl:data_type(E) of
- {atomic,_} ->
+ case cerl:is_literal(E) of
+ true ->
case_opt_lit(E, Cs);
- _ ->
+ false ->
case_opt_data(E, Cs)
end
end.
@@ -2023,10 +2051,10 @@ case_opt_lit_1(_, []) -> [].
%% the clauses where it is actually needed.
case_opt_data(E, Cs0) ->
- Es = cerl:data_es(E),
TypeSig = {cerl:data_type(E),cerl:data_arity(E)},
- try case_opt_data_1(Cs0, Es, TypeSig) of
+ try case_opt_data_1(Cs0, TypeSig) of
Cs ->
+ Es = cerl:data_es(E),
{ok,Es,Cs}
catch
throw:impossible ->
@@ -2034,44 +2062,47 @@ case_opt_data(E, Cs0) ->
{error,Cs0}
end.
-case_opt_data_1([{[P0|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig) ->
+case_opt_data_1([{[P0|Ps0],C,PsAcc,Bs0}|Cs], TypeSig) ->
P = case_opt_compiler_generated(P0),
- BindTo = #c_var{name=dummy},
- {Ps1,[{BindTo,_}|Bs1]} = case_data_pat_alias(P, BindTo, TypeSig, []),
- [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}|case_opt_data_1(Cs, Es, TypeSig)];
-case_opt_data_1([], _, _) -> [].
+ {Ps1,Bs} = case_opt_data_2(P, TypeSig, Bs0),
+ [{Ps1++Ps0,C,PsAcc,Bs}|case_opt_data_1(Cs, TypeSig)];
+case_opt_data_1([], _) -> [].
-case_data_pat_alias(P, BindTo0, TypeSig, Bs0) ->
- case cerl:type(P) of
- alias ->
- %% Recursively handle the pattern and bind to
- %% the alias variable.
- BindTo = cerl:alias_var(P),
- Apat0 = cerl:alias_pat(P),
- Ann = [compiler_generated],
- Apat = cerl:set_ann(Apat0, Ann),
- {Ps,Bs} = case_data_pat_alias(Apat, BindTo, TypeSig, Bs0),
- {Ps,[{BindTo0,BindTo}|Bs]};
- var ->
- %% Here we will need to actually build the data and bind
- %% it to the variable.
+case_opt_data_2(P, TypeSig, Bs0) ->
+ case case_analyze_pat(P) of
+ {[],Pat} when Pat =/= none ->
+ DataEs = cerl:data_es(P),
+ {DataEs,Bs0};
+ {[V|Vs],none} ->
{Type,Arity} = TypeSig,
Ann = [compiler_generated],
Vars = make_vars(Ann, Arity),
Data = cerl:ann_make_data(Ann, Type, Vars),
- Bs = [{BindTo0,P},{P,Data}|Bs0],
+ Bs = [{V,Data} | [{Var,V} || Var <- Vs] ++ Bs0],
{Vars,Bs};
- _ ->
- %% Since case_opt_nomatch/3 has removed all clauses that
- %% cannot match, we KNOW that this clause must match and
- %% that the pattern must be a data constructor.
- %% Here we must build the data and bind it to the variable.
+ {[V|Vs],Pat} when Pat =/= none ->
{Type,_} = TypeSig,
- DataEs = cerl:data_es(P),
+ DataEs = cerl:data_es(Pat),
Vars = pat_to_expr_list(DataEs),
Ann = [compiler_generated],
Data = cerl:ann_make_data(Ann, Type, Vars),
- {DataEs,[{BindTo0,Data}]}
+ Bs = [{V,Data} | [{Var,V} || Var <- Vs] ++ Bs0],
+ {DataEs,Bs}
+ end.
+
+case_analyze_pat(P) ->
+ case_analyze_pat_1(P, [], none).
+
+case_analyze_pat_1(P, Vs, Pat) ->
+ case cerl:type(P) of
+ alias ->
+ V = cerl:alias_var(P),
+ Apat = cerl:alias_pat(P),
+ case_analyze_pat_1(Apat, [V|Vs], Pat);
+ var ->
+ {[P|Vs],Pat};
+ _ ->
+ {Vs,P}
end.
%% pat_to_expr(Pattern) -> Expression.
@@ -2115,7 +2146,7 @@ make_var(A) ->
make_var_name() ->
N = get(new_var_num),
put(new_var_num, N+1),
- list_to_atom("fol"++integer_to_list(N)).
+ list_to_atom("@f"++integer_to_list(N)).
letify(Bs, Body) ->
Ann = cerl:get_ann(Body),
@@ -2129,7 +2160,7 @@ letify(Bs, Body) ->
-spec opt_not_in_let(cerl:c_let()) -> cerl:cerl().
opt_not_in_let(#c_let{vars=[_]=Vs0,arg=Arg0,body=Body0}=Let) ->
- case opt_not_in_let(Vs0, Arg0, Body0) of
+ case opt_not_in_let_0(Vs0, Arg0, Body0) of
{[],#c_values{es=[]},Body} ->
Body;
{Vs,Arg,Body} ->
@@ -2137,13 +2168,7 @@ opt_not_in_let(#c_let{vars=[_]=Vs0,arg=Arg0,body=Body0}=Let) ->
end;
opt_not_in_let(Let) -> Let.
-%% opt_not_in_let(Vs, Arg, Body) -> {Vs',Arg',Body'}
-%% Try to optimize away a 'not' operator in a 'let'.
-
--spec opt_not_in_let([cerl:c_var()], cerl:cerl(), cerl:cerl()) ->
- {[cerl:c_var()],cerl:cerl(),cerl:cerl()}.
-
-opt_not_in_let([#c_var{name=V}]=Vs0, Arg0, Body0) ->
+opt_not_in_let_0([#c_var{name=V}]=Vs0, Arg0, Body0) ->
case cerl:type(Body0) of
call ->
%% let <V> = Expr in not V ==>
@@ -2174,9 +2199,7 @@ opt_not_in_let([#c_var{name=V}]=Vs0, Arg0, Body0) ->
end;
_ ->
{Vs0,Arg0,Body0}
- end;
-opt_not_in_let(Vs, Arg, Body) ->
- {Vs,Arg,Body}.
+ end.
opt_not_in_let_1(V, Call, Body) ->
case Call of
@@ -2222,24 +2245,24 @@ inverse_rel_op('=<') -> '>';
inverse_rel_op(_) -> no.
-%% opt_bool_case_in_let(LetExpr, Sub) -> Core
+%% opt_bool_case_in_let(LetExpr) -> Core
opt_bool_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) ->
- opt_case_in_let_1(Vs, Arg, B, Let, Sub).
+ opt_bool_case_in_let_1(Vs, Arg, B, Let, Sub).
-opt_case_in_let_1([#c_var{name=V}], Arg,
+opt_bool_case_in_let_1([#c_var{name=V}], Arg,
#c_case{arg=#c_var{name=V}}=Case0, Let, Sub) ->
case is_simple_case_arg(Arg) of
true ->
- Case = opt_bool_case(Case0#c_case{arg=Arg}),
+ Case = opt_bool_case(Case0#c_case{arg=Arg}, Sub),
case core_lib:is_var_used(V, Case) of
- false -> expr(Case, sub_new(Sub));
+ false -> Case;
true -> Let
end;
false ->
Let
end;
-opt_case_in_let_1(_, _, _, Let, _) -> Let.
+opt_bool_case_in_let_1(_, _, _, Let, _) -> Let.
%% is_simple_case_arg(Expr) -> true|false
%% Determine whether the Expr is simple enough to be worth
@@ -2372,9 +2395,7 @@ is_safe_bool_expr_list([], _, _) -> true.
%% as a let or a sequence, move the original let body into the complex
%% expression.
-simplify_let(#c_let{arg=Arg0}=Let0, Sub) ->
- Arg = opt_bool_case(Arg0),
- Let = Let0#c_let{arg=Arg},
+simplify_let(#c_let{arg=Arg}=Let, Sub) ->
move_let_into_expr(Let, Arg, Sub).
move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner,
@@ -2630,11 +2651,10 @@ opt_simple_let_0(#c_let{arg=Arg0}=Let, Ctxt, Sub) ->
opt_simple_let_1(#c_let{vars=Vs0,body=B0}=Let, Arg0, Ctxt, Sub0) ->
%% Optimise let and add new substitutions.
- {Vs1,Args,Sub1} = let_substs(Vs0, Arg0, Sub0),
- BodySub = update_let_types(Vs1, Args, Sub1),
- B1 = body(B0, Ctxt, BodySub),
- Arg1 = core_lib:make_values(Args),
- {Vs,Arg,B} = opt_not_in_let(Vs1, Arg1, B1),
+ {Vs,Args,Sub1} = let_substs(Vs0, Arg0, Sub0),
+ BodySub = update_let_types(Vs, Args, Sub1),
+ B = body(B0, Ctxt, BodySub),
+ Arg = core_lib:make_values(Args),
opt_simple_let_2(Let, Vs, Arg, B, B0, Ctxt, Sub1).
opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) ->
@@ -2647,25 +2667,23 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) ->
false ->
%% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar
Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody),
- expr(#c_seq{arg=Arg,body=Body}, Ctxt,
- sub_new_preserve_types(Sub))
+ #c_seq{arg=Arg,body=Body}
end;
{[],#c_values{es=[]},_} ->
%% No variables left.
Body;
{Vs,Arg1,#c_literal{}} ->
Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody),
- E = case Ctxt of
- effect ->
- %% Throw away the literal body.
- Arg;
- value ->
- %% Since the variable is not used in the body, we
- %% can rewrite the let to a sequence.
- %% let <Var> = Arg in Literal ==> seq Arg Literal
- #c_seq{arg=Arg,body=Body}
- end,
- expr(E, Ctxt, sub_new_preserve_types(Sub));
+ case Ctxt of
+ effect ->
+ %% Throw away the literal body.
+ Arg;
+ value ->
+ %% Since the variable is not used in the body, we
+ %% can rewrite the let to a sequence.
+ %% let <Var> = Arg in Literal ==> seq Arg Literal
+ #c_seq{arg=Arg,body=Body}
+ end;
{Vs,Arg1,Body} ->
%% If none of the variables are used in the body, we can
%% rewrite the let to a sequence:
@@ -2674,12 +2692,10 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) ->
case is_any_var_used(Vs, Body) of
false ->
Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody),
- expr(#c_seq{arg=Arg,body=Body}, Ctxt,
- sub_new_preserve_types(Sub));
+ #c_seq{arg=Arg,body=Body};
true ->
Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body},
- Let2 = opt_bool_case_in_let(Let1, Sub),
- opt_case_in_let_arg(Let2, Ctxt, Sub)
+ opt_bool_case_in_let(Let1, Sub)
end
end.
@@ -2807,48 +2823,6 @@ move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer,
move_case_into_arg(_, _) ->
impossible.
-%% In guards only, rewrite a case in a let argument like
-%%
-%% let <Var> = case <> of
-%% <> when AnyGuard -> Literal1;
-%% <> when AnyGuard -> Literal2
-%% end
-%% in LetBody
-%%
-%% to
-%%
-%% case <> of
-%% <> when AnyGuard ->
-%% let <Var> = Literal1 in LetBody
-%% <> when 'true' ->
-%% let <Var> = Literal2 in LetBody
-%% end
-%%
-%% In the worst case, the size of the code could increase.
-%% In practice, though, substituting the literals into
-%% LetBody and doing constant folding will decrease the code
-%% size. (Doing this transformation outside of guards could
-%% lead to a substantational increase in code size.)
-%%
-opt_case_in_let_arg(#c_let{arg=#c_case{}=Case}=Let, Ctxt,
- #sub{in_guard=true}=Sub) ->
- opt_case_in_let_arg_1(Let, Case, Ctxt, Sub);
-opt_case_in_let_arg(Let, _, _) -> Let.
-
-opt_case_in_let_arg_1(Let0, #c_case{arg=#c_values{es=[]},
- clauses=Cs}=Case0, Ctxt, Sub) ->
- Let = mark_compiler_generated(Let0),
- case Cs of
- [#c_clause{body=#c_literal{}=BodyA}=Ca0,
- #c_clause{body=#c_literal{}=BodyB}=Cb0] ->
- Ca = Ca0#c_clause{body=Let#c_let{arg=BodyA}},
- Cb = Cb0#c_clause{body=Let#c_let{arg=BodyB}},
- Case = Case0#c_case{clauses=[Ca,Cb]},
- expr(Case, Ctxt, sub_new_preserve_types(Sub));
- _ -> Let
- end;
-opt_case_in_let_arg_1(Let, _, _, _) -> Let.
-
is_any_var_used([#c_var{name=V}|Vs], Expr) ->
case core_lib:is_var_used(V, Expr) of
false -> is_any_var_used(Vs, Expr);
@@ -2956,7 +2930,9 @@ returns_integer(bit_size, [_]) -> true;
returns_integer('bsl', [_,_]) -> true;
returns_integer('bsr', [_,_]) -> true;
returns_integer(byte_size, [_]) -> true;
+returns_integer(ceil, [_]) -> true;
returns_integer('div', [_,_]) -> true;
+returns_integer(floor, [_]) -> true;
returns_integer(length, [_]) -> true;
returns_integer('rem', [_,_]) -> true;
returns_integer('round', [_]) -> true;
@@ -2974,15 +2950,8 @@ update_types(Expr, Pat, #sub{t=Tdb0}=Sub) ->
Tdb = update_types_1(Expr, Pat, Tdb0),
Sub#sub{t=Tdb}.
-update_types_1(#c_var{name=V,anno=Anno}, Pat, Types) ->
- case member(reuse_for_context, Anno) of
- true ->
- %% If a variable has been marked for reuse of binary context,
- %% optimizations based on type information are unsafe.
- kill_types(V, Types);
- false ->
- update_types_2(V, Pat, Types)
- end;
+update_types_1(#c_var{name=V}, Pat, Types) ->
+ update_types_2(V, Pat, Types);
update_types_1(_, _, Types) -> Types.
update_types_2(V, [#c_tuple{}=P], Types) ->
@@ -3025,274 +2994,14 @@ copy_type(_, _, Tdb) -> Tdb.
void() -> #c_literal{val=ok}.
-%%%
-%%% Annotate bit syntax matching to faciliate optimization in further passes.
-%%%
-
-bsm_an(#c_case{arg=#c_var{}=V}=Case) ->
- bsm_an_1([V], Case);
-bsm_an(#c_case{arg=#c_values{es=Es}}=Case) ->
- bsm_an_1(Es, Case);
-bsm_an(Other) -> Other.
-
-bsm_an_1(Vs, #c_case{clauses=Cs}=Case) ->
- case bsm_leftmost(Cs) of
- none -> Case;
- Pos -> bsm_an_2(Vs, Cs, Case, Pos)
- end.
-
-bsm_an_2(Vs, Cs, Case, Pos) ->
- case bsm_nonempty(Cs, Pos) of
- true -> bsm_an_3(Vs, Cs, Case, Pos);
- false -> Case
- end.
-
-bsm_an_3(Vs, Cs, Case, Pos) ->
- try
- bsm_ensure_no_partition(Cs, Pos),
- bsm_do_an(Vs, Pos, Cs, Case)
- catch
- throw:{problem,Where,What} ->
- add_bin_opt_info(Where, What),
- Case
- end.
-
-bsm_do_an(Vs0, Pos, Cs0, Case) ->
- case nth(Pos, Vs0) of
- #c_var{name=Vname}=V0 ->
- Cs = bsm_do_an_var(Vname, Pos, Cs0, []),
- V = bsm_annotate_for_reuse(V0),
- Bef = lists:sublist(Vs0, Pos-1),
- Aft = lists:nthtail(Pos, Vs0),
- case Bef ++ [V|Aft] of
- [_] ->
- Case#c_case{arg=V,clauses=Cs};
- Vs ->
- Case#c_case{arg=#c_values{es=Vs},clauses=Cs}
- end;
- _ ->
- Case
- end.
-
-bsm_do_an_var(V, S, [#c_clause{pats=Ps,guard=G,body=B0}=C0|Cs], Acc) ->
- case nth(S, Ps) of
- #c_var{name=VarName} ->
- case core_lib:is_var_used(V, G) of
- true -> bsm_problem(C0, orig_bin_var_used_in_guard);
- false -> ok
- end,
- case core_lib:is_var_used(VarName, G) of
- true -> bsm_problem(C0, bin_var_used_in_guard);
- false -> ok
- end,
- B1 = bsm_maybe_ctx_to_binary(VarName, B0),
- B = bsm_maybe_ctx_to_binary(V, B1),
- C = C0#c_clause{body=B},
- bsm_do_an_var(V, S, Cs, [C|Acc]);
- #c_alias{}=P ->
- case bsm_could_match_binary(P) of
- false ->
- bsm_do_an_var(V, S, Cs, [C0|Acc]);
- true ->
- bsm_problem(C0, bin_opt_alias)
- end;
- P ->
- case bsm_could_match_binary(P) andalso bsm_is_var_used(V, G, B0) of
- false ->
- bsm_do_an_var(V, S, Cs, [C0|Acc]);
- true ->
- bsm_problem(C0, bin_var_used)
- end
- end;
-bsm_do_an_var(_, _, [], Acc) -> reverse(Acc).
-
-bsm_annotate_for_reuse(#c_var{anno=Anno}=Var) ->
- case member(reuse_for_context, Anno) of
- false -> Var#c_var{anno=[reuse_for_context|Anno]};
- true -> Var
- end.
-
-bsm_is_var_used(V, G, B) ->
- core_lib:is_var_used(V, G) orelse core_lib:is_var_used(V, B).
-
-bsm_maybe_ctx_to_binary(V, B) ->
- case core_lib:is_var_used(V, B) andalso not previous_ctx_to_binary(V, B) of
- false ->
- B;
- true ->
- #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary},
- args=[#c_var{name=V}]},
- body=B}
- end.
-
-previous_ctx_to_binary(V, Core) ->
- case Core of
- #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary},
- args=[#c_var{name=V}]}} ->
- true;
- _ ->
- false
- end.
-
-%% bsm_leftmost(Cs) -> none | ArgumentNumber
-%% Find the leftmost argument that does binary matching. Return
-%% the number of the argument (1-N).
-
-bsm_leftmost(Cs) ->
- bsm_leftmost_1(Cs, none).
-
-bsm_leftmost_1([#c_clause{pats=Ps}|Cs], Pos) ->
- bsm_leftmost_2(Ps, Cs, 1, Pos);
-bsm_leftmost_1([], Pos) -> Pos.
-
-bsm_leftmost_2(_, Cs, Pos, Pos) ->
- bsm_leftmost_1(Cs, Pos);
-bsm_leftmost_2([#c_binary{}|_], Cs, N, _) ->
- bsm_leftmost_1(Cs, N);
-bsm_leftmost_2([_|Ps], Cs, N, Pos) ->
- bsm_leftmost_2(Ps, Cs, N+1, Pos);
-bsm_leftmost_2([], Cs, _, Pos) ->
- bsm_leftmost_1(Cs, Pos).
-
-%% bsm_nonempty(Cs, Pos) -> true|false
-%% Check if at least one of the clauses matches a non-empty
-%% binary in the given argument position.
-%%
-bsm_nonempty([#c_clause{pats=Ps}|Cs], Pos) ->
- case nth(Pos, Ps) of
- #c_binary{segments=[_|_]} ->
- true;
- _ ->
- bsm_nonempty(Cs, Pos)
- end;
-bsm_nonempty([], _ ) -> false.
-
-%% bsm_ensure_no_partition(Cs, Pos) -> ok (exception if problem)
-%% We must make sure that matching is not partitioned between
-%% variables like this:
-%% foo(<<...>>) -> ...
-%% foo(<Variable>) when ... -> ...
-%% foo(<Any non-variable pattern>) ->
-%% If there is such partition, we are not allowed to reuse the binary variable
-%% for the match context.
-%%
-%% Also, arguments to the left of the argument that is matched
-%% against a binary, are only allowed to be simple variables, not
-%% used in guards. The reason is that we must know that the binary is
-%% only matched in one place (i.e. there must be only one bs_start_match2
-%% instruction emitted).
-
-bsm_ensure_no_partition(Cs, Pos) ->
- bsm_ensure_no_partition_1(Cs, Pos, before).
-
-%% Loop through each clause.
-bsm_ensure_no_partition_1([#c_clause{pats=Ps,guard=G}|Cs], Pos, State0) ->
- State = bsm_ensure_no_partition_2(Ps, Pos, G, simple_vars, State0),
- case State of
- 'after' ->
- bsm_ensure_no_partition_after(Cs, Pos);
- _ ->
- ok
- end,
- bsm_ensure_no_partition_1(Cs, Pos, State);
-bsm_ensure_no_partition_1([], _, _) -> ok.
-
-%% Loop through each pattern for this clause.
-bsm_ensure_no_partition_2([#c_binary{}=Where|_], 1, _, Vstate, State) ->
- case State of
- before when Vstate =:= simple_vars -> within;
- before -> bsm_problem(Where, Vstate);
- within when Vstate =:= simple_vars -> within;
- within -> bsm_problem(Where, Vstate)
- end;
-bsm_ensure_no_partition_2([#c_alias{}=Alias|_], 1, N, Vstate, State) ->
- %% Retrieve the real pattern that the alias refers to and check that.
- P = bsm_real_pattern(Alias),
- bsm_ensure_no_partition_2([P], 1, N, Vstate, State);
-bsm_ensure_no_partition_2([_|_], 1, _, _Vstate, before=State) ->
- %% No binary matching yet - therefore no partition.
- State;
-bsm_ensure_no_partition_2([P|_], 1, _, Vstate, State) ->
- case bsm_could_match_binary(P) of
- false ->
- %% If clauses can be freely arranged (Vstate =:= simple_vars),
- %% a clause that cannot match a binary will not partition the clause.
- %% Example:
- %%
- %% a(Var, <<>>) -> ...
- %% a(Var, []) -> ...
- %% a(Var, <<B>>) -> ...
- %%
- %% But if the clauses can't be freely rearranged, as in
- %%
- %% b(Var, <<X>>) -> ...
- %% b(1, 2) -> ...
- %%
- %% we do have a problem.
- %%
- case Vstate of
- simple_vars -> State;
- _ -> bsm_problem(P, Vstate)
- end;
- true ->
- %% The pattern P *may* match a binary, so we must update the state.
- %% (P must be a variable.)
- case State of
- within -> 'after';
- 'after' -> 'after'
- end
- end;
-bsm_ensure_no_partition_2([#c_var{name=V}|Ps], N, G, Vstate, S) ->
- case core_lib:is_var_used(V, G) of
- false ->
- bsm_ensure_no_partition_2(Ps, N-1, G, Vstate, S);
- true ->
- bsm_ensure_no_partition_2(Ps, N-1, G, bin_left_var_used_in_guard, S)
- end;
-bsm_ensure_no_partition_2([_|Ps], N, G, _, S) ->
- bsm_ensure_no_partition_2(Ps, N-1, G, bin_argument_order, S).
-
-bsm_ensure_no_partition_after([#c_clause{pats=Ps}=C|Cs], Pos) ->
- case nth(Pos, Ps) of
- #c_var{} ->
- bsm_ensure_no_partition_after(Cs, Pos);
- _ ->
- bsm_problem(C, bin_partition)
- end;
-bsm_ensure_no_partition_after([], _) -> ok.
-
-bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P);
-bsm_could_match_binary(#c_cons{}) -> false;
-bsm_could_match_binary(#c_tuple{}) -> false;
-bsm_could_match_binary(#c_literal{val=Lit}) -> is_bitstring(Lit);
-bsm_could_match_binary(_) -> true.
-
-bsm_real_pattern(#c_alias{pat=P}) -> bsm_real_pattern(P);
-bsm_real_pattern(P) -> P.
-
-bsm_problem(Where, What) ->
- throw({problem,Where,What}).
%%%
%%% Handling of warnings.
%%%
-mark_compiler_generated(Term) ->
- cerl_trees:map(fun mark_compiler_generated_1/1, Term).
-
-mark_compiler_generated_1(#c_call{anno=Anno}=Term) ->
- Term#c_call{anno=[compiler_generated|Anno--[compiler_generated]]};
-mark_compiler_generated_1(Term) -> Term.
-
init_warnings() ->
put({?MODULE,warnings}, []).
-add_bin_opt_info(Core, Term) ->
- case get(bin_opt_info) of
- true -> add_warning(Core, Term);
- false -> ok
- end.
-
add_warning(Core, Term) ->
case should_suppress_warning(Core) of
true ->
@@ -3414,28 +3123,7 @@ format_error(result_ignored) ->
format_error(invalid_call) ->
"invalid function call";
format_error(useless_building) ->
- "a term is constructed, but never used";
-format_error(bin_opt_alias) ->
- "INFO: the '=' operator will prevent delayed sub binary optimization";
-format_error(bin_partition) ->
- "INFO: matching non-variables after a previous clause matching a variable "
- "will prevent delayed sub binary optimization";
-format_error(bin_left_var_used_in_guard) ->
- "INFO: a variable to the left of the binary pattern is used in a guard; "
- "will prevent delayed sub binary optimization";
-format_error(bin_argument_order) ->
- "INFO: matching anything else but a plain variable to the left of "
- "binary pattern will prevent delayed sub binary optimization; "
- "SUGGEST changing argument order";
-format_error(bin_var_used) ->
- "INFO: using a matched out sub binary will prevent "
- "delayed sub binary optimization";
-format_error(orig_bin_var_used_in_guard) ->
- "INFO: using the original binary variable in a guard will prevent "
- "delayed sub binary optimization";
-format_error(bin_var_used_in_guard) ->
- "INFO: using a matched out sub binary in a guard will prevent "
- "delayed sub binary optimization".
+ "a term is constructed, but never used".
-ifdef(DEBUG).
%% In order for simplify_let/2 to work correctly, the list of
@@ -3446,12 +3134,18 @@ format_error(bin_var_used_in_guard) ->
verify_scope(E, #sub{s=Scope}) ->
Free0 = cerl_trees:free_variables(E),
Free = [V || V <- Free0, not is_tuple(V)], %Ignore function names.
- case ordsets:is_subset(Free, cerl_sets:to_list(Scope)) of
- true -> true;
+ case is_subset_of_scope(Free, Scope) of
+ true ->
+ true;
false ->
io:format("~p\n", [E]),
io:format("~p\n", [Free]),
- io:format("~p\n", [cerl_sets:to_list(Scope)]),
+ io:format("~p\n", [ordsets:from_list(cerl_sets:to_list(Scope))]),
false
end.
+
+is_subset_of_scope([V|Vs], Scope) ->
+ cerl_sets:is_element(V, Scope) andalso is_subset_of_scope(Vs, Scope);
+is_subset_of_scope([], _) -> true.
+
-endif.
diff --git a/lib/compiler/src/sys_pre_attributes.erl b/lib/compiler/src/sys_pre_attributes.erl
index bc93c85989..67adae5acf 100644
--- a/lib/compiler/src/sys_pre_attributes.erl
+++ b/lib/compiler/src/sys_pre_attributes.erl
@@ -25,10 +25,10 @@
-define(OPTION_TAG, attributes).
--record(state, {forms,
- pre_ops = [],
- post_ops = [],
- options}).
+-record(state, {forms :: [form()],
+ pre_ops = [] :: [op()],
+ post_ops = [] :: [op()],
+ options :: [option()]}).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Inserts, deletes and replaces Erlang compiler attributes.
@@ -59,9 +59,23 @@
%% due to that the pre_transform pass did not find the attribute plus
%% all insert operations.
+-type attribute() :: atom().
+-type value() :: term().
+-type form() :: {function, integer(), atom(), arity(), _}
+ | {attribute, integer(), attribute(), _}.
+-type option() :: compile:option()
+ | {'attribute', 'insert', attribute(), value()}
+ | {'attribute', 'replace', attribute(), value()}
+ | {'attribute', 'delete', attribute()}.
+-type op() :: {'insert', attribute(), value()}
+ | {'replace', attribute(), value()}
+ | {'delete', attribute()}.
+
+-spec parse_transform([form()], [option()]) -> [form()].
+
parse_transform(Forms, Options) ->
S = #state{forms = Forms, options = Options},
- S2 = init_transform(S),
+ S2 = init_transform(Options, 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),
@@ -71,13 +85,6 @@ parse_transform(Forms, Options) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% 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 is_list(Options) ->
- init_transform(Options, S);
- Option ->
- init_transform([Option], S)
- end.
init_transform([{attribute, insert, Name, Val} | Tail], S) ->
Op = {insert, Name, Val},
@@ -92,12 +99,9 @@ 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),
+init_transform([], S) ->
S.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -176,18 +180,9 @@ 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 ->
@@ -204,9 +199,6 @@ report_verbose(Format, Args, S) ->
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).
diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
deleted file mode 100644
index 7ab4e1845c..0000000000
--- a/lib/compiler/src/sys_pre_expand.erl
+++ /dev/null
@@ -1,616 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2015. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%% Purpose : Expand some source Erlang constructions. This is part of the
-%% pre-processing phase.
-
-%% N.B. Although structs (tagged tuples) are not yet allowed in the
-%% language there is code included in pattern/2 and expr/3 (commented out)
-%% that handles them by transforming them to tuples.
-
--module(sys_pre_expand).
-
-%% Main entry point.
--export([module/2]).
-
--import(lists, [member/2,foldl/3,foldr/3]).
-
--type fa() :: {atom(), arity()}.
-
--record(expand, {module=[], %Module name
- exports=[], %Exports
- attributes=[], %Attributes
- callbacks=[], %Callbacks
- optional_callbacks=[] :: [fa()], %Optional callbacks
- vcount=0, %Variable counter
- func=[], %Current function
- arity=[], %Arity for current function
- fcount=0, %Local fun count
- ctype %Call type map
- }).
-
-%% module(Forms, CompileOptions)
-%% {ModuleName,Exports,TransformedForms,CompileOptions'}
-%% Expand the forms in one module.
-%%
-%% CompileOptions is augmented with options from -compile attributes.
-
-module(Fs0, Opts0) ->
-
- %% Expand records. Normalise guard tests.
- Fs = erl_expand_records:module(Fs0, Opts0),
-
- Opts = compiler_options(Fs) ++ Opts0,
-
- %% Set pre-defined exported functions.
- PreExp = [{module_info,0},{module_info,1}],
-
- %% Build the set of defined functions and the initial call
- %% type map.
- Defined = defined_functions(Fs, PreExp),
- Ctype = maps:from_list([{K,local} || K <- Defined]),
-
- %% Build initial expand record.
- St0 = #expand{exports=PreExp,
- ctype=Ctype
- },
-
- %% Expand the functions.
- {Tfs,St1} = forms(Fs, St0),
-
- %% Get the correct list of exported functions.
- Exports = case member(export_all, Opts) of
- true -> Defined;
- false -> St1#expand.exports
- end,
- St2 = St1#expand{exports=Exports,ctype=undefined},
-
- %% Generate all functions from stored info.
- {Ats,St3} = module_attrs(St2),
- {Mfs,St4} = module_predef_funcs(St3),
- {St4#expand.module, St4#expand.exports, Ats ++ Tfs ++ Mfs,
- Opts}.
-
-compiler_options(Forms) ->
- lists:flatten([C || {attribute,_,compile,C} <- Forms]).
-
-%% defined_function(Forms, Predef) -> Functions.
-%% Add function to defined if form is a function.
-
-defined_functions(Forms, Predef) ->
- Fs = foldl(fun({function,_,N,A,_Cs}, Acc) -> [{N,A}|Acc];
- (_, Acc) -> Acc
- end, Predef, Forms),
- ordsets:from_list(Fs).
-
-module_attrs(#expand{attributes=Attributes}=St) ->
- Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes],
- Callbacks = [Callback || {_,_,callback,_}=Callback <- Attrs],
- OptionalCallbacks = get_optional_callbacks(Attrs),
- {Attrs,St#expand{callbacks=Callbacks,
- optional_callbacks=OptionalCallbacks}}.
-
-get_optional_callbacks(Attrs) ->
- L = [O ||
- {attribute, _, optional_callbacks, O} <- Attrs,
- is_fa_list(O)],
- lists:append(L).
-
-is_fa_list([{FuncName, Arity}|L])
- when is_atom(FuncName), is_integer(Arity), Arity >= 0 ->
- is_fa_list(L);
-is_fa_list([]) -> true;
-is_fa_list(_) -> false.
-
-module_predef_funcs(St0) ->
- {Mpf1,St1} = module_predef_func_beh_info(St0),
- Mpf2 = module_predef_funcs_mod_info(St1),
- Mpf = [erl_parse:new_anno(F) || F <- Mpf1++Mpf2],
- {Mpf,St1}.
-
-module_predef_func_beh_info(#expand{callbacks=[]}=St) ->
- {[], St};
-module_predef_func_beh_info(#expand{callbacks=Callbacks,
- optional_callbacks=OptionalCallbacks,
- exports=Exports}=St) ->
- PreDef0 = [{behaviour_info,1}],
- PreDef = ordsets:from_list(PreDef0),
- {[gen_beh_info(Callbacks, OptionalCallbacks)],
- St#expand{exports=ordsets:union(PreDef, Exports)}}.
-
-gen_beh_info(Callbacks, OptionalCallbacks) ->
- List = make_list(Callbacks),
- OptionalList = make_optional_list(OptionalCallbacks),
- {function,0,behaviour_info,1,
- [{clause,0,[{atom,0,callbacks}],[],
- [List]},
- {clause,0,[{atom,0,optional_callbacks}],[],
- [OptionalList]}]}.
-
-make_list([]) -> {nil,0};
-make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) ->
- {cons,0,
- {tuple,0,
- [{atom,0,Name},
- {integer,0,Arity}]},
- make_list(Rest)}.
-
-make_optional_list([]) -> {nil,0};
-make_optional_list([{Name,Arity}|Rest]) ->
- {cons,0,
- {tuple,0,
- [{atom,0,Name},
- {integer,0,Arity}]},
- make_optional_list(Rest)}.
-
-module_predef_funcs_mod_info(#expand{module=Mod}) ->
- ModAtom = {atom,0,Mod},
- [{function,0,module_info,0,
- [{clause,0,[],[],
- [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}},
- [ModAtom]}]}]},
- {function,0,module_info,1,
- [{clause,0,[{var,0,'X'}],[],
- [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}},
- [ModAtom,{var,0,'X'}]}]}]}].
-
-%% forms(Forms, State) ->
-%% {TransformedForms,State'}
-%% Process the forms. Attributes are lost and just affect the state.
-%% Ignore uninteresting forms like eof and type.
-
-forms([{attribute,_,file,_File}=F|Fs0], St0) ->
- {Fs,St1} = forms(Fs0, St0),
- {[F|Fs],St1};
-forms([{attribute,Line,Name,Val}|Fs0], St0) ->
- St1 = attribute(Name, Val, Line, St0),
- forms(Fs0, St1);
-forms([{function,L,N,A,Cs}|Fs0], St0) ->
- {Ff,St1} = function(L, N, A, Cs, St0),
- {Fs,St2} = forms(Fs0, St1),
- {[Ff|Fs],St2};
-forms([_|Fs], St) -> forms(Fs, St);
-forms([], St) -> {[],St}.
-
-%% attribute(Attribute, Value, Line, State) -> State'.
-%% Process an attribute, this just affects the state.
-
-attribute(module, Module, _L, St) ->
- true = is_atom(Module),
- St#expand{module=Module};
-attribute(export, Es, _L, St) ->
- St#expand{exports=ordsets:union(ordsets:from_list(Es),
- St#expand.exports)};
-attribute(import, Is, _L, St) ->
- import(Is, St);
-attribute(compile, _C, _L, St) ->
- St;
-attribute(Name, Val, Line, St) when is_list(Val) ->
- St#expand{attributes=St#expand.attributes ++ [{Name,Line,Val}]};
-attribute(Name, Val, Line, St) ->
- St#expand{attributes=St#expand.attributes ++ [{Name,Line,[Val]}]}.
-
-function(L, N, A, Cs0, St0) ->
- {Cs,St} = clauses(Cs0, St0#expand{func=N,arity=A,fcount=0}),
- {{function,L,N,A,Cs},St}.
-
-%% clauses([Clause], State) ->
-%% {[TransformedClause],State}.
-%% Expand function clauses.
-
-clauses([{clause,Line,H0,G0,B0}|Cs0], St0) ->
- {H,St1} = head(H0, St0),
- {G,St2} = guard(G0, St1),
- {B,St3} = exprs(B0, St2),
- {Cs,St4} = clauses(Cs0, St3),
- {[{clause,Line,H,G,B}|Cs],St4};
-clauses([], St) -> {[],St}.
-
-%% head(HeadPatterns, State) ->
-%% {TransformedPatterns,Variables,UsedVariables,State'}
-
-head(As, St) -> pattern_list(As, St).
-
-%% pattern(Pattern, State) ->
-%% {TransformedPattern,State'}
-%%
-
-pattern({var,_,_}=Var, St) ->
- {Var,St};
-pattern({char,_,_}=Char, St) ->
- {Char,St};
-pattern({integer,_,_}=Int, St) ->
- {Int,St};
-pattern({float,_,_}=Float, St) ->
- {Float,St};
-pattern({atom,_,_}=Atom, St) ->
- {Atom,St};
-pattern({string,_,_}=String, St) ->
- {String,St};
-pattern({nil,_}=Nil, St) ->
- {Nil,St};
-pattern({cons,Line,H,T}, St0) ->
- {TH,St1} = pattern(H, St0),
- {TT,St2} = pattern(T, St1),
- {{cons,Line,TH,TT},St2};
-pattern({tuple,Line,Ps}, St0) ->
- {TPs,St1} = pattern_list(Ps, St0),
- {{tuple,Line,TPs},St1};
-pattern({map,Line,Ps}, St0) ->
- {TPs,St1} = pattern_list(Ps, St0),
- {{map,Line,TPs},St1};
-pattern({map_field_exact,Line,K0,V0}, St0) ->
- %% Key should be treated as an expression
- %% but since expressions are not allowed yet,
- %% process it through pattern .. and handle assoc
- %% (normalise unary op integer -> integer)
- {K,St1} = pattern(K0, St0),
- {V,St2} = pattern(V0, St1),
- {{map_field_exact,Line,K,V},St2};
-pattern({map_field_assoc,Line,K0,V0}, St0) ->
- %% when keys are Maps
- {K,St1} = pattern(K0, St0),
- {V,St2} = pattern(V0, St1),
- {{map_field_assoc,Line,K,V},St2};
-%%pattern({struct,Line,Tag,Ps}, St0) ->
-%% {TPs,TPsvs,St1} = pattern_list(Ps, St0),
-%% {{tuple,Line,[{atom,Line,Tag}|TPs]},TPsvs,St1};
-pattern({bin,Line,Es0}, St0) ->
- {Es1,St1} = pattern_bin(Es0, St0),
- {{bin,Line,Es1},St1};
-pattern({op,_,'++',{nil,_},R}, St) ->
- pattern(R, St);
-pattern({op,_,'++',{cons,Li,H,T},R}, St) ->
- pattern({cons,Li,H,{op,Li,'++',T,R}}, St);
-pattern({op,_,'++',{string,Li,L},R}, St) ->
- pattern(string_to_conses(Li, L, R), St);
-pattern({match,Line,Pat1, Pat2}, St0) ->
- {TH,St1} = pattern(Pat2, St0),
- {TT,St2} = pattern(Pat1, St1),
- {{match,Line,TT,TH},St2};
-%% Compile-time pattern expressions, including unary operators.
-pattern({op,_Line,_Op,_A}=Op, St) ->
- {erl_eval:partial_eval(Op),St};
-pattern({op,_Line,_Op,_L,_R}=Op, St) ->
- {erl_eval:partial_eval(Op),St}.
-
-pattern_list([P0|Ps0], St0) ->
- {P,St1} = pattern(P0, St0),
- {Ps,St2} = pattern_list(Ps0, St1),
- {[P|Ps],St2};
-pattern_list([], St) -> {[],St}.
-
-%% guard(Guard, State) ->
-%% {TransformedGuard,State'}
-%% Transform a list of guard tests. We KNOW that this has been checked
-%% and what the guards test are. Use expr for transforming the guard
-%% expressions.
-
-guard([G0|Gs0], St0) ->
- {G,St1} = guard_tests(G0, St0),
- {Gs,St2} = guard(Gs0, St1),
- {[G|Gs],St2};
-guard([], St) -> {[],St}.
-
-guard_tests([Gt0|Gts0], St0) ->
- {Gt1,St1} = guard_test(Gt0, St0),
- {Gts1,St2} = guard_tests(Gts0, St1),
- {[Gt1|Gts1],St2};
-guard_tests([], St) -> {[],St}.
-
-guard_test(Test, St) ->
- expr(Test, St).
-
-%% exprs(Expressions, State) ->
-%% {TransformedExprs,State'}
-
-exprs([E0|Es0], St0) ->
- {E,St1} = expr(E0, St0),
- {Es,St2} = exprs(Es0, St1),
- {[E|Es],St2};
-exprs([], St) -> {[],St}.
-
-%% expr(Expression, State) ->
-%% {TransformedExpression,State'}
-
-expr({var,_,_}=Var, St) ->
- {Var,St};
-expr({char,_,_}=Char, St) ->
- {Char,St};
-expr({integer,_,_}=Int, St) ->
- {Int,St};
-expr({float,_,_}=Float, St) ->
- {Float,St};
-expr({atom,_,_}=Atom, St) ->
- {Atom,St};
-expr({string,_,_}=String, St) ->
- {String,St};
-expr({nil,_}=Nil, St) ->
- {Nil,St};
-expr({cons,Line,H0,T0}, St0) ->
- {H,St1} = expr(H0, St0),
- {T,St2} = expr(T0, St1),
- {{cons,Line,H,T},St2};
-expr({lc,Line,E0,Qs0}, St0) ->
- {Qs1,St1} = lc_tq(Line, Qs0, St0),
- {E1,St2} = expr(E0, St1),
- {{lc,Line,E1,Qs1},St2};
-expr({bc,Line,E0,Qs0}, St0) ->
- {Qs1,St1} = lc_tq(Line, Qs0, St0),
- {E1,St2} = expr(E0, St1),
- {{bc,Line,E1,Qs1},St2};
-expr({tuple,Line,Es0}, St0) ->
- {Es1,St1} = expr_list(Es0, St0),
- {{tuple,Line,Es1},St1};
-%%expr({struct,Line,Tag,Es0}, Vs, St0) ->
-%% {Es1,Esvs,Esus,St1} = expr_list(Es0, Vs, St0),
-%% {{tuple,Line,[{atom,Line,Tag}|Es1]},Esvs,Esus,St1};
-expr({map,Line,Es0}, St0) ->
- {Es1,St1} = expr_list(Es0, St0),
- {{map,Line,Es1},St1};
-expr({map,Line,E0,Es0}, St0) ->
- {E1,St1} = expr(E0, St0),
- {Es1,St2} = expr_list(Es0, St1),
- {{map,Line,E1,Es1},St2};
-expr({map_field_assoc,Line,K0,V0}, St0) ->
- {K,St1} = expr(K0, St0),
- {V,St2} = expr(V0, St1),
- {{map_field_assoc,Line,K,V},St2};
-expr({map_field_exact,Line,K0,V0}, St0) ->
- {K,St1} = expr(K0, St0),
- {V,St2} = expr(V0, St1),
- {{map_field_exact,Line,K,V},St2};
-expr({bin,Line,Es0}, St0) ->
- {Es1,St1} = expr_bin(Es0, St0),
- {{bin,Line,Es1},St1};
-expr({block,Line,Es0}, St0) ->
- {Es,St1} = exprs(Es0, St0),
- {{block,Line,Es},St1};
-expr({'if',Line,Cs0}, St0) ->
- {Cs,St1} = clauses(Cs0, St0),
- {{'if',Line,Cs},St1};
-expr({'case',Line,E0,Cs0}, St0) ->
- {E,St1} = expr(E0, St0),
- {Cs,St2} = clauses(Cs0, St1),
- {{'case',Line,E,Cs},St2};
-expr({'receive',Line,Cs0}, St0) ->
- {Cs,St1} = clauses(Cs0, St0),
- {{'receive',Line,Cs},St1};
-expr({'receive',Line,Cs0,To0,ToEs0}, St0) ->
- {To,St1} = expr(To0, St0),
- {ToEs,St2} = exprs(ToEs0, St1),
- {Cs,St3} = clauses(Cs0, St2),
- {{'receive',Line,Cs,To,ToEs},St3};
-expr({'fun',Line,Body}, St) ->
- fun_tq(Line, Body, St);
-expr({named_fun,Line,Name,Cs}, St) ->
- fun_tq(Line, Cs, St, Name);
-expr({call,Line,{atom,La,N}=Atom,As0}, St0) ->
- {As,St1} = expr_list(As0, St0),
- Ar = length(As),
- Key = {N,Ar},
- case St1#expand.ctype of
- #{Key:=local} ->
- {{call,Line,Atom,As},St1};
- #{Key:={imported,Mod}} ->
- {{call,Line,{remote,La,{atom,La,Mod},Atom},As},St1};
- _ ->
- true = erl_internal:bif(N, Ar),
- {{call,Line,{remote,La,{atom,La,erlang},Atom},As},St1}
- end;
-expr({call,Line,{remote,Lr,M0,F},As0}, St0) ->
- {[M1,F1|As1],St1} = expr_list([M0,F|As0], St0),
- {{call,Line,{remote,Lr,M1,F1},As1},St1};
-expr({call,Line,F,As0}, St0) ->
- {[Fun1|As1],St1} = expr_list([F|As0], St0),
- {{call,Line,Fun1,As1},St1};
-expr({'try',Line,Es0,Scs0,Ccs0,As0}, St0) ->
- {Es1,St1} = exprs(Es0, St0),
- {Scs1,St2} = clauses(Scs0, St1),
- {Ccs1,St3} = clauses(Ccs0, St2),
- {As1,St4} = exprs(As0, St3),
- {{'try',Line,Es1,Scs1,Ccs1,As1},St4};
-expr({'catch',Line,E0}, St0) ->
- {E,St1} = expr(E0, St0),
- {{'catch',Line,E},St1};
-expr({match,Line,P0,E0}, St0) ->
- {E,St1} = expr(E0, St0),
- {P,St2} = pattern(P0, St1),
- {{match,Line,P,E},St2};
-expr({op,Line,Op,A0}, St0) ->
- {A,St1} = expr(A0, St0),
- {{op,Line,Op,A},St1};
-expr({op,Line,Op,L0,R0}, St0) ->
- {L,St1} = expr(L0, St0),
- {R,St2} = expr(R0, St1),
- {{op,Line,Op,L,R},St2}.
-
-expr_list([E0|Es0], St0) ->
- {E,St1} = expr(E0, St0),
- {Es,St2} = expr_list(Es0, St1),
- {[E|Es],St2};
-expr_list([], St) -> {[],St}.
-
-%% lc_tq(Line, Qualifiers, State) ->
-%% {[TransQual],State'}
-
-lc_tq(Line, [{generate,Lg,P0,G0} | Qs0], St0) ->
- {G1,St1} = expr(G0, St0),
- {P1,St2} = pattern(P0, St1),
- {Qs1,St3} = lc_tq(Line, Qs0, St2),
- {[{generate,Lg,P1,G1} | Qs1],St3};
-
-lc_tq(Line, [{b_generate,Lg,P0,G0}|Qs0], St0) ->
- {G1,St1} = expr(G0, St0),
- {P1,St2} = pattern(P0, St1),
- {Qs1,St3} = lc_tq(Line, Qs0, St2),
- {[{b_generate,Lg,P1,G1}|Qs1],St3};
-lc_tq(Line, [F0 | Qs0], St0) ->
- {F1,St1} = expr(F0, St0),
- {Qs1,St2} = lc_tq(Line, Qs0, St1),
- {[F1|Qs1],St2};
-lc_tq(_Line, [], St0) ->
- {[],St0}.
-
-
-%% fun_tq(Line, Body, State) ->
-%% {Fun,State'}
-%% Transform an "explicit" fun {'fun', Line, {clauses, Cs}} into an
-%% extended form {'fun', Line, {clauses, Cs}, Info}, unless it is the
-%% name of a BIF (erl_lint has checked that it is not an import).
-%% "Implicit" funs {'fun', Line, {function, F, A}} are not changed.
-
-fun_tq(Lf, {function,F,A}=Function, St0) ->
- case erl_internal:bif(F, A) of
- true ->
- {As,St1} = new_vars(A, Lf, St0),
- Cs = [{clause,Lf,As,[],[{call,Lf,{atom,Lf,F},As}]}],
- fun_tq(Lf, {clauses,Cs}, St1);
- false ->
- {Fname,St1} = new_fun_name(St0),
- Index = Uniq = 0,
- {{'fun',Lf,Function,{Index,Uniq,Fname}},St1}
- end;
-fun_tq(L, {function,M,F,A}, St) when is_atom(M), is_atom(F), is_integer(A) ->
- %% This is the old format for external funs, generated by a pre-R15
- %% compiler. That means that a tool, such as the debugger or xref,
- %% directly invoked this module with the abstract code from a
- %% pre-R15 BEAM file. Be helpful, and translate it to the new format.
- fun_tq(L, {function,{atom,L,M},{atom,L,F},{integer,L,A}}, St);
-fun_tq(Lf, {function,_,_,_}=ExtFun, St) ->
- {{'fun',Lf,ExtFun},St};
-fun_tq(Lf, {clauses,Cs0}, St0) ->
- {Cs1,St1} = clauses(Cs0, St0),
- {Fname,St2} = new_fun_name(St1),
- %% Set dummy values for Index and Uniq -- the real values will
- %% be assigned by beam_asm.
- Index = Uniq = 0,
- {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},St2}.
-
-fun_tq(Line, Cs0, St0, Name) ->
- {Cs1,St1} = clauses(Cs0, St0),
- {Fname,St2} = new_fun_name(St1, Name),
- {{named_fun,Line,Name,Cs1,{0,0,Fname}},St2}.
-
-%% new_fun_name(State) -> {FunName,State}.
-
-new_fun_name(St) ->
- new_fun_name(St, 'fun').
-
-new_fun_name(#expand{func=F,arity=A,fcount=I}=St, FName) ->
- Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A)
- ++ "-" ++ atom_to_list(FName) ++ "-" ++ integer_to_list(I) ++ "-",
- {list_to_atom(Name),St#expand{fcount=I+1}}.
-
-%% pattern_bin([Element], State) -> {[Element],[Variable],[UsedVar],State}.
-
-pattern_bin(Es0, St) ->
- Es1 = bin_expand_strings(Es0),
- foldr(fun (E, Acc) -> pattern_element(E, Acc) end, {[],St}, Es1).
-
-pattern_element({bin_element,Line,Expr0,Size0,Type0}, {Es,St0}) ->
- {Expr1,St1} = pattern(Expr0, St0),
- {Size1,St2} = pat_bit_size(Size0, St1),
- {Size,Type} = make_bit_type(Line, Size1, Type0),
- Expr = coerce_to_float(Expr1, Type0),
- {[{bin_element,Line,Expr,Size,Type}|Es],St2}.
-
-pat_bit_size(default, St) -> {default,St};
-pat_bit_size({var,_Lv,_V}=Var, St) -> {Var,St};
-pat_bit_size(Size, St) ->
- Line = element(2, Size),
- {value,Sz,_} = erl_eval:expr(Size, erl_eval:new_bindings()),
- {{integer,Line,Sz},St}.
-
-make_bit_type(Line, default, Type0) ->
- case erl_bits:set_bit_type(default, Type0) of
- {ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)};
- {ok,undefined,Bt} -> {{atom,Line,undefined},erl_bits:as_list(Bt)};
- {ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)}
- end;
-make_bit_type(_Line, Size, Type0) -> %Integer or 'all'
- {ok,Size,Bt} = erl_bits:set_bit_type(Size, Type0),
- {Size,erl_bits:as_list(Bt)}.
-
-coerce_to_float({integer,L,I}=E, [float|_]) ->
- try
- {float,L,float(I)}
- catch
- error:badarg -> E
- end;
-coerce_to_float(E, _) -> E.
-
-%% expr_bin([Element], State) -> {[Element],State}.
-
-expr_bin(Es0, St) ->
- Es1 = bin_expand_strings(Es0),
- foldr(fun (E, Acc) -> bin_element(E, Acc) end, {[],St}, Es1).
-
-bin_element({bin_element,Line,Expr,Size,Type}, {Es,St0}) ->
- {Expr1,St1} = expr(Expr, St0),
- {Size1,St2} = if Size == default -> {default,St1};
- true -> expr(Size, St1)
- end,
- {Size2,Type1} = make_bit_type(Line, Size1, Type),
- {[{bin_element,Line,Expr1,Size2,Type1}|Es],St2}.
-
-bin_expand_strings(Es) ->
- foldr(fun ({bin_element,Line,{string,_,S},Sz,Ts}, Es1) ->
- foldr(fun (C, Es2) ->
- [{bin_element,Line,{char,Line,C},Sz,Ts}|Es2]
- end, Es1, S);
- (E, Es1) -> [E|Es1]
- end, [], Es).
-
-%% new_var_name(State) -> {VarName,State}.
-
-new_var_name(St) ->
- C = St#expand.vcount,
- {list_to_atom("pre" ++ integer_to_list(C)),St#expand{vcount=C+1}}.
-
-%% new_var(Line, State) -> {Var,State}.
-
-new_var(L, St0) ->
- {New,St1} = new_var_name(St0),
- {{var,L,New},St1}.
-
-%% new_vars(Count, Line, State) -> {[Var],State}.
-%% Make Count new variables.
-
-new_vars(N, L, St) -> new_vars(N, L, St, []).
-
-new_vars(N, L, St0, Vs) when N > 0 ->
- {V,St1} = new_var(L, St0),
- new_vars(N-1, L, St1, [V|Vs]);
-new_vars(0, _L, St, Vs) -> {Vs,St}.
-
-string_to_conses(Line, Cs, Tail) ->
- foldr(fun (C, T) -> {cons,Line,{char,Line,C},T} end, Tail, Cs).
-
-
-%% import(Line, Imports, State) ->
-%% State'
-%% Handle import declarations.
-
-import({Mod,Fs}, #expand{ctype=Ctype0}=St) ->
- true = is_atom(Mod),
- Ctype = foldl(fun(F, A) ->
- A#{F=>{imported,Mod}}
- end, Ctype0, Fs),
- St#expand{ctype=Ctype}.
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index 4df1aadd0a..47c1567f10 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -69,6 +69,10 @@
stk=[], %Stack table
res=[]}). %Reserved regs: [{reserved,I,V}]
+-type life_module() :: {module(),_,_,[_]}.
+
+-spec module(life_module(), [compile:option()]) -> {'ok',beam_asm:module_code()}.
+
module({Mod,Exp,Attr,Forms}, _Options) ->
{Fs,St} = functions(Forms, {atom,Mod}),
{ok,{Mod,Exp,Attr,Fs,St#cg.lcount}}.
@@ -151,6 +155,8 @@ cg({bif,Bif,As,Rs}, Le, Vdb, Bef, St) ->
bif_cg(Bif, As, Rs, Le, Vdb, Bef, St);
cg({gc_bif,Bif,As,Rs}, Le, Vdb, Bef, St) ->
gc_bif_cg(Bif, As, Rs, Le, Vdb, Bef, St);
+cg({internal,Bif,As,Rs}, Le, Vdb, Bef, St) ->
+ internal_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) ->
@@ -208,15 +214,10 @@ need_heap_1(#l{ke={set,_,Val}}, H) ->
{tuple,Es} -> 1 + length(Es);
_Other -> 0
end};
-need_heap_1(#l{ke={bif,dsetelement,_As,_Rs},i=I}, H) ->
- {need_heap_need(I, H),0};
-need_heap_1(#l{ke={bif,{make_fun,_,_,_,_},_As,_Rs},i=I}, H) ->
- {need_heap_need(I, H),0};
-need_heap_1(#l{ke={bif,bs_init_writable,_As,_Rs},i=I}, H) ->
- {need_heap_need(I, H),0};
need_heap_1(#l{ke={bif,_Bif,_As,_Rs}}, H) ->
{[],H};
need_heap_1(#l{i=I}, H) ->
+ %% Call or call-like instruction such as set_tuple_element/3.
{need_heap_need(I, H),0}.
need_heap_need(_I, 0) -> [];
@@ -366,7 +367,7 @@ bsm_rename_ctx(#l{ke={match,Ms0,Rs}}=L, Old, New, InProt) ->
bsm_rename_ctx(#l{ke={guard_match,Ms0,Rs}}=L, Old, New, InProt) ->
Ms = bsm_rename_ctx(Ms0, Old, New, InProt),
L#l{ke={guard_match,Ms,Rs}};
-bsm_rename_ctx(#l{ke={test,_,_}}=L, _, _, _) -> L;
+bsm_rename_ctx(#l{ke={test,_,_,_}}=L, _, _, _) -> L;
bsm_rename_ctx(#l{ke={bif,_,_,_}}=L, _, _, _) -> L;
bsm_rename_ctx(#l{ke={gc_bif,_,_,_}}=L, _, _, _) -> L;
bsm_rename_ctx(#l{ke={set,_,_}}=L, _, _, _) -> L;
@@ -1054,8 +1055,15 @@ 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(#l{ke={test,Test,As,Inverted},i=I,vdb=_Tdb}, Fail, Vdb, Bef, St0) ->
+ case Inverted of
+ false ->
+ test_cg(Test, As, Fail, I, Vdb, Bef, St0);
+ true ->
+ {Psucc,St1} = new_label(St0),
+ {Is,Aft,St2} = test_cg(Test, As, Psucc, I, Vdb, Bef, St1),
+ {Is++[{jump,{f,Fail}},{label,Psucc}],Aft,St2}
+ end;
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),
@@ -1106,6 +1114,13 @@ test_cg(is_map, [A], Fail, I, Vdb, Bef, St) ->
Arg = cg_reg_arg_prefer_y(A, Bef),
Aft = clear_dead(Bef, I, Vdb),
{[{test,is_map,{f,Fail},[Arg]}],Aft,St};
+test_cg(is_boolean, [{atom,Val}], Fail, I, Vdb, Bef, St) ->
+ Aft = clear_dead(Bef, I, Vdb),
+ Is = case is_boolean(Val) of
+ true -> [];
+ false -> [{jump,{f,Fail}}]
+ end,
+ {Is,Aft,St};
test_cg(Test, As, Fail, I, Vdb, Bef, St) ->
Args = cg_reg_args(As, Bef),
Aft = clear_dead(Bef, I, Vdb),
@@ -1301,10 +1316,10 @@ 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) ->
+%% internal_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) ->
%% {[Ainstr],StackReg,State}.
-bif_cg(bs_context_to_binary=Instr, [Src0], [], Le, Vdb, Bef, St0) ->
+internal_cg(bs_context_to_binary=Instr, [Src0], [], Le, Vdb, Bef, St0) ->
[Src] = cg_reg_args([Src0], Bef),
case is_register(Src) of
false ->
@@ -1312,25 +1327,34 @@ bif_cg(bs_context_to_binary=Instr, [Src0], [], Le, Vdb, Bef, St0) ->
true ->
{[{Instr,Src}],clear_dead(Bef, Le#l.i, Vdb), St0}
end;
-bif_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) ->
+internal_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) ->
+internal_cg(make_fun, [Func0,Arity0|As], Rs, Le, Vdb, Bef, St0) ->
%% This behaves more like a function call.
+ {atom,Func} = Func0,
+ {integer,Arity} = Arity0,
{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 = {make_fun2,{f,FuncLbl},Index,Uniq,length(As)},
+ MakeFun = {make_fun2,{f,FuncLbl},0,0,length(As)},
{Sis ++ [MakeFun],
clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),
St1};
-bif_cg(bs_init_writable=I, As, Rs, Le, Vdb, Bef, St) ->
+internal_cg(bs_init_writable=I, As, Rs, Le, Vdb, Bef, St) ->
%% This behaves like a function call.
{Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb),
Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
{Sis++[I],clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),St};
+internal_cg(raise, As, Rs, Le, Vdb, Bef, St) ->
+ %% raise can be treated like a guard BIF.
+ bif_cg(raise, As, Rs, Le, Vdb, Bef, St).
+
+%% bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) ->
+%% {[Ainstr],StackReg,State}.
+
bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) ->
Ars = cg_reg_args(As, Bef),
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index d71411de80..ae650546e5 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -137,11 +137,13 @@
-record(core, {vcount=0 :: non_neg_integer(), %Variable counter
fcount=0 :: non_neg_integer(), %Function counter
+ function={none,0} :: fa(), %Current function.
in_guard=false :: boolean(), %In guard or not.
wanted=true :: boolean(), %Result wanted or not.
opts :: [compile:option()], %Options.
ws=[] :: [warning()], %Warnings.
- file=[{file,""}]}). %File
+ file=[{file,""}] %File.
+ }).
%% XXX: The following type declarations do not belong in this module
-type fa() :: {atom(), arity()}.
@@ -149,38 +151,73 @@
-type form() :: {function, integer(), atom(), arity(), _}
| {attribute, integer(), attribute(), _}.
--spec module({module(), [fa()], [form()]}, [compile:option()]) ->
+-record(imodule, {name = [],
+ exports = ordsets:new(),
+ attrs = [],
+ defs = [],
+ file = [],
+ opts = [],
+ ws = []}).
+
+-spec module([form()], [compile:option()]) ->
{'ok',cerl:c_module(),[warning()]}.
-module({Mod,Exp,Forms}, Opts) ->
- Cexp = map(fun ({_N,_A} = NA) -> #c_var{name=NA} end, Exp),
- {Kfs0,As0,Ws,_File} = foldl(fun (F, Acc) ->
- form(F, Acc, Opts)
- end, {[],[],[],[]}, Forms),
- Kfs = reverse(Kfs0),
+module(Forms0, Opts) ->
+ Forms = erl_internal:add_predefined_functions(Forms0),
+ Module = foldl(fun (F, Acc) ->
+ form(F, Acc, Opts)
+ end, #imodule{}, Forms),
+ #imodule{name=Mod,exports=Exp0,attrs=As0,defs=Kfs0,ws=Ws} = Module,
+ Exp = case member(export_all, Opts) of
+ true -> defined_functions(Forms);
+ false -> Exp0
+ end,
+ Cexp = [#c_var{name=FA} || {_,_}=FA <- Exp],
As = reverse(As0),
+ Kfs = reverse(Kfs0),
{ok,#c_module{name=#c_literal{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws}.
-form({function,_,_,_,_}=F0, {Fs,As,Ws0,File}, Opts) ->
+form({function,_,_,_,_}=F0, Module, Opts) ->
+ #imodule{file=File,defs=Defs,ws=Ws0} = Module,
{F,Ws} = function(F0, Ws0, File, Opts),
- {[F|Fs],As,Ws,File};
-form({attribute,_,file,{File,_Line}}, {Fs,As,Ws,_}, _Opts) ->
- {Fs,As,Ws,File};
-form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) ->
- {Fs,[attribute(F)|As],Ws,File}.
-
-attribute(Attribute) ->
- Fun = fun(A) -> [erl_anno:location(A)] end,
- {attribute,Line,Name,Val} = erl_parse:map_anno(Fun, Attribute),
+ Module#imodule{defs=[F|Defs],ws=Ws};
+form({attribute,_,module,Mod}, Module, _Opts) ->
+ true = is_atom(Mod),
+ Module#imodule{name=Mod};
+form({attribute,_,file,{File,_Line}}=F, #imodule{attrs=As}=Module, _Opts) ->
+ Module#imodule{file=File, attrs=[attribute(F)|As]};
+form({attribute,_,import,_}, Module, _Opts) ->
+ %% Ignore. We have no futher use for imports.
+ Module;
+form({attribute,_,export,Es}, #imodule{exports=Exp0}=Module, _Opts) ->
+ Exp = ordsets:union(ordsets:from_list(Es), Exp0),
+ Module#imodule{exports=Exp};
+form({attribute,_,_,_}=F, #imodule{attrs=As}=Module, _Opts) ->
+ Module#imodule{attrs=[attribute(F)|As]};
+form(_, Module, _Opts) ->
+ %% Ignore uninteresting forms such as 'eof'.
+ Module.
+
+attribute({attribute,A,Name,Val0}) ->
+ Line = [erl_anno:location(A)],
+ Val = if
+ is_list(Val0) -> Val0;
+ true -> [Val0]
+ end,
{#c_literal{val=Name, anno=Line}, #c_literal{val=Val, anno=Line}}.
+defined_functions(Forms) ->
+ Fs = [{Name,Arity} || {function,_,Name,Arity,_} <- Forms],
+ ordsets:from_list(Fs).
+
%% function_dump(module_info,_,_,_) -> ok;
%% function_dump(Name,Arity,Format,Terms) ->
%% io:format("~w/~w " ++ Format,[Name,Arity]++Terms),
%% ok.
function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) ->
- St0 = #core{vcount=0,opts=Opts,ws=Ws0,file=[{file,File}]},
+ St0 = #core{vcount=0,function={Name,Arity},opts=Opts,
+ ws=Ws0,file=[{file,File}]},
{B0,St1} = body(Cs0, Name, Arity, St0),
%% ok = function_dump(Name,Arity,"body:~n~p~n",[B0]),
{B1,St2} = ubody(B0, St1),
@@ -632,9 +669,11 @@ expr({'catch',L,E0}, St0) ->
{E1,Eps,St1} = expr(E0, St0),
Lanno = lineno_anno(L, St1),
{#icatch{anno=#a{anno=Lanno},body=Eps ++ [E1]},[],St1};
-expr({'fun',L,{function,F,A},{_,_,_}=Id}, St) ->
- Lanno = full_anno(L, St),
- {#c_var{anno=Lanno++[{id,Id}],name={F,A}},[],St};
+expr({'fun',L,{function,F,A}}, St0) ->
+ {Fname,St1} = new_fun_name(St0),
+ Lanno = full_anno(L, St1),
+ Id = {0,0,Fname},
+ {#c_var{anno=Lanno++[{id,Id}],name={F,A}},[],St1};
expr({'fun',L,{function,M,F,A}}, St0) ->
{As,Aps,St1} = safe_list([M,F,A], St0),
Lanno = full_anno(L, St1),
@@ -642,12 +681,12 @@ expr({'fun',L,{function,M,F,A}}, St0) ->
module=#c_literal{val=erlang},
name=#c_literal{val=make_fun},
args=As},Aps,St1};
-expr({'fun',L,{clauses,Cs},Id}, St) ->
- fun_tq(Id, Cs, L, St, unnamed);
-expr({named_fun,L,'_',Cs,Id}, St) ->
- fun_tq(Id, Cs, L, St, unnamed);
-expr({named_fun,L,Name,Cs,Id}, St) ->
- fun_tq(Id, Cs, L, St, {named,Name});
+expr({'fun',L,{clauses,Cs}}, St) ->
+ fun_tq(Cs, L, St, unnamed);
+expr({named_fun,L,'_',Cs}, St) ->
+ fun_tq(Cs, L, St, unnamed);
+expr({named_fun,L,Name,Cs}, St) ->
+ fun_tq(Cs, L, St, {named,Name});
expr({call,L,{remote,_,M,F},As0}, St0) ->
{[M1,F1|As1],Aps,St1} = safe_list([M,F|As0], St0),
Anno = full_anno(L, St1),
@@ -840,19 +879,33 @@ badmap_term(Map, #core{in_guard=false}) ->
c_tuple([#c_literal{val=badmap},Map]).
map_build_pairs(Map, Es0, Ann, St0) ->
- {Es,Pre,St1} = map_build_pairs_1(Es0, St0),
+ {Es,Pre,_,St1} = map_build_pairs_1(Es0, cerl_sets:new(), St0),
{ann_c_map(Ann, Map, Es),Pre,St1}.
-map_build_pairs_1([{Op0,L,K0,V0}|Es], St0) ->
+map_build_pairs_1([{Op0,L,K0,V0}|Es], Used0, St0) ->
{K,Pre0,St1} = safe(K0, St0),
{V,Pre1,St2} = safe(V0, St1),
- {Pairs,Pre2,St3} = map_build_pairs_1(Es, St2),
+ {Pairs,Pre2,Used1,St3} = map_build_pairs_1(Es, Used0, St2),
As = lineno_anno(L, St3),
Op = map_op(Op0),
+ {Used2,St4} = maybe_warn_repeated_keys(K, L, Used1, St3),
Pair = cerl:ann_c_map_pair(As, Op, K, V),
- {[Pair|Pairs],Pre0++Pre1++Pre2,St3};
-map_build_pairs_1([], St) ->
- {[],[],St}.
+ {[Pair|Pairs],Pre0++Pre1++Pre2,Used2,St4};
+map_build_pairs_1([], Used, St) ->
+ {[],[],Used,St}.
+
+maybe_warn_repeated_keys(Ck,Line,Used,St) ->
+ case cerl:is_literal(Ck) of
+ false -> {Used,St};
+ true ->
+ K = cerl:concrete(Ck),
+ case cerl_sets:is_element(K,Used) of
+ true ->
+ {Used, add_warning(Line, {map_key_repeated,K}, St)};
+ false ->
+ {cerl_sets:add_element(K,Used), St}
+ end
+ end.
map_op(map_field_assoc) -> #c_literal{val=assoc};
map_op(map_field_exact) -> #c_literal{val=exact}.
@@ -899,14 +952,29 @@ try_after(As, St0) ->
%% record whereas c_literal should not have a wrapped annotation
expr_bin(Es0, Anno, St0) ->
- case constant_bin(Es0) of
+ Es1 = [bin_element(E) || E <- Es0],
+ case constant_bin(Es1) of
error ->
- {Es,Eps,St} = expr_bin_1(Es0, St0),
+ {Es,Eps,St} = expr_bin_1(bin_expand_strings(Es1), St0),
{#ibinary{anno=#a{anno=Anno},segments=Es},Eps,St};
Bin ->
{#c_literal{anno=Anno,val=Bin},[],St0}
end.
+bin_element({bin_element,Line,Expr,Size0,Type0}) ->
+ {Size,Type} = make_bit_type(Line, Size0, Type0),
+ {bin_element,Line,Expr,Size,Type}.
+
+make_bit_type(Line, default, Type0) ->
+ case erl_bits:set_bit_type(default, Type0) of
+ {ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)};
+ {ok,undefined,Bt} -> {{atom,Line,undefined},erl_bits:as_list(Bt)};
+ {ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)}
+ end;
+make_bit_type(_Line, Size, Type0) -> %Integer or 'all'
+ {ok,Size,Bt} = erl_bits:set_bit_type(Size, Type0),
+ {Size,erl_bits:as_list(Bt)}.
+
%% constant_bin([{bin_element,_,_,_,_}]) -> binary() | error
%% If the binary construction is truly constant (no variables,
%% no native fields), and does not contain fields whose expansion
@@ -923,7 +991,8 @@ constant_bin(Es) ->
constant_bin_1(Es) ->
verify_suitable_fields(Es),
EmptyBindings = erl_eval:new_bindings(),
- EvalFun = fun({integer,_,I}, B) -> {value,I,B};
+ EvalFun = fun({string,_,S}, B) -> {value,S,B};
+ ({integer,_,I}, B) -> {value,I,B};
({char,_,C}, B) -> {value,C,B};
({float,_,F}, B) -> {value,F,B};
({atom,_,undefined}, B) -> {value,undefined,B}
@@ -944,6 +1013,9 @@ verify_suitable_fields([{bin_element,_,Val,SzTerm,Opts}|Es]) ->
end,
{unit,Unit} = keyfind(unit, 1, Opts),
case {SzTerm,Val} of
+ {{atom,_,undefined},{string,_,_}} ->
+ %% UTF-8/16/32.
+ ok;
{{atom,_,undefined},{char,_,_}} ->
%% UTF-8/16/32.
ok;
@@ -983,6 +1055,31 @@ count_bits(Int) ->
count_bits_1(0, Bits) -> Bits;
count_bits_1(Int, Bits) -> count_bits_1(Int bsr 64, Bits+64).
+bin_expand_strings(Es0) ->
+ foldr(fun ({bin_element,Line,{string,_,S},{integer,_,8},_}, Es) ->
+ bin_expand_string(S, Line, 0, 0) ++ Es;
+ ({bin_element,Line,{string,_,S},Sz,Ts}, Es1) ->
+ foldr(
+ fun (C, Es) ->
+ [{bin_element,Line,{char,Line,C},Sz,Ts}|Es]
+ end, Es1, S);
+ (E, Es) ->
+ [E|Es]
+ end, [], Es0).
+
+bin_expand_string(S, Line, Val, Size) when Size >= 2048 ->
+ Combined = make_combined(Line, Val, Size),
+ [Combined|bin_expand_string(S, Line, 0, 0)];
+bin_expand_string([H|T], Line, Val, Size) ->
+ bin_expand_string(T, Line, (Val bsl 8) bor H, Size+8);
+bin_expand_string([], Line, Val, Size) ->
+ [make_combined(Line, Val, Size)].
+
+make_combined(Line, Val, Size) ->
+ {bin_element,Line,{integer,Line,Val},
+ {integer,Line,Size},
+ [integer,{unit,1},unsigned,big]}.
+
expr_bin_1(Es, St) ->
foldr(fun (E, {Ces,Esp,St0}) ->
{Ce,Ep,St1} = bitstr(E, St0),
@@ -1018,17 +1115,19 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) ->
%% fun_tq(Id, [Clauses], Line, State, NameInfo) -> {Fun,[PreExp],State}.
-fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) ->
+fun_tq(Cs0, L, St0, NameInfo) ->
Arity = clause_arity(hd(Cs0)),
{Cs1,Ceps,St1} = clauses(Cs0, St0),
{Args,St2} = new_vars(Arity, St1),
{Ps,St3} = new_vars(Arity, St2), %Need new variables here
Anno = full_anno(L, St3),
+ {Name,St4} = new_fun_name(St3),
Fc = function_clause(Ps, Anno, {Name,Arity}),
+ Id = {0,0,Name},
Fun = #ifun{anno=#a{anno=Anno},
id=[{id,Id}], %We KNOW!
vars=Args,clauses=Cs1,fc=Fc,name=NameInfo},
- {Fun,Ceps,St3}.
+ {Fun,Ceps,St4}.
%% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}.
%% This TQ from Simon PJ pp 127-138.
@@ -1354,8 +1453,9 @@ list_gen_pattern(P0, Line, St) ->
%%% the result binary in a binary comprehension.
%%%
-bc_initial_size(E, Q, St0) ->
+bc_initial_size(E0, Q, St0) ->
try
+ E = bin_bin_element(E0),
{ElemSzExpr,ElemSzPre,EVs,St1} = bc_elem_size(E, St0),
{V,St2} = new_var(St1),
{GenSzExpr,GenSzPre,St3} = bc_gen_size(Q, EVs, St2),
@@ -1394,11 +1494,15 @@ bc_elem_size({bin,_,El}, St0) ->
bc_elem_size(_, _) ->
throw(impossible).
-bc_elem_size_1([{bin_element,_,_,{integer,_,N},Flags}|Es], Bits, Vars) ->
- {unit,U} = keyfind(unit, 1, Flags),
+bc_elem_size_1([{bin_element,_,{string,_,String},{integer,_,N},_}=El|Es],
+ Bits, Vars) ->
+ U = get_unit(El),
+ bc_elem_size_1(Es, Bits+U*N*length(String), Vars);
+bc_elem_size_1([{bin_element,_,_,{integer,_,N},_}=El|Es], Bits, Vars) ->
+ U = get_unit(El),
bc_elem_size_1(Es, Bits+U*N, Vars);
-bc_elem_size_1([{bin_element,_,_,{var,_,Var},Flags}|Es], Bits, Vars) ->
- {unit,U} = keyfind(unit, 1, Flags),
+bc_elem_size_1([{bin_element,_,_,{var,_,Var},_}=El|Es], Bits, Vars) ->
+ U = get_unit(El),
bc_elem_size_1(Es, Bits, [{U,#c_var{name=Var}}|Vars]);
bc_elem_size_1([_|_], _, _) ->
throw(impossible);
@@ -1455,7 +1559,9 @@ bc_gen_size_1([{generate,L,El,Gen}|Qs], EVs, E0, Pre0, St0) ->
{E,Pre,St} = bc_gen_size_mul(E0, #c_literal{val=Len}, Pre0, St0),
bc_gen_size_1(Qs, EVs, E, Pre, St)
end;
-bc_gen_size_1([{b_generate,_,El,Gen}|Qs], EVs, E0, Pre0, St0) ->
+bc_gen_size_1([{b_generate,_,El0,Gen0}|Qs], EVs, E0, Pre0, St0) ->
+ El = bin_bin_element(El0),
+ Gen = bin_bin_element(Gen0),
bc_verify_non_filtering(El, EVs),
{MatchSzExpr,Pre1,_,St1} = bc_elem_size(El, St0),
Pre2 = reverse(Pre1, Pre0),
@@ -1471,6 +1577,10 @@ bc_gen_size_1([], _, E, Pre, St) ->
bc_gen_size_1(_, _, _, _, _) ->
throw(impossible).
+bin_bin_element({bin,L,El}) ->
+ {bin,L,[bin_element(E) || E <- El]};
+bin_bin_element(Other) -> Other.
+
bc_gen_bit_size({var,L,V}, Pre0, St0) ->
Lanno = lineno_anno(L, St0),
{SzVar,St} = new_var(St0),
@@ -1513,8 +1623,11 @@ bc_list_length(_, _) ->
bc_bin_size({bin,_,Els}) ->
bc_bin_size_1(Els, 0).
-bc_bin_size_1([{bin_element,_,_,{integer,_,Sz},Flags}|Els], N) ->
- {unit,U} = keyfind(unit, 1, Flags),
+bc_bin_size_1([{bin_element,_,{string,_,String},{integer,_,Sz},_}=El|Els], N) ->
+ U = get_unit(El),
+ bc_bin_size_1(Els, N+U*Sz*length(String));
+bc_bin_size_1([{bin_element,_,_,{integer,_,Sz},_}=El|Els], N) ->
+ U = get_unit(El),
bc_bin_size_1(Els, N+U*Sz);
bc_bin_size_1([], N) -> N;
bc_bin_size_1(_, _) -> throw(impossible).
@@ -1549,11 +1662,24 @@ bc_bsr(E1, E2) ->
name=#c_literal{val='bsr'},
args=[E1,E2]}.
-%% 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.
+get_unit({bin_element,_,_,_,Flags}) ->
+ {unit,U} = keyfind(unit, 1, Flags),
+ U.
-is_guard_test(E) -> erl_lint:is_guard_test(E).
+%% is_guard_test(Expression) -> true | false.
+%% Test if a general expression is a guard test.
+%%
+%% Note that a local function overrides a BIF with the same name.
+%% For example, if there is a local function named is_list/1,
+%% any unqualified call to is_list/1 will be to the local function.
+%% The guard function must be explicitly called as erlang:is_list/1.
+
+is_guard_test(E) ->
+ %% erl_expand_records has added a module prefix to any call
+ %% to a BIF or imported function. Any call without a module
+ %% prefix that remains must therefore be to a local function.
+ IsOverridden = fun({_,_}) -> true end,
+ erl_lint:is_guard_test(E, [], IsOverridden).
%% novars(Expr, State) -> {Novars,[PreExpr],State}.
%% Generate a novars expression, basically a call or a safe. At this
@@ -1696,7 +1822,18 @@ pattern({bin,L,Ps}, St) ->
pattern({match,_,P1,P2}, St) ->
{Cp1,Eps1,St1} = pattern(P1,St),
{Cp2,Eps2,St2} = pattern(P2,St1),
- {pat_alias(Cp1,Cp2),Eps1++Eps2,St2}.
+ {pat_alias(Cp1,Cp2),Eps1++Eps2,St2};
+%% Evaluate compile-time expressions.
+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({op,_Line,_Op,_A}=Op, St) ->
+ pattern(erl_eval:partial_eval(Op), St);
+pattern({op,_Line,_Op,_L,_R}=Op, St) ->
+ pattern(erl_eval:partial_eval(Op), St).
%% pattern_map_pairs([MapFieldExact],State) -> [#c_map_pairs{}]
pattern_map_pairs(Ps, St) ->
@@ -1736,18 +1873,29 @@ pat_alias_map_pairs_1([]) -> [].
%% pat_bin([BinElement], State) -> [BinSeg].
-pat_bin(Ps, St) -> [pat_segment(P, St) || P <- Ps].
+pat_bin(Ps, St) -> [pat_segment(P, St) || P <- bin_expand_strings(Ps)].
-pat_segment({bin_element,L,Val,Size,[Type,{unit,Unit}|Flags]}, St) ->
+pat_segment({bin_element,L,Val,Size0,Type0}, St) ->
+ {Size,Type1} = make_bit_type(L, Size0, Type0),
+ [Type,{unit,Unit}|Flags] = Type1,
Anno = lineno_anno(L, St),
- {Pval,[],St1} = pattern(Val,St),
- {Psize,[],_St2} = pattern(Size,St1),
+ {Pval0,[],St1} = pattern(Val, St),
+ Pval = coerce_to_float(Pval0, Type0),
+ {Psize,[],_St2} = pattern(Size, St1),
#c_bitstr{anno=Anno,
val=Pval,size=Psize,
unit=#c_literal{val=Unit},
type=#c_literal{val=Type},
flags=#c_literal{val=Flags}}.
+coerce_to_float(#c_literal{val=Int}=E, [float|_]) when is_integer(Int) ->
+ try
+ E#c_literal{val=float(Int)}
+ catch
+ error:badarg -> E
+ end;
+coerce_to_float(E, _) -> E.
+
%% pat_alias(CorePat, CorePat) -> AliasPat.
%% Normalise aliases. Trap bad aliases by throwing 'nomatch'.
@@ -1817,11 +1965,18 @@ pattern_list([P0|Ps0], St0) ->
pattern_list([], St) ->
{[],[],St}.
+string_to_conses(Line, Cs, Tail) ->
+ foldr(fun (C, T) -> {cons,Line,{char,Line,C},T} end, Tail, Cs).
%% make_vars([Name]) -> [{Var,Name}].
make_vars(Vs) -> [ #c_var{name=V} || V <- Vs ].
+new_fun_name(#core{function={F,A},fcount=I}=St) ->
+ Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A)
+ ++ "-fun-" ++ integer_to_list(I) ++ "-",
+ {list_to_atom(Name),St#core{fcount=I+1}}.
+
%% new_fun_name(Type, State) -> {FunName,State}.
new_fun_name(Type, #core{fcount=C}=St) ->
@@ -1830,7 +1985,7 @@ new_fun_name(Type, #core{fcount=C}=St) ->
%% 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}}.
+ {list_to_atom("@c" ++ integer_to_list(C)),St#core{vcount=C + 1}}.
%% new_var(State) -> {{var,Name},State}.
%% new_var(LineAnno, State) -> {{var,Name},State}.
@@ -2475,7 +2630,11 @@ format_error(nomatch) ->
format_error(bad_binary) ->
"binary construction will fail because of a type mismatch";
format_error(badmap) ->
- "map construction will fail because of a type mismatch".
+ "map construction will fail because of a type mismatch";
+format_error({map_key_repeated,Key}) when is_atom(Key) ->
+ io_lib:format("key '~w' will be overridden in expression", [Key]);
+format_error({map_key_repeated,Key}) ->
+ io_lib:format("key ~p will be overridden in expression", [Key]).
add_warning(Anno, Term, #core{ws=Ws,file=[{file,File}]}=St) ->
case erl_anno:generated(Anno) of
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index b4bbc5e739..1fc05109c5 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -82,7 +82,7 @@
-export([module/2,format_error/1]).
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2,
- keymember/3,keyfind/3,partition/2,droplast/1,last/1]).
+ keymember/3,keyfind/3,partition/2,droplast/1,last/1,sort/1]).
-import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]).
-import(cerl, [c_tuple/1]).
@@ -148,9 +148,12 @@ include_attribute(opaque) -> false;
include_attribute(export_type) -> false;
include_attribute(record) -> false;
include_attribute(optional_callbacks) -> false;
+include_attribute(file) -> false;
+include_attribute(compile) -> false;
include_attribute(_) -> true.
function({#c_var{name={F,Arity}=FA},Body}, St0) ->
+ %%io:format("~w/~w~n", [F,Arity]),
try
St1 = St0#kern{func=FA,ff=undefined,vcount=0,fcount=0,ds=cerl_sets:new()},
{#ifun{anno=Ab,vars=Kvs,body=B0},[],St2} = expr(Body, new_sub(), St1),
@@ -190,9 +193,479 @@ body(Ce, Sub, St0) ->
guard(G0, Sub, St0) ->
{G1,St1} = wrap_guard(G0, St0),
{Ge0,Pre,St2} = expr(G1, Sub, St1),
- {Ge,St} = gexpr_test(Ge0, St2),
+ {Ge1,St3} = gexpr_test(Ge0, St2),
+ {Ge,St} = guard_opt(Ge1, St3),
{pre_seq(Pre, Ge),St}.
+%% guard_opt(Kexpr, State) -> {Kexpr,State}.
+%% Optimize the Kexpr for the guard. Instead of evaluating a boolean
+%% expression comparing it to 'true' in a final #k_test{},
+%% replace BIF calls with #k_test{} in the expression.
+%%
+%% As an example, take the guard:
+%%
+%% when is_integer(V0), is_atom(V1) ->
+%%
+%% The unoptimized Kexpr translated to pseudo BEAM assembly
+%% code would look like:
+%%
+%% bif is_integer V0 => Bool0
+%% bif is_atom V1 => Bool1
+%% bif and Bool0 Bool1 => Bool
+%% test Bool =:= true else goto Fail
+%% ...
+%% Fail:
+%% ...
+%%
+%% The optimized code would look like:
+%%
+%% test is_integer V0 else goto Fail
+%% test is_atom V1 else goto Fail
+%% ...
+%% Fail:
+%% ...
+%%
+%% An 'or' operation is only slightly more complicated:
+%%
+%% test is_integer V0 else goto NotFailedYet
+%% goto Success
+%%
+%% NotFailedYet:
+%% test is_atom V1 else goto Fail
+%%
+%% Success:
+%% ...
+%% Fail:
+%% ...
+
+guard_opt(G, St0) ->
+ {Root,Forest0,St1} = make_forest(G, St0),
+ {Exprs,Forest,St} = rewrite_bool(Root, Forest0, false, St1),
+ E = forest_pre_seq(Exprs, Forest),
+ {G#k_try{arg=E},St}.
+
+%% rewrite_bool(Kexpr, Forest, Inv, St) -> {[Kexpr],Forest,St}.
+%% Rewrite Kexpr to use #k_test{} operations instead of comparison
+%% and type test BIFs.
+%%
+%% If Kexpr is a #k_test{} operation, the call will always
+%% succeed. Otherwise, a 'not_possible' exception will be
+%% thrown if Kexpr cannot be rewritten.
+
+rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}},
+ args=[#k_var{}=V,#k_atom{val=true}]}=Test, Forest0, Inv, St0) ->
+ try rewrite_bool_var(V, Forest0, Inv, St0) of
+ {_,_,_}=Res ->
+ Res
+ catch
+ throw:not_possible ->
+ {[Test],Forest0,St0}
+ end;
+rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}},
+ args=[#k_var{}=V,#k_atom{val=false}]}=Test, Forest0, Inv, St0) ->
+ try rewrite_bool_var(V, Forest0, not Inv, St0) of
+ {_,_,_}=Res ->
+ Res
+ catch
+ throw:not_possible ->
+ {[Test],Forest0,St0}
+ end;
+rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}},
+ args=[#k_atom{val=V1},#k_atom{val=V2}]}, Forest0, false, St0) ->
+ case V1 =:= V2 of
+ true ->
+ {[make_test(is_boolean, [#k_atom{val=true}])],Forest0,St0};
+ false ->
+ {[make_failing_test()],Forest0,St0}
+ end;
+rewrite_bool(#k_test{}=Test, Forest, false, St) ->
+ {[Test],Forest,St};
+rewrite_bool(#k_try{vars=[#k_var{name=X}],body=#k_var{name=X},
+ handler=#k_atom{val=false},ret=[]}=Prot,
+ Forest0, Inv, St0) ->
+ {Root,Forest1,St1} = make_forest(Prot, Forest0, St0),
+ {Exprs,Forest2,St} = rewrite_bool(Root, Forest1, Inv, St1),
+ InnerForest = maps:without(maps:keys(Forest0), Forest2),
+ Forest = maps:without(maps:keys(InnerForest), Forest2),
+ E = forest_pre_seq(Exprs, InnerForest),
+ {[Prot#k_try{arg=E}],Forest,St};
+rewrite_bool(#k_match{body=Body,ret=[]}, Forest, Inv, St) ->
+ rewrite_match(Body, Forest, Inv, St);
+rewrite_bool(Other, Forest, Inv, St) ->
+ case extract_bif(Other) of
+ {Name,Args} ->
+ rewrite_bif(Name, Args, Forest, Inv, St);
+ error ->
+ throw(not_possible)
+ end.
+
+%% rewrite_bool_var(Var, Forest, Inv, St) -> {[Kexpr],Forest,St}.
+%% Rewrite the boolean expression whose key in Forest is
+%% given by Var. Throw a 'not_possible' expression if something
+%% prevents the rewriting.
+
+rewrite_bool_var(Arg, Forest0, Inv, St) ->
+ {Expr,Forest} = forest_take_expr(Arg, Forest0),
+ rewrite_bool(Expr, Forest, Inv, St).
+
+%% rewrite_bool_args([Kexpr], Forest, Inv, St) -> {[[Kexpr]],Forest,St}.
+%% Rewrite each Kexpr in the list. The input Kexpr should be variables
+%% or boolean values. Throw a 'not_possible' expression if something
+%% prevents the rewriting.
+%%
+%% This function is suitable for handling the arguments for both
+%% 'and' and 'or'.
+
+rewrite_bool_args([#k_atom{val=B}=A|Vs], Forest0, false=Inv, St0) when is_boolean(B) ->
+ {Tail,Forest1,St1} = rewrite_bool_args(Vs, Forest0, Inv, St0),
+ Bif = make_bif('=:=', [A,#k_atom{val=true}]),
+ {Exprs,Forest,St} = rewrite_bool(Bif, Forest1, Inv, St1),
+ {[Exprs|Tail],Forest,St};
+rewrite_bool_args([#k_var{}=Var|Vs], Forest0, false=Inv, St0) ->
+ {Tail,Forest1,St1} = rewrite_bool_args(Vs, Forest0, Inv, St0),
+ {Exprs,Forest,St} =
+ case is_bool_expr(Var, Forest0) of
+ true ->
+ rewrite_bool_var(Var, Forest1, Inv, St1);
+ false ->
+ Bif = make_bif('=:=', [Var,#k_atom{val=true}]),
+ rewrite_bool(Bif, Forest1, Inv, St1)
+ end,
+ {[Exprs|Tail],Forest,St};
+rewrite_bool_args([_|_], _Forest, _Inv, _St) ->
+ throw(not_possible);
+rewrite_bool_args([], Forest, _Inv, St) ->
+ {[],Forest,St}.
+
+%% rewrite_bif(Name, [Kexpr], Forest, Inv, St) -> {[Kexpr],Forest,St}.
+%% Rewrite a BIF. Throw a 'not_possible' expression if something
+%% prevents the rewriting.
+
+rewrite_bif('or', Args, Forest, true, St) ->
+ rewrite_not_args('and', Args, Forest, St);
+rewrite_bif('and', Args, Forest, true, St) ->
+ rewrite_not_args('or', Args, Forest, St);
+rewrite_bif('and', [#k_atom{val=Val},Arg], Forest0, Inv, St0) ->
+ false = Inv, %Assertion.
+ case Val of
+ true ->
+ %% The result only depends on Arg.
+ rewrite_bool_var(Arg, Forest0, Inv, St0);
+ _ ->
+ %% Will fail. There is no need to evalute the expression
+ %% represented by Arg. Take it out from the forest and
+ %% discard the expression.
+ Failing = make_failing_test(),
+ try rewrite_bool_var(Arg, Forest0, Inv, St0) of
+ {_,Forest,St} ->
+ {[Failing],Forest,St}
+ catch
+ throw:not_possible ->
+ try forest_take_expr(Arg, Forest0) of
+ {_,Forest} ->
+ {[Failing],Forest,St0}
+ catch
+ throw:not_possible ->
+ %% Arg is probably a variable bound in an
+ %% outer scope.
+ {[Failing],Forest0,St0}
+ end
+ end
+ end;
+rewrite_bif('and', [Arg,#k_atom{}=Atom], Forest, Inv, St) ->
+ false = Inv, %Assertion.
+ rewrite_bif('and', [Atom,Arg], Forest, Inv, St);
+rewrite_bif('and', Args, Forest0, Inv, St0) ->
+ false = Inv, %Assertion.
+ {[Es1,Es2],Forest,St} = rewrite_bool_args(Args, Forest0, Inv, St0),
+ {Es1 ++ Es2,Forest,St};
+rewrite_bif('or', Args, Forest0, Inv, St0) ->
+ false = Inv, %Assertion.
+ {[First,Then],Forest,St} = rewrite_bool_args(Args, Forest0, Inv, St0),
+ Alt = make_alt(First, Then),
+ {[Alt],Forest,St};
+rewrite_bif('xor', [_,_], _Forest, _Inv, _St) ->
+ %% Rewriting 'xor' is not practical. Fortunately, 'xor' is
+ %% almost never used in practice.
+ throw(not_possible);
+rewrite_bif('not', [Arg], Forest0, Inv, St) ->
+ {Expr,Forest} = forest_take_expr(Arg, Forest0),
+ rewrite_bool(Expr, Forest, not Inv, St);
+rewrite_bif(Op, Args, Forest, Inv, St) ->
+ case is_test(Op, Args) of
+ true ->
+ rewrite_bool(make_test(Op, Args, Inv), Forest, false, St);
+ false ->
+ throw(not_possible)
+ end.
+
+rewrite_not_args(Op, [A0,B0], Forest0, St0) ->
+ {A,Forest1,St1} = rewrite_not_args_1(A0, Forest0, St0),
+ {B,Forest2,St2} = rewrite_not_args_1(B0, Forest1, St1),
+ rewrite_bif(Op, [A,B], Forest2, false, St2).
+
+rewrite_not_args_1(Arg, Forest, St) ->
+ Not = make_bif('not', [Arg]),
+ forest_add_expr(Not, Forest, St).
+
+%% rewrite_match(Kvar, TypeClause, Forest, Inv, St) ->
+%% {[Kexpr],Forest,St}.
+%% Try to rewrite a #k_match{} originating from an 'andalso' or an 'orelse'.
+
+rewrite_match(#k_alt{first=First,then=Then}, Forest, Inv, St) ->
+ case {First,Then} of
+ {#k_select{var=#k_var{name=V}=Var,types=[TypeClause]},#k_var{name=V}} ->
+ rewrite_match_1(Var, TypeClause, Forest, Inv, St);
+ {_,_} ->
+ throw(not_possible)
+ end.
+
+rewrite_match_1(Var, #k_type_clause{values=Cs0}, Forest0, Inv, St0) ->
+ Cs = sort([{Val,B} || #k_val_clause{val=#k_atom{val=Val},body=B} <- Cs0]),
+ case Cs of
+ [{false,False},{true,True}] ->
+ rewrite_match_2(Var, False, True, Forest0, Inv, St0);
+ _ ->
+ throw(not_possible)
+ end.
+
+rewrite_match_2(Var, False, #k_atom{val=true}, Forest0, Inv, St0) ->
+ %% Originates from an 'orelse'.
+ case False of
+ #k_atom{val=NotBool} when not is_boolean(NotBool) ->
+ rewrite_bool(Var, Forest0, Inv, St0);
+ _ ->
+ {CodeVar,Forest1,St1} = add_protected_expr(False, Forest0, St0),
+ rewrite_bif('or', [Var,CodeVar], Forest1, Inv, St1)
+ end;
+rewrite_match_2(Var, #k_atom{val=false}, True, Forest0, Inv, St0) ->
+ %% Originates from an 'andalso'.
+ {CodeVar,Forest1,St1} = add_protected_expr(True, Forest0, St0),
+ rewrite_bif('and', [Var,CodeVar], Forest1, Inv, St1);
+rewrite_match_2(_V, _, _, _Forest, _Inv, _St) ->
+ throw(not_possible).
+
+%% is_bool_expr(#k_var{}, Forest) -> true|false.
+%% Return true if the variable refers to a boolean expression
+%% that does not need an explicit '=:= true' test.
+
+is_bool_expr(V, Forest) ->
+ case forest_peek_expr(V, Forest) of
+ error ->
+ %% Defined outside of the guard. We can't know.
+ false;
+ Expr ->
+ case extract_bif(Expr) of
+ {Name,Args} ->
+ is_test(Name, Args) orelse
+ erl_internal:bool_op(Name, length(Args));
+ error ->
+ %% Not a BIF. Should be possible to rewrite
+ %% to a boolean. Definitely does not need
+ %% a '=:= true' test.
+ true
+ end
+ end.
+
+make_bif(Op, Args) ->
+ #k_bif{op=#k_remote{mod=#k_atom{val=erlang},
+ name=#k_atom{val=Op},
+ arity=length(Args)},
+ args=Args}.
+
+extract_bif(#k_bif{op=#k_remote{mod=#k_atom{val=erlang},
+ name=#k_atom{val=Name}},
+ args=Args}) ->
+ {Name,Args};
+extract_bif(_) ->
+ error.
+
+%% make_alt(First, Then) -> KMatch.
+%% Make a #k_alt{} within a #k_match{} to implement
+%% 'or' or 'orelse'.
+
+make_alt(First0, Then0) ->
+ First1 = pre_seq(droplast(First0), last(First0)),
+ Then1 = pre_seq(droplast(Then0), last(Then0)),
+ First2 = make_protected(First1),
+ Then2 = make_protected(Then1),
+ Body = #k_atom{val=ignored},
+ First3 = #k_guard_clause{guard=First2,body=Body},
+ Then3 = #k_guard_clause{guard=Then2,body=Body},
+ First = #k_guard{clauses=[First3]},
+ Then = #k_guard{clauses=[Then3]},
+ Alt = #k_alt{first=First,then=Then},
+ #k_match{vars=[],body=Alt}.
+
+add_protected_expr(#k_atom{}=Atom, Forest, St) ->
+ {Atom,Forest,St};
+add_protected_expr(#k_var{}=Var, Forest, St) ->
+ {Var,Forest,St};
+add_protected_expr(E0, Forest, St) ->
+ E = make_protected(E0),
+ forest_add_expr(E, Forest, St).
+
+make_protected(#k_try{}=Try) ->
+ Try;
+make_protected(B) ->
+ #k_try{arg=B,vars=[#k_var{name=''}],body=#k_var{name=''},
+ handler=#k_atom{val=false}}.
+
+make_failing_test() ->
+ make_test(is_boolean, [#k_atom{val=fail}]).
+
+make_test(Op, Args) ->
+ make_test(Op, Args, false).
+
+make_test(Op, Args, Inv) ->
+ Remote = #k_remote{mod=#k_atom{val=erlang},
+ name=#k_atom{val=Op},
+ arity=length(Args)},
+ #k_test{op=Remote,args=Args,inverted=Inv}.
+
+is_test(Op, Args) ->
+ A = length(Args),
+ erl_internal:new_type_test(Op, A) orelse erl_internal:comp_op(Op, A).
+
+%% make_forest(Kexpr, St) -> {RootKexpr,Forest,St}.
+%% Build a forest out of Kexpr. RootKexpr is the final expression
+%% nested inside Kexpr.
+
+make_forest(G, St) ->
+ make_forest_1(G, #{}, 0, St).
+
+%% make_forest(Kexpr, St) -> {RootKexpr,Forest,St}.
+%% Add to Forest from Kexpr. RootKexpr is the final expression
+%% nested inside Kexpr.
+
+make_forest(G, Forest0, St) ->
+ N = forest_next_index(Forest0),
+ make_forest_1(G, Forest0, N, St).
+
+make_forest_1(#k_try{arg=B}, Forest, I, St) ->
+ make_forest_1(B, Forest, I, St);
+make_forest_1(#iset{vars=[]}=Iset0, Forest, I, St0) ->
+ {UnrefVar,St} = new_var(St0),
+ Iset = Iset0#iset{vars=[UnrefVar]},
+ make_forest_1(Iset, Forest, I, St);
+make_forest_1(#iset{vars=[#k_var{name=V}],arg=Arg,body=B}, Forest0, I, St) ->
+ Forest = Forest0#{V => {I,Arg}, {untaken,V} => true},
+ make_forest_1(B, Forest, I+1, St);
+make_forest_1(Innermost, Forest, _I, St) ->
+ {Innermost,Forest,St}.
+
+%% forest_take_expr(Kexpr, Forest) -> {Expr,Forest}.
+%% If Kexpr is a variable, take out the expression corresponding
+%% to variable in Forest. Expressions that have been taken out
+%% of the forest will not be included the Kexpr returned
+%% by forest_pre_seq/2.
+%%
+%% Throw a 'not_possible' exception if Kexpr is not a variable or
+%% if the name of the variable is not a key in Forest.
+
+forest_take_expr(#k_var{name=V}, Forest0) ->
+ %% v3_core currently always generates guard expressions that can
+ %% be represented as a tree. Other code generators (such as LFE)
+ %% could generate guard expressions that can only be represented
+ %% as a DAG (i.e. some nodes are referenced more than once). To
+ %% handle DAGs, we must never remove a node from the forest, but
+ %% just remove the {untaken,V} marker. That will effectively convert
+ %% the DAG to a tree by duplicating the shared nodes and their
+ %% descendants.
+
+ case maps:find(V, Forest0) of
+ {ok,{_,Expr}} ->
+ Forest = maps:remove({untaken,V}, Forest0),
+ {Expr,Forest};
+ error ->
+ throw(not_possible)
+ end;
+forest_take_expr(_, _) ->
+ throw(not_possible).
+
+%% forest_peek_expr(Kvar, Forest) -> Kexpr | error.
+%% Return the expression corresponding to Kvar in Forest or
+%% return 'error' if there is a corresponding expression.
+
+forest_peek_expr(#k_var{name=V}, Forest0) ->
+ case maps:find(V, Forest0) of
+ {ok,{_,Expr}} -> Expr;
+ error -> error
+ end.
+
+%% forest_add_expr(Kexpr, Forest, St) -> {Kvar,Forest,St}.
+%% Add a new expression to Forest.
+
+forest_add_expr(Expr, Forest0, St0) ->
+ {#k_var{name=V}=Var,St} = new_var(St0),
+ N = forest_next_index(Forest0),
+ Forest = Forest0#{V => {N,Expr}},
+ {Var,Forest,St}.
+
+forest_next_index(Forest) ->
+ 1 + lists:max([N || {N,_} <- maps:values(Forest),
+ is_integer(N)] ++ [0]).
+
+%% forest_pre_seq([Kexpr], Forest) -> Kexpr.
+%% Package the list of Kexprs into a nested Kexpr, prepending all
+%% expressions in Forest that have not been taken out using
+%% forest_take_expr/2.
+
+forest_pre_seq(Exprs, Forest) ->
+ Es0 = [#k_var{name=V} || {untaken,V} <- maps:keys(Forest)],
+ Es = Es0 ++ Exprs,
+ Vs = extract_all_vars(Es, Forest, []),
+ Pre0 = sort([{maps:get(V, Forest),V} || V <- Vs]),
+ Pre = [#iset{vars=[#k_var{name=V}],arg=A} ||
+ {{_,A},V} <- Pre0],
+ pre_seq(Pre++droplast(Exprs), last(Exprs)).
+
+extract_all_vars(Es, Forest, Acc0) ->
+ case extract_var_list(Es) of
+ [] ->
+ Acc0;
+ [_|_]=Vs0 ->
+ Vs = [V || V <- Vs0, maps:is_key(V, Forest)],
+ NewVs = ordsets:subtract(Vs, Acc0),
+ NewEs = [begin
+ {_,E} = maps:get(V, Forest),
+ E
+ end || V <- NewVs],
+ Acc = union(NewVs, Acc0),
+ extract_all_vars(NewEs, Forest, Acc)
+ end.
+
+extract_vars(#iset{arg=A,body=B}) ->
+ union(extract_vars(A), extract_vars(B));
+extract_vars(#k_bif{args=Args}) ->
+ ordsets:from_list(lit_list_vars(Args));
+extract_vars(#k_call{}) ->
+ [];
+extract_vars(#k_test{args=Args}) ->
+ ordsets:from_list(lit_list_vars(Args));
+extract_vars(#k_match{body=Body}) ->
+ extract_vars(Body);
+extract_vars(#k_alt{first=First,then=Then}) ->
+ union(extract_vars(First), extract_vars(Then));
+extract_vars(#k_guard{clauses=Cs}) ->
+ extract_var_list(Cs);
+extract_vars(#k_guard_clause{guard=G}) ->
+ extract_vars(G);
+extract_vars(#k_select{var=Var,types=Types}) ->
+ union(ordsets:from_list(lit_vars(Var)),
+ extract_var_list(Types));
+extract_vars(#k_type_clause{values=Values}) ->
+ extract_var_list(Values);
+extract_vars(#k_val_clause{body=Body}) ->
+ extract_vars(Body);
+extract_vars(#k_try{arg=Arg}) ->
+ extract_vars(Arg);
+extract_vars(Lit) ->
+ ordsets:from_list(lit_vars(Lit)).
+
+extract_var_list(L) ->
+ union([extract_vars(E) || E <- L]).
+
%% Wrap the entire guard in a try/catch if needed.
wrap_guard(#c_try{}=Try, St) -> {Try,St};
@@ -840,23 +1313,26 @@ get_vsub(V, Vsub) ->
set_vsub(V, S, Vsub) ->
orddict:store(V, S, Vsub).
-subst_vsub(Key, New, [{K,Key}|Dict]) ->
+subst_vsub(Key, New, Vsub) ->
+ orddict:from_list(subst_vsub_1(Key, New, Vsub)).
+
+subst_vsub_1(Key, New, [{K,Key}|Dict]) ->
%% Fold chained substitution.
- [{K,New}|subst_vsub(Key, New, Dict)];
-subst_vsub(Key, New, [{K,_}|_]=Dict) when Key < K ->
+ [{K,New}|subst_vsub_1(Key, New, Dict)];
+subst_vsub_1(Key, New, [{K,_}|_]=Dict) when Key < K ->
%% Insert the new substitution here, and continue
%% look for chained substitutions.
- [{Key,New}|subst_vsub_1(Key, New, Dict)];
-subst_vsub(Key, New, [{K,_}=E|Dict]) when Key > K ->
- [E|subst_vsub(Key, New, Dict)];
-subst_vsub(Key, New, []) -> [{Key,New}].
+ [{Key,New}|subst_vsub_2(Key, New, Dict)];
+subst_vsub_1(Key, New, [{K,_}=E|Dict]) when Key > K ->
+ [E|subst_vsub_1(Key, New, Dict)];
+subst_vsub_1(Key, New, []) -> [{Key,New}].
-subst_vsub_1(V, S, [{K,V}|Dict]) ->
+subst_vsub_2(V, S, [{K,V}|Dict]) ->
%% Fold chained substitution.
- [{K,S}|subst_vsub_1(V, S, Dict)];
-subst_vsub_1(V, S, [E|Dict]) ->
- [E|subst_vsub_1(V, S, Dict)];
-subst_vsub_1(_, _, []) -> [].
+ [{K,S}|subst_vsub_2(V, S, Dict)];
+subst_vsub_2(V, S, [E|Dict]) ->
+ [E|subst_vsub_2(V, S, Dict)];
+subst_vsub_2(_, _, []) -> [].
get_fsub(F, A, Fsub) ->
case orddict:find({F,A}, Fsub) of
@@ -880,7 +1356,7 @@ new_fun_name(Type, #kern{func={F,Arity},fcount=C}=St) ->
%% 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}}.
+ {list_to_atom("@k" ++ integer_to_list(C)),St#kern{vcount=C+1}}.
%% new_var(State) -> {#k_var{},State}.
@@ -1350,10 +1826,70 @@ select(T, Cs) -> [ C || C <- Cs, clause_con(C) =:= T ].
%% At this point all the clauses have the same constructor, we must
%% now separate them according to value.
-match_value(Us, T, Cs0, Def, St0) ->
- Css = group_value(T, Cs0),
+match_value(Us0, T, Cs0, Def, St0) ->
+ {Us1,Cs1,St1} = partition_intersection(T, Us0, Cs0, St0),
+ UCss = group_value(T, Us1, Cs1),
%%ok = io:format("match_value ~p ~p~n", [T, Css]),
- mapfoldl(fun (Cs, St) -> match_clause(Us, Cs, Def, St) end, St0, Css).
+ mapfoldl(fun ({Us,Cs}, St) -> match_clause(Us, Cs, Def, St) end, St1, UCss).
+
+%% partition_intersection
+%% Partitions a map into two maps with the most common keys to the first map.
+%% case <M> of
+%% <#{a}>
+%% <#{a,b}>
+%% <#{a,c}>
+%% <#{c}>
+%% end
+%% becomes
+%% case <M,M> of
+%% <#{a}, #{ }>
+%% <#{a}, #{b}>
+%% <#{ }, #{c}>
+%% <#{a}, #{c}>
+%% end
+%% The intention is to group as many keys together as possible and thus
+%% reduce the number of lookups to that key.
+partition_intersection(k_map, [U|_]=Us0, [_,_|_]=Cs0,St0) ->
+ Ps = [clause_val(C) || C <- Cs0],
+ case find_key_partition(Ps) of
+ no_partition ->
+ {Us0,Cs0,St0};
+ Ks ->
+ {Cs1,St1} = mapfoldl(fun(#iclause{pats=[Arg|Args]}=C, Sti) ->
+ {{Arg1,Arg2},St} = partition_key_intersection(Arg, Ks, Sti),
+ {C#iclause{pats=[Arg1,Arg2|Args]}, St}
+ end, St0, Cs0),
+ {[U|Us0],Cs1,St1}
+ end;
+partition_intersection(_, Us, Cs, St) ->
+ {Us,Cs,St}.
+
+partition_key_intersection(#k_map{es=Pairs}=Map,Ks,St0) ->
+ F = fun(#k_map_pair{key=Key}) -> member(map_key_clean(Key), Ks) end,
+ {Ps1,Ps2} = partition(F, Pairs),
+ {{Map#k_map{es=Ps1},Map#k_map{es=Ps2}},St0};
+partition_key_intersection(#ialias{pat=Map}=Alias,Ks,St0) ->
+ %% only alias one of them
+ {{Map1,Map2},St1} = partition_key_intersection(Map, Ks, St0),
+ {{Map1,Alias#ialias{pat=Map2}},St1}.
+
+% Only check for the complete intersection of keys and not commonality
+find_key_partition(Ps) ->
+ Sets = [sets:from_list(Ks)||Ks <- Ps],
+ Is = sets:intersection(Sets),
+ case sets:to_list(Is) of
+ [] -> no_partition;
+ KeyIntersection ->
+ %% Check if the intersection are all keys in all clauses.
+ %% Don't split if they are since this will only
+ %% infer extra is_map instructions with no gain.
+ All = foldl(fun (Kset, Bool) ->
+ Bool andalso sets:is_subset(Kset, Is)
+ end, true, Sets),
+ if All -> no_partition;
+ true -> KeyIntersection
+ end
+ end.
%% group_value([Clause]) -> [[Clause]].
%% Group clauses according to value. Here we know that
@@ -1361,30 +1897,30 @@ match_value(Us, T, Cs0, Def, St0) ->
%% 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(k_bin_int, Cs) -> [Cs];
-group_value(k_map, Cs) -> group_map(Cs);
-group_value(_, Cs) ->
+group_value(k_cons, Us, Cs) -> [{Us,Cs}]; %These are single valued
+group_value(k_nil, Us, Cs) -> [{Us,Cs}];
+group_value(k_binary, Us, Cs) -> [{Us,Cs}];
+group_value(k_bin_end, Us, Cs) -> [{Us,Cs}];
+group_value(k_bin_seg, Us, Cs) -> group_bin_seg(Us,Cs);
+group_value(k_bin_int, Us, Cs) -> [{Us,Cs}];
+group_value(k_map, Us, Cs) -> group_map(Us,Cs);
+group_value(_, Us, 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).
+ dict:fold(fun (_, Vcs, Css) -> [{Us,Vcs}|Css] end, [], Cd).
-group_bin_seg([C1|Cs]) ->
+group_bin_seg(Us, [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([]) -> [].
+ [{Us,[C1|More]}|group_bin_seg(Us,Rest)];
+group_bin_seg(_, []) -> [].
-group_map([C1|Cs]) ->
+group_map(Us, [C1|Cs]) ->
V1 = clause_val(C1),
{More,Rest} = splitwith(fun (C) -> clause_val(C) =:= V1 end, Cs),
- [[C1|More]|group_map(Rest)];
-group_map([]) -> [].
+ [{Us,[C1|More]}|group_map(Us,Rest)];
+group_map(_, []) -> [].
%% Profiling shows that this quadratic implementation account for a big amount
%% of the execution time if there are many values.
@@ -1734,15 +2270,15 @@ 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}=Try,
+uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0},
{break,Rs0}=Br, St0) ->
case is_in_guard(St0) of
true ->
{[#k_var{name=X}],#k_var{name=X}} = {Vs,B0}, %Assertion.
#k_atom{val=false} = H0, %Assertion.
{A1,Bu,St1} = uexpr(A0, Br, St0),
- {Try#k_try{anno=#k{us=Bu,ns=lit_list_vars(Rs0),a=A},
- arg=A1,ret=Rs0},Bu,St1};
+ {#k_protected{anno=#k{us=Bu,ns=lit_list_vars(Rs0),a=A},
+ arg=A1,ret=Rs0},Bu,St1};
false ->
{Avs,St1} = new_vars(length(Vs), St0),
{A1,Au,St2} = ubody(A0, {break,Avs}, St1),
@@ -1791,13 +2327,9 @@ uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) ->
end,
Fun = #k_fdef{anno=#k{us=[],ns=[],a=A},func=Fname,arity=Arity,
vars=Vs ++ Fvs,body=B1},
- %% Set dummy values for Index and Uniq -- the real values will
- %% be assigned by beam_asm.
- Index = Uniq = 0,
{#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],
+ op=#k_internal{name=make_fun,arity=length(Free)+2},
+ args=[#k_atom{val=Fname},#k_int{val=Arity}|Fvs],
ret=Rs},
Free,add_local_function(Fun, St)};
uexpr(Lit, {break,Rs0}, St0) ->
diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl
index 5216a1a620..7cd30b25a8 100644
--- a/lib/compiler/src/v3_kernel.hrl
+++ b/lib/compiler/src/v3_kernel.hrl
@@ -58,7 +58,7 @@
-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_test, {anno=[],op,args,inverted=false}).
-record(k_call, {anno=[],op,args,ret=[]}).
-record(k_enter, {anno=[],op,args}).
-record(k_receive, {anno=[],var,body,timeout,action,ret=[]}).
@@ -66,6 +66,7 @@
-record(k_receive_next, {anno=[]}).
-record(k_try, {anno=[],arg,vars,body,evars,handler,ret=[]}).
-record(k_try_enter, {anno=[],arg,vars,body,evars,handler}).
+-record(k_protected, {anno=[],arg,ret=[]}).
-record(k_catch, {anno=[],body,ret=[]}).
-record(k_guard_match, {anno=[],vars,body,ret=[]}).
diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl
index 0b90f0a1e0..53097d0d7d 100644
--- a/lib/compiler/src/v3_kernel_pp.erl
+++ b/lib/compiler/src/v3_kernel_pp.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -47,7 +47,7 @@
canno(Cthing) -> element(2, Cthing).
--spec format(cerl:cerl()) -> iolist().
+-spec format(#k_mdef{}) -> iolist().
format(Node) -> format(Node, #ctxt{}).
@@ -145,7 +145,7 @@ 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]);
+ io_lib:format("remote ~ts:~ts/~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) ->
@@ -235,8 +235,13 @@ format_1(#k_bif{op=Op,args=As,ret=Rs}, Ctxt) ->
[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)),$)],
+format_1(#k_test{op=Op,args=As,inverted=Inverted}, Ctxt) ->
+ Txt = case Inverted of
+ false ->
+ ["test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)];
+ true ->
+ ["inverted_test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)]
+ end,
Ctxt1 = ctxt_bump_indent(Ctxt, 2),
[Txt,format_args(As, Ctxt1)];
format_1(#k_put{arg=A,ret=Rs}, Ctxt) ->
@@ -279,6 +284,15 @@ format_1(#k_try_enter{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Ctxt) ->
nl_indent(Ctxt),
"end"
];
+format_1(#k_protected{arg=A,ret=Rs}, Ctxt) ->
+ Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent),
+ ["protected",
+ nl_indent(Ctxt1),
+ format(A, Ctxt1),
+ nl_indent(Ctxt),
+ "end",
+ format_ret(Rs, ctxt_bump_indent(Ctxt, 1))
+ ];
format_1(#k_catch{body=B,ret=Rs}, Ctxt) ->
Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent),
["catch",
diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl
index 1452b78d1d..be3ade47ff 100644
--- a/lib/compiler/src/v3_life.erl
+++ b/lib/compiler/src/v3_life.erl
@@ -52,10 +52,15 @@
-include("v3_kernel.hrl").
-include("v3_life.hrl").
+-type fa() :: {atom(),arity()}.
+
%% These are not defined in v3_kernel.hrl.
get_kanno(Kthing) -> element(2, Kthing).
%%set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno).
+-spec module(#k_mdef{}, [compile:option()]) ->
+ {'ok',{module(),[fa()],[_],[_]}}.
+
module(#k_mdef{name=M,exports=Es,attributes=As,body=Fs0}, _Opts) ->
Fs1 = functions(Fs0, []),
{ok,{M,Es,As,Fs1}}.
@@ -78,9 +83,7 @@ function(#k_fdef{anno=#k{a=Anno},func=F,arity=Ar,vars=Vs,body=Kb}) ->
#k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a},
vars=Vs,body=Kb,ret=[]}
end,
- put(guard_refc, 0),
{B1,_,Vdb1} = body(B0, 1, Vdb0),
- erase(guard_refc),
{function,F,Ar,As,B1,Vdb1,Anno}
catch
Class:Error ->
@@ -106,12 +109,13 @@ body(Ke, I, Vdb0) ->
E = expr(Ke, I, Vdb1),
{[E],I,Vdb1}.
-%% guard(Kguard, I, Vdb) -> Guard.
+%% protected(Kprotected, I, Vdb) -> Protected.
+%% Only used in guards.
-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) ->
+protected(#k_protected{anno=A,arg=Ts,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.
+ %% Don't lock variables that are only used inside the protected
+ %% expression.
Pdb0 = vdb_sub(I, I+1, Vdb),
{T,MaxI,Pdb1} = body(Ts, I+1, Pdb0),
Pdb2 = use_vars(A#k.ns, MaxI+1, Pdb1), %Save "return" values
@@ -119,8 +123,8 @@ guard(#k_try{anno=A,arg=Ts,vars=[#k_var{name=X}],body=#k_var{name=X},
%% expr(Kexpr, I, Vdb) -> Expr.
-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};
+expr(#k_test{anno=A,op=Op,args=As,inverted=Inverted}, I, _Vdb) ->
+ #l{ke={test,test_op(Op),atomic_list(As),Inverted},i=I,a=A#k.a};
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) ->
@@ -139,10 +143,9 @@ expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) ->
M = match(Kb, A#k.us, I+1, [], Mdb),
#l{ke={guard_match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a};
expr(#k_try{}=Try, I, Vdb) ->
- case is_in_guard() of
- false -> body_try(Try, I, Vdb);
- true -> guard(Try, I, Vdb)
- end;
+ body_try(Try, I, Vdb);
+expr(#k_protected{}=Protected, I, Vdb) ->
+ protected(Protected, I, Vdb);
expr(#k_try_enter{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}, I, Vdb) ->
%% Lock variables that are alive before the catch and used afterwards.
%% Don't lock variables that are only used inside the try.
@@ -213,7 +216,6 @@ body_try(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh,ret=Rs},
i=I,vdb=Tdb1,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.
@@ -221,28 +223,14 @@ call_op(#k_local{name=N}) -> N;
call_op(#k_remote{mod=M,name=N}) -> {remote,atomic(M),atomic(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], Vdb) -> 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=bs_context_to_binary=Op,arity=1}, As, []) ->
- {bif,Op,atomic_list(As),[]};
-k_bif(_A, #k_internal{name=bs_init_writable=Op,arity=1}, As, Rs) ->
- {bif,Op,atomic_list(As),var_list(Rs)};
-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.
- Name = bif_op(Op),
+%% Build bifs.
+
+k_bif(_A, #k_internal{name=Name}, As, Rs) ->
+ {internal,Name,atomic_list(As),var_list(Rs)};
+k_bif(_A, #k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}}, As, Rs) ->
Ar = length(As),
case is_gc_bif(Name, Ar) of
false ->
@@ -303,9 +291,7 @@ val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Ctxt0, Vdb0) ->
guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Ctxt, Vdb0) ->
Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0),
Gdb = vdb_sub(I+1, I+2, Vdb1),
- OldRefc = put(guard_refc, get(guard_refc)+1),
- G = guard(Kg, I+1, Gdb),
- put(guard_refc, OldRefc),
+ G = protected(Kg, I+1, Gdb),
B = match(Kb, Ls, I+2, Ctxt, Vdb1),
#l{ke={guard_clause,G,B},
i=I,vdb=use_vars((get_kanno(Kg))#k.us, I+2, Vdb1),
@@ -394,7 +380,6 @@ is_gc_bif(node, 0) -> false;
is_gc_bif(node, 1) -> false;
is_gc_bif(element, 2) -> false;
is_gc_bif(get, 1) -> false;
-is_gc_bif(raise, 2) -> false;
is_gc_bif(tuple_size, 1) -> false;
is_gc_bif(Bif, Arity) ->
not (erl_internal:bool_op(Bif, Arity) orelse
@@ -431,16 +416,15 @@ use_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I).
add_var(V, F, L, Vdb) ->
vdb_store_new(V, {V,F,L}, Vdb).
-%% is_in_guard() -> true|false.
-
-is_in_guard() ->
- get(guard_refc) > 0.
-
%% vdb
vdb_new(Vs) ->
sort([{V,0,0} || {var,V} <- Vs]).
+-type var() :: atom().
+
+-spec vdb_find(var(), [vdb_entry()]) -> 'error' | vdb_entry().
+
vdb_find(V, Vdb) ->
case lists:keyfind(V, 1, Vdb) of
false -> error;
diff --git a/lib/compiler/src/v3_life.hrl b/lib/compiler/src/v3_life.hrl
index 9d03a86ccd..5c76312067 100644
--- a/lib/compiler/src/v3_life.hrl
+++ b/lib/compiler/src/v3_life.hrl
@@ -20,8 +20,10 @@
%% This record contains variable life-time annotation for a
%% kernel expression. Added by v3_life, used by v3_codegen.
+-type vdb_entry() :: {atom(),non_neg_integer(),non_neg_integer()}.
+
-record(l, {ke, %Kernel expression
- i=0, %Op number
- vdb=[], %Variable database
- a}). %Core annotation
+ i=0 :: non_neg_integer(), %Op number
+ vdb=[] :: [vdb_entry()], %Variable database
+ a=[] :: [term()]}). %Core annotation