aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler/src')
-rw-r--r--lib/compiler/src/beam_asm.erl4
-rw-r--r--lib/compiler/src/beam_bool.erl4
-rw-r--r--lib/compiler/src/beam_utils.erl103
-rw-r--r--lib/compiler/src/cerl.erl13
-rw-r--r--lib/compiler/src/cerl_trees.erl16
-rw-r--r--lib/compiler/src/compile.erl5
-rw-r--r--lib/compiler/src/core_parse.yrl61
-rw-r--r--lib/compiler/src/core_pp.erl168
-rw-r--r--lib/compiler/src/rec_env.erl3
-rw-r--r--lib/compiler/src/sys_core_fold.erl17
-rw-r--r--lib/compiler/src/v3_core.erl25
-rw-r--r--lib/compiler/src/v3_kernel.erl3
12 files changed, 243 insertions, 179 deletions
diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl
index 9a81537006..f6ca7a0afb 100644
--- a/lib/compiler/src/beam_asm.erl
+++ b/lib/compiler/src/beam_asm.erl
@@ -230,9 +230,7 @@ build_attributes(Opts, SourceFile, Attr, MD5) ->
[_|_] -> [{source,SourceFile}]
end,
Misc = case member(slim, Opts) of
- false ->
- {{Y,Mo,D},{H,Mi,S}} = erlang:universaltime(),
- [{time,{Y,Mo,D,H,Mi,S}}|Misc0];
+ false -> Misc0;
true -> []
end,
Compile = [{options,Opts},{version,?COMPILER_VSN}|Misc],
diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl
index f9a08f8718..359fdb6d3c 100644
--- a/lib/compiler/src/beam_bool.erl
+++ b/lib/compiler/src/beam_bool.erl
@@ -238,9 +238,9 @@ extend_block(BlAcc0, Fail, [{block,Is0}|OldAcc]) ->
end;
extend_block(BlAcc, _, OldAcc) -> {BlAcc,OldAcc}.
-extend_block_1([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) ->
+extend_block_1([{set,[{x,_}],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) ->
extend_block_1(Is, Fail, [I|Acc]);
-extend_block_1([{set,[_],As,{bif,Bif,_}}=I|Is]=Is0, Fail, Acc) ->
+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])
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index 37f89dd677..47703b4aa3 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -25,9 +25,8 @@
is_not_used/3,is_not_used_at/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]).
-
--export([join_even/2,split_even/1]).
+ live_opt/1,delete_live_annos/1,combine_heap_needs/2,
+ join_even/2,split_even/1]).
-import(lists, [member/2,sort/1,reverse/1,splitwith/2]).
@@ -67,8 +66,7 @@ is_killed(R, Is, D) ->
St = #live{bl=check_killed_block_fun(),lbl=D,res=gb_trees:empty()},
case check_liveness(R, Is, St) of
{killed,_} -> true;
- {used,_} -> false;
- {unknown,_} -> false
+ {used,_} -> false
end.
%% is_killed_at(Reg, Lbl, State) -> true|false
@@ -78,8 +76,7 @@ is_killed_at(R, Lbl, D) when is_integer(Lbl) ->
St0 = #live{bl=check_killed_block_fun(),lbl=D,res=gb_trees:empty()},
case check_liveness_at(R, Lbl, St0) of
{killed,_} -> true;
- {used,_} -> false;
- {unknown,_} -> false
+ {used,_} -> false
end.
%% is_not_used(Register, [Instruction], State) -> true|false
@@ -93,8 +90,7 @@ is_not_used(R, Is, D) ->
St = #live{bl=fun check_used_block/3,lbl=D,res=gb_trees:empty()},
case check_liveness(R, Is, St) of
{killed,_} -> true;
- {used,_} -> false;
- {unknown,_} -> false
+ {used,_} -> false
end.
%% is_not_used(Register, [Instruction], State) -> true|false
@@ -108,8 +104,7 @@ 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;
- {unknown,_} -> false
+ {used,_} -> false
end.
%% index_labels(FunctionIs) -> State
@@ -137,10 +132,7 @@ index_label(Lbl, Is0, Acc) ->
%% Retrieve the code at the given label.
code_at(L, Ll) ->
- case gb_trees:lookup(L, Ll) of
- {value,Code} -> Code;
- none -> none
- end.
+ 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.
@@ -164,10 +156,10 @@ bif_to_test('=<', [A,B], Fail) -> {test,is_ge,Fail,[B,A]};
bif_to_test('>', [A,B], Fail) -> {test,is_lt,Fail,[B,A]};
bif_to_test('<', [_,_]=Ops, Fail) -> {test,is_lt,Fail,Ops};
bif_to_test('>=', [_,_]=Ops, Fail) -> {test,is_ge,Fail,Ops};
-bif_to_test('==', [A,[]], Fail) -> {test,is_nil,Fail,[A]};
+bif_to_test('==', [A,nil], Fail) -> {test,is_nil,Fail,[A]};
bif_to_test('==', [_,_]=Ops, Fail) -> {test,is_eq,Fail,Ops};
bif_to_test('/=', [_,_]=Ops, Fail) -> {test,is_ne,Fail,Ops};
-bif_to_test('=:=', [A,[]], Fail) -> {test,is_nil,Fail,[A]};
+bif_to_test('=:=', [A,nil], Fail) -> {test,is_nil,Fail,[A]};
bif_to_test('=:=', [_,_]=Ops, Fail) -> {test,is_eq_exact,Fail,Ops};
bif_to_test('=/=', [_,_]=Ops, Fail) -> {test,is_ne_exact,Fail,Ops};
bif_to_test(is_record, [_,_,_]=Ops, Fail) -> {test,is_record,Fail,Ops}.
@@ -235,21 +227,28 @@ combine_heap_needs(Words, {alloc,Alloc}) when is_integer(Words) ->
combine_heap_needs(H1, H2) when is_integer(H1), is_integer(H2) ->
H1+H2.
+%% split_even/1
+%% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]}
+
+split_even(Rs) -> split_even(Rs, [], []).
+
+%% join_even/1
+%% {[1,3,5],[2,4,6]} -> [1,2,3,4,5,6]
+
+join_even([], []) -> [];
+join_even([S|Ss], [D|Ds]) -> [S,D|join_even(Ss, Ds)].
+
%%%
%%% Local functions.
%%%
-%% check_liveness(Reg, [Instruction], {State,BlockCheckFun}) ->
-%% {killed | used | unknown,UpdateState}
-%% Finds out how Reg is used in the instruction sequence. Returns one of:
-%% killed - Reg is assigned a new value or killed by an allocation instruction
-%% used - Reg is used (or possibly referenced by an allocation instruction)
-%% unknown - not possible to determine (perhaps because of an instruction
-%% that we don't recognize)
+%% check_liveness(Reg, [Instruction], #live{}) ->
+%% {killed | 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.
-check_liveness(R, [{set,_,_,_}=I|_], St) ->
- erlang:error(only_allowed_in_blocks, [R,I,St]);
check_liveness(R, [{block,Blk}|Is], #live{bl=BlockCheck}=St0) ->
case BlockCheck(R, Blk, St0) of
{transparent,St} -> check_liveness(R, Is, St);
@@ -461,8 +460,9 @@ check_liveness(R, [{loop_rec,{f,_},{x,0}}|_], St) ->
{x,_} ->
{killed,St};
_ ->
- %% y register. Rarely happens. Be very conversative.
- {unknown,St}
+ %% y register. Rarely happens. Be very conversative and
+ %% assume it's used.
+ {used,St}
end;
check_liveness(R, [{loop_rec_end,{f,Fail}}|_], St) ->
check_liveness_at(R, Fail, St);
@@ -493,7 +493,8 @@ check_liveness(R, [{put_map,{f,_},_,Src,_D,Live,{list,_}}|_], St0) ->
{x,_} ->
{killed,St0};
{y,_} ->
- {unknown,St0}
+ %% Conservatively mark it as used.
+ {used,St0}
end;
check_liveness(R, [{test_heap,N,Live}|Is], St) ->
I = {block,[{set,[],[],{alloc,Live,{nozero,nostack,N,[]}}}]},
@@ -505,12 +506,8 @@ check_liveness(R, [{get_list,S,D1,D2}|Is], St) ->
I = {block,[{set,[D1,D2],[S],get_list}]},
check_liveness(R, [I|Is], St);
check_liveness(_R, Is, St) when is_list(Is) ->
-%% case Is of
-%% [I|_] ->
-%% io:format("~p ~p\n", [_R,I]);
-%% _ -> ok
-%% end,
- {unknown,St}.
+ %% 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
@@ -529,7 +526,7 @@ check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) ->
none ->
{Res,St} = case gb_trees:lookup(Lbl, Ll) of
{value,Is} -> check_liveness(R, Is, St0);
- none -> {unknown,St0}
+ none -> {used,St0}
end,
{Res,St#live{res=gb_trees:insert(Lbl, Res, St#live.res)}}
end.
@@ -594,8 +591,10 @@ check_killed_block(_, []) -> transparent.
%% killed - Reg is assigned a new value or killed by an allocation instruction
%% transparent - Reg is neither used nor killed
%% used - Reg is explicitly used by an instruction
-%%
-%% (Unknown instructions will cause an exception.)
+%%
+%% '%live' annotations are not allowed.
+%%
+%% (Unknown instructions will cause an exception.)
check_used_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St) ->
if
@@ -604,11 +603,6 @@ check_used_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St) ->
end;
check_used_block(R, [{set,Ds,Ss,Op}|Is], St) ->
check_used_block_1(R, Ss, Ds, Op, Is, St);
-check_used_block(R, [{'%live',Live,_}|Is], St) ->
- case R of
- {x,X} when X >= Live -> {killed,St};
- _ -> check_used_block(R, Is, St)
- end;
check_used_block(_, [], St) -> {transparent,St}.
check_used_block_1(R, Ss, Ds, Op, Is, St0) ->
@@ -639,8 +633,7 @@ is_reg_used_at_1(_, 0, 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};
- {unknown,St} -> {true,St}
+ {used,St} -> {true,St}
end.
index_labels_1([{label,Lbl}|Is0], Acc) ->
@@ -756,11 +749,6 @@ live_opt([{select,_,Src,Fail,List}=I|Is], Regs0, D, Acc) ->
Regs1 = x_live([Src], Regs0),
Regs = live_join_labels([Fail|List], D, Regs1),
live_opt(Is, Regs, D, [I|Acc]);
-live_opt([{'try',_,_}=I|Is], Regs, D, Acc) ->
- %% If an exeption happens, all x registers will be killed.
- %% Therefore, we should only base liveness of the code inside
- %% the try.
- live_opt(Is, Regs, D, [I|Acc]);
live_opt([{try_case,_}=I|Is], _, D, Acc) ->
live_opt(Is, live_call(1), D, [I|Acc]);
live_opt([{loop_rec,_Fail,_Dst}=I|Is], _, D, Acc) ->
@@ -860,14 +848,7 @@ x_live([], Regs) -> Regs.
is_live(X, Regs) -> ((Regs bsr X) band 1) =:= 1.
-%% split_even/1
-%% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]}
-split_even(Rs) -> split_even(Rs,[],[]).
-split_even([],Ss,Ds) -> {reverse(Ss),reverse(Ds)};
-split_even([S,D|Rs],Ss,Ds) ->
- split_even(Rs,[S|Ss],[D|Ds]).
-
-%% join_even/1
-%% {[1,3,5],[2,4,6]} -> [1,2,3,4,5,6]
-join_even([],[]) -> [];
-join_even([S|Ss],[D|Ds]) -> [S,D|join_even(Ss,Ds)].
+split_even([], Ss, Ds) ->
+ {reverse(Ss),reverse(Ds)};
+split_even([S,D|Rs], Ss, Ds) ->
+ split_even(Rs, [S|Ss], [D|Ds]).
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index d033050d3c..6dc162db40 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -126,6 +126,7 @@
%% keep map exports here for now
c_map_pattern/1,
is_c_map/1,
+ is_c_map_pattern/1,
map_es/1,
map_arg/1,
update_c_map/3,
@@ -134,7 +135,7 @@
ann_c_map_pattern/2,
map_pair_op/1,map_pair_key/1,map_pair_val/1,
update_c_map_pair/4,
- c_map_pair/2,
+ c_map_pair/2, c_map_pair_exact/2,
ann_c_map_pair/4
]).
@@ -1636,6 +1637,11 @@ is_c_map_empty(#c_map{ es=[] }) -> true;
is_c_map_empty(#c_literal{val=M}) when is_map(M),map_size(M) =:= 0 -> true;
is_c_map_empty(_) -> false.
+-spec is_c_map_pattern(c_map()) -> boolean().
+
+is_c_map_pattern(#c_map{is_pat=IsPat}) ->
+ IsPat.
+
-spec ann_c_map([term()], [c_map_pair()]) -> c_map() | c_literal().
ann_c_map(As, Es) ->
@@ -1688,6 +1694,11 @@ map_pair_op(#c_map_pair{op=Op}) -> Op.
c_map_pair(Key,Val) ->
#c_map_pair{op=#c_literal{val=assoc},key=Key,val=Val}.
+-spec c_map_pair_exact(cerl(), cerl()) -> c_map_pair().
+
+c_map_pair_exact(Key,Val) ->
+ #c_map_pair{op=#c_literal{val=exact},key=Key,val=Val}.
+
-spec ann_c_map_pair([term()], cerl(), cerl(), cerl()) ->
c_map_pair().
diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl
index 6d38748964..b3decbec1f 100644
--- a/lib/compiler/src/cerl_trees.erl
+++ b/lib/compiler/src/cerl_trees.erl
@@ -61,6 +61,7 @@
map_arg/1, map_es/1,
ann_c_map/3,
update_c_map/3,
+ is_c_map_pattern/1, ann_c_map_pattern/2,
map_pair_key/1,map_pair_val/1,map_pair_op/1,
ann_c_map_pair/4,
update_c_map_pair/4
@@ -752,10 +753,17 @@ label(T, N, Env) ->
{As, N2} = label_ann(T, N1),
{ann_c_tuple_skel(As, Ts), N2};
map ->
- {M, N1} = label(map_arg(T), N, Env),
- {Ts, N2} = label_list(map_es(T), N1, Env),
- {As, N3} = label_ann(T, N2),
- {ann_c_map(As, M, Ts), N3};
+ case is_c_map_pattern(T) of
+ false ->
+ {M, N1} = label(map_arg(T), N, Env),
+ {Ts, N2} = label_list(map_es(T), N1, Env),
+ {As, N3} = label_ann(T, N2),
+ {ann_c_map(As, M, Ts), N3};
+ true ->
+ {Ts, N1} = label_list(map_es(T), N, Env),
+ {As, N2} = label_ann(T, N1),
+ {ann_c_map_pattern(As, Ts), N2}
+ end;
map_pair ->
{Op, N1} = label(map_pair_op(T), N, Env),
{Key, N2} = label(map_pair_key(T), N1, Env),
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 65566df025..149086152a 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -1317,7 +1317,7 @@ generate_key(String) when is_list(String) ->
encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) ->
Bin1 = case byte_size(Bin0) rem BlockSize of
0 -> Bin0;
- N -> list_to_binary([Bin0,crypto:rand_bytes(BlockSize-N)])
+ N -> list_to_binary([Bin0,crypto:strong_rand_bytes(BlockSize-N)])
end,
Bin = crypto:block_encrypt(Type, Key, IVec, Bin1),
TypeString = atom_to_list(Type),
@@ -1798,4 +1798,5 @@ pre_load() ->
v3_core,
v3_kernel,
v3_life],
- code:ensure_modules_loaded(L).
+ _ = code:ensure_modules_loaded(L),
+ ok.
diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl
index 315324e906..8028aa99bb 100644
--- a/lib/compiler/src/core_parse.yrl
+++ b/lib/compiler/src/core_parse.yrl
@@ -47,12 +47,14 @@ receive_expr timeout try_expr
sequence catch_expr
variable clause clause_pattern
-map_expr map_pairs map_pair map_pair_assoc map_pair_exact
+map_expr anno_map_expr map_pairs anno_map_pair map_pair map_pair_assoc map_pair_exact
map_pattern map_pair_patterns map_pair_pattern
-annotation anno_fun anno_expression anno_expressions
+annotation anno_atom anno_fun anno_expression anno_expressions
anno_variable anno_variables anno_pattern anno_patterns
anno_function_name
+anno_literal
+anno_segment anno_segment_pattern
anno_clause anno_clauses.
Terminals
@@ -90,7 +92,7 @@ module_definition ->
module_definition ->
'(' 'module' atom module_export module_attribute module_defs 'end'
'-|' annotation ')' :
- #c_module{anno='$9',name=tok_val('$3'),exports='$4',
+ #c_module{anno='$9',name=#c_literal{val=tok_val('$3')},exports='$4',
attrs='$5',defs='$6'}.
module_export -> '[' ']' : [].
@@ -99,7 +101,7 @@ module_export -> '[' exported_names ']' : '$2'.
exported_names -> exported_name ',' exported_names : ['$1' | '$3'].
exported_names -> exported_name : ['$1'].
-exported_name -> function_name : '$1'.
+exported_name -> anno_function_name : '$1'.
module_attribute -> 'attributes' '[' ']' : [].
module_attribute -> 'attributes' '[' attribute_list ']' : '$3'.
@@ -107,8 +109,16 @@ module_attribute -> 'attributes' '[' attribute_list ']' : '$3'.
attribute_list -> attribute ',' attribute_list : ['$1' | '$3'].
attribute_list -> attribute : ['$1'].
-attribute -> atom '=' literal :
- {#c_literal{val=tok_val('$1')},'$3'}.
+attribute -> anno_atom '=' anno_literal :
+ {'$1','$3'}.
+
+anno_atom -> atom :
+ cerl:c_atom(tok_val('$1')).
+anno_atom -> '(' atom '-|' annotation ')' :
+ cerl:ann_c_atom('$4', tok_val('$2')).
+
+anno_literal -> literal : '$1'.
+anno_literal -> '(' literal '-|' annotation ')' : cerl:set_ann('$2', '$4').
module_defs -> function_definitions : '$1'.
@@ -186,7 +196,9 @@ tuple_pattern -> '{' anno_patterns '}' : c_tuple('$2').
map_pattern -> '~' '{' '}' '~' : c_map_pattern([]).
map_pattern -> '~' '{' map_pair_patterns '}' '~' :
- c_map_pattern(lists:sort('$3')).
+ c_map_pattern('$3').
+map_pattern -> '~' '{' map_pair_patterns '|' anno_map_expr '}' '~' :
+ ann_c_map_pattern('$5', '$3').
map_pair_patterns -> map_pair_pattern : ['$1'].
map_pair_patterns -> map_pair_pattern ',' map_pair_patterns : ['$1' | '$3'].
@@ -194,6 +206,9 @@ map_pair_patterns -> map_pair_pattern ',' map_pair_patterns : ['$1' | '$3'].
map_pair_pattern -> anno_expression ':=' anno_pattern :
#c_map_pair{op=#c_literal{val=exact},
key='$1',val='$3'}.
+map_pair_pattern -> '(' anno_expression ':=' anno_pattern '-|' annotation ')' :
+ #c_map_pair{anno='$6',op=#c_literal{val=exact},
+ key='$2',val='$4'}.
cons_pattern -> '[' anno_pattern tail_pattern :
c_cons('$2', '$3').
@@ -206,8 +221,12 @@ tail_pattern -> ',' anno_pattern tail_pattern :
binary_pattern -> '#' '{' '}' '#' : #c_binary{segments=[]}.
binary_pattern -> '#' '{' segment_patterns '}' '#' : #c_binary{segments='$3'}.
-segment_patterns -> segment_pattern ',' segment_patterns : ['$1' | '$3'].
-segment_patterns -> segment_pattern : ['$1'].
+segment_patterns -> anno_segment_pattern ',' segment_patterns : ['$1' | '$3'].
+segment_patterns -> anno_segment_pattern : ['$1'].
+
+anno_segment_pattern -> segment_pattern : '$1'.
+anno_segment_pattern -> '(' segment_pattern '-|' annotation ')' :
+ cerl:set_ann('$2', '$4').
segment_pattern -> '#' '<' anno_pattern '>' '(' anno_expressions ')':
case '$6' of
@@ -289,11 +308,17 @@ tuple -> '{' anno_expressions '}' : c_tuple('$2').
map_expr -> '~' '{' '}' '~' : c_map([]).
map_expr -> '~' '{' map_pairs '}' '~' : c_map('$3').
-map_expr -> '~' '{' map_pairs '|' variable '}' '~' : ann_c_map([], '$5', '$3').
-map_expr -> '~' '{' map_pairs '|' map_expr '}' '~' : ann_c_map([], '$5', '$3').
+map_expr -> '~' '{' map_pairs '|' anno_variable '}' '~' : ann_c_map([], '$5', '$3').
+map_expr -> '~' '{' map_pairs '|' anno_map_expr '}' '~' : ann_c_map([], '$5', '$3').
-map_pairs -> map_pair : ['$1'].
-map_pairs -> map_pair ',' map_pairs : ['$1' | '$3'].
+anno_map_expr -> map_expr : '$1'.
+anno_map_expr -> '(' map_expr '-|' annotation ')' : cerl:set_ann('$2', '$4').
+
+map_pairs -> anno_map_pair : ['$1'].
+map_pairs -> anno_map_pair ',' map_pairs : ['$1' | '$3'].
+
+anno_map_pair -> map_pair : '$1'.
+anno_map_pair -> '(' map_pair '-|' annotation ')' : cerl:set_ann('$2', '$4').
map_pair -> map_pair_assoc : '$1'.
map_pair -> map_pair_exact : '$1'.
@@ -312,8 +337,11 @@ tail -> ',' anno_expression tail : c_cons('$2', '$3').
binary -> '#' '{' '}' '#' : #c_literal{val = <<>>}.
binary -> '#' '{' segments '}' '#' : make_binary('$3').
-segments -> segment ',' segments : ['$1' | '$3'].
-segments -> segment : ['$1'].
+segments -> anno_segment ',' segments : ['$1' | '$3'].
+segments -> anno_segment : ['$1'].
+
+anno_segment -> segment : '$1'.
+anno_segment -> '(' segment '-|' annotation ')' : cerl:set_ann('$2', '$4').
segment -> '#' '<' anno_expression '>' '(' anno_expressions ')':
case '$6' of
@@ -413,7 +441,8 @@ Erlang code.
-include("core_parse.hrl").
--import(cerl, [ann_c_map/3,c_cons/2,c_map/1,c_map_pattern/1,c_tuple/1]).
+-import(cerl, [ann_c_map/3,ann_c_map_pattern/2,c_cons/2,c_map/1,
+ c_map_pattern/1,c_tuple/1]).
tok_val(T) -> element(3, T).
tok_line(T) -> element(2, T).
diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl
index 78a081e9ca..67209d06be 100644
--- a/lib/compiler/src/core_pp.erl
+++ b/lib/compiler/src/core_pp.erl
@@ -21,7 +21,7 @@
-module(core_pp).
--export([format/1]).
+-export([format/1,format_all/1]).
-include("core_parse.hrl").
@@ -33,25 +33,35 @@
%% Prettyprint-formats (naively) an abstract Core Erlang syntax
%% tree.
--record(ctxt, {class = term :: 'clause' | 'def' | 'expr' | 'term',
- indent = 0 :: integer(),
+-record(ctxt, {indent = 0 :: integer(),
item_indent = 2 :: integer(),
body_indent = 4 :: integer(),
- tab_width = 8 :: non_neg_integer(),
- line = 0 :: integer()}).
+ line = 0 :: integer(),
+ clean = true :: boolean()}).
+
+-define(TAB_WIDTH, 8).
-spec format(cerl:cerl()) -> iolist().
format(Node) ->
format(Node, #ctxt{}).
-maybe_anno(Node, Fun, Ctxt) ->
+-spec format_all(cerl:cerl()) -> iolist().
+
+format_all(Node) ->
+ format(Node, #ctxt{clean=false}).
+
+maybe_anno(Node, Fun, #ctxt{clean=false}=Ctxt) ->
As = cerl:get_ann(Node),
- case get_line(As) of
+ maybe_anno(Node, Fun, Ctxt, As);
+maybe_anno(Node, Fun, #ctxt{clean=true}=Ctxt) ->
+ As0 = cerl:get_ann(Node),
+ case get_line(As0) of
none ->
- maybe_anno(Node, Fun, Ctxt, As);
+ maybe_anno(Node, Fun, Ctxt, As0);
Line ->
- if Line > Ctxt#ctxt.line ->
+ As = strip_line(As0),
+ if Line > Ctxt#ctxt.line ->
[io_lib:format("%% Line ~w",[Line]),
nl_indent(Ctxt),
maybe_anno(Node, Fun, Ctxt#ctxt{line = Line}, As)
@@ -61,22 +71,22 @@ maybe_anno(Node, Fun, Ctxt) ->
end
end.
-maybe_anno(Node, Fun, Ctxt, As) ->
- case strip_line(As) of
- [] ->
- Fun(Node, Ctxt);
- List ->
- Ctxt1 = add_indent(Ctxt, 2),
- Ctxt2 = add_indent(Ctxt1, 3),
- ["( ",
- Fun(Node, Ctxt1),
- nl_indent(Ctxt1),
- "-| ",format_anno(List, Ctxt2)," )"
- ]
- end.
+maybe_anno(Node, Fun, Ctxt, []) ->
+ Fun(Node, Ctxt);
+maybe_anno(Node, Fun, Ctxt, List) ->
+ Ctxt1 = add_indent(Ctxt, 2),
+ Ctxt2 = add_indent(Ctxt1, 3),
+ ["( ",
+ Fun(Node, Ctxt1),
+ nl_indent(Ctxt1),
+ "-| ",format_anno(List, Ctxt2)," )"
+ ].
format_anno([_|_]=List, Ctxt) ->
[$[,format_anno_list(List, Ctxt),$]];
+format_anno({file,Name}, _Ctxt) ->
+ %% Optimization: Reduces file size considerably.
+ io_lib:format("{'file',~p}", [Name]);
format_anno(Tuple, Ctxt) when is_tuple(Tuple) ->
[${,format_anno_list(tuple_to_list(Tuple), Ctxt),$}];
format_anno(Val, Ctxt) when is_atom(Val) ->
@@ -121,14 +131,11 @@ format_1(#c_literal{anno=A,val=Bitstring}, Ctxt) when is_bitstring(Bitstring) ->
format_1(#c_binary{anno=A,segments=Segs}, Ctxt);
format_1(#c_literal{anno=A,val=M},Ctxt) when is_map(M) ->
Pairs = maps:to_list(M),
- Op = case Ctxt of
- #ctxt{ class = clause } -> exact;
- _ -> assoc
- end,
- Cpairs = [#c_map_pair{op=#c_literal{val=Op},
+ Op = #c_literal{val=assoc},
+ Cpairs = [#c_map_pair{op=Op,
key=#c_literal{val=K},
val=#c_literal{val=V}} || {K,V} <- Pairs],
- format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt);
+ format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt);
format_1(#c_var{name={I,A}}, _) ->
[core_atom(I),$/,integer_to_list(A)];
format_1(#c_var{name=V}, _) ->
@@ -172,7 +179,8 @@ format_1(#c_tuple{es=Es}, Ctxt) ->
format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
$}
];
-format_1(#c_map{arg=#c_literal{val=M},es=Es}, Ctxt) when is_map(M),map_size(M)=:=0 ->
+format_1(#c_map{arg=#c_literal{anno=[],val=M},es=Es}, Ctxt)
+ when is_map(M), map_size(M) =:= 0 ->
["~{",
format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
"}~"
@@ -195,9 +203,16 @@ format_1(#c_values{es=Es}, Ctxt) ->
format_1(#c_alias{var=V,pat=P}, Ctxt) ->
Txt = [format(V, Ctxt)|" = "],
[Txt|format(P, add_indent(Ctxt, width(Txt, Ctxt)))];
-format_1(#c_let{vars=Vs0,arg=A,body=B}, Ctxt) ->
- Vs = [cerl:set_ann(V, []) || V <- Vs0],
- case is_simple_term(A) of
+format_1(#c_let{anno=Anno0,vars=Vs0,arg=A0,body=B}, #ctxt{clean=Clean}=Ctxt) ->
+ {Vs,A,Anno} = case Clean of
+ false ->
+ {Vs0,A0,Anno0};
+ true ->
+ {[cerl:set_ann(V, []) || V <- Vs0],
+ cerl:set_ann(A0, []),
+ []}
+ end,
+ case is_simple_term(A) andalso Anno =:= [] of
false ->
Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.body_indent),
["let ",
@@ -214,7 +229,7 @@ format_1(#c_let{vars=Vs0,arg=A,body=B}, Ctxt) ->
["let ",
format_values(Vs, add_indent(Ctxt, 4)),
" = ",
- format(cerl:set_ann(A, []), Ctxt1),
+ format(A, Ctxt1),
nl_indent(Ctxt),
"in "
| format(B, add_indent(Ctxt, 4))
@@ -321,35 +336,30 @@ format_1(#c_module{name=N,exports=Es,attrs=As,defs=Ds}, Ctxt) ->
[Mod," [",
format_vseq(Es,
"", ",",
- add_indent(set_class(Ctxt, term), width(Mod, Ctxt)+2),
+ add_indent(Ctxt, width(Mod, Ctxt)+2),
fun format/2),
"]",
nl_indent(Ctxt),
" attributes [",
format_vseq(As,
"", ",",
- add_indent(set_class(Ctxt, def), 16),
+ add_indent(Ctxt, 16),
fun format_def/2),
"]",
nl_indent(Ctxt),
format_funcs(Ds, Ctxt),
nl_indent(Ctxt)
| "end"
- ];
-format_1(Type, _) ->
- ["** Unsupported type: ",
- io_lib:write(Type)
- | " **"
].
format_funcs(Fs, Ctxt) ->
format_vseq(Fs,
"", "",
- set_class(Ctxt, def),
+ Ctxt,
fun format_def/2).
format_def({N,V}, Ctxt0) ->
- Ctxt1 = add_indent(set_class(Ctxt0, expr), Ctxt0#ctxt.body_indent),
+ Ctxt1 = add_indent(Ctxt0, Ctxt0#ctxt.body_indent),
[format(N, Ctxt0),
" =",
nl_indent(Ctxt1)
@@ -362,7 +372,10 @@ format_values(Vs, Ctxt) ->
format_hseq(Vs, ",", add_indent(Ctxt, 1), fun format/2),
$>].
-format_bitstr(#c_bitstr{val=V,size=S,unit=U,type=T,flags=Fs}, Ctxt0) ->
+format_bitstr(Node, Ctxt) ->
+ maybe_anno(Node, fun do_format_bitstr/2, Ctxt).
+
+do_format_bitstr(#c_bitstr{val=V,size=S,unit=U,type=T,flags=Fs}, Ctxt0) ->
Vs = [S, U, T, Fs],
Ctxt1 = add_indent(Ctxt0, 2),
Val = format(V, Ctxt1),
@@ -370,8 +383,7 @@ format_bitstr(#c_bitstr{val=V,size=S,unit=U,type=T,flags=Fs}, Ctxt0) ->
["#<", Val, ">(", format_hseq(Vs,",", Ctxt2, fun format/2), $)].
format_clauses(Cs, Ctxt) ->
- format_vseq(Cs, "", "", set_class(Ctxt, clause),
- fun format_clause/2).
+ format_vseq(Cs, "", "", Ctxt, fun format_clause/2).
format_clause(Node, Ctxt) ->
maybe_anno(Node, fun format_clause_1/2, Ctxt).
@@ -383,15 +395,13 @@ format_clause_1(#c_clause{pats=Ps,guard=G,body=B}, Ctxt) ->
case is_trivial_guard(G) of
true ->
[" when ",
- format_guard(G, add_indent(set_class(Ctxt, expr),
- width(Ptxt, Ctxt) + 6))];
+ format_guard(G, add_indent(Ctxt, width(Ptxt, Ctxt) + 6))];
false ->
[nl_indent(Ctxt2), "when ",
format_guard(G, add_indent(Ctxt2, 2))]
end++
" ->",
- nl_indent(Ctxt2)
- | format(B, set_class(Ctxt2, expr))
+ nl_indent(Ctxt2) | format(B, Ctxt2)
].
is_trivial_guard(#c_literal{val=Val}) when is_atom(Val) -> true;
@@ -445,50 +455,53 @@ format_list_tail(Tail, Ctxt) ->
format_map_pair(Op, K, V, Ctxt0) ->
Ctxt1 = add_indent(Ctxt0, 1),
- Txt = format(K, set_class(Ctxt1, expr)),
+ Txt = format(K, Ctxt1),
Ctxt2 = add_indent(Ctxt0, width(Txt, Ctxt1)),
[Txt,Op,format(V, Ctxt2)].
-indent(Ctxt) -> indent(Ctxt#ctxt.indent, Ctxt).
-
-indent(N, _) when N =< 0 -> "";
-indent(N, Ctxt) ->
- T = Ctxt#ctxt.tab_width,
- string:chars($\t, N div T, string:chars($\s, N rem T)).
+indent(#ctxt{indent=N}) ->
+ if
+ N =< 0 ->
+ "";
+ true ->
+ string:chars($\t, N div ?TAB_WIDTH, spaces(N rem ?TAB_WIDTH))
+ end.
nl_indent(Ctxt) -> [$\n|indent(Ctxt)].
+spaces(0) -> "";
+spaces(1) -> " ";
+spaces(2) -> " ";
+spaces(3) -> " ";
+spaces(4) -> " ";
+spaces(5) -> " ";
+spaces(6) -> " ";
+spaces(7) -> " ".
+%% Undo indentation done by nl_indent/1.
unindent(T, Ctxt) ->
- unindent(T, Ctxt#ctxt.indent, Ctxt, []).
+ unindent(T, Ctxt#ctxt.indent, []).
-unindent(T, N, _, C) when N =< 0 ->
+unindent(T, N, C) when N =< 0 ->
[T|C];
-unindent([$\s|T], N, Ctxt, C) ->
- unindent(T, N - 1, Ctxt, C);
-unindent([$\t|T], N, Ctxt, C) ->
- Tab = Ctxt#ctxt.tab_width,
+unindent([$\s|T], N, C) ->
+ unindent(T, N - 1, C);
+unindent([$\t|T], N, C) ->
+ Tab = ?TAB_WIDTH,
if N >= Tab ->
- unindent(T, N - Tab, Ctxt, C);
+ unindent(T, N - Tab, C);
true ->
- unindent([string:chars($\s, Tab - N)|T], 0, Ctxt, C)
+ unindent([spaces(Tab - N)|T], 0, C)
end;
-unindent([L|T], N, Ctxt, C) when is_list(L) ->
- unindent(L, N, Ctxt, [T|C]);
-unindent([H|T], _, _, C) ->
- [H|[T|C]];
-unindent([], N, Ctxt, [H|T]) ->
- unindent(H, N, Ctxt, T);
-unindent([], _, _, []) -> [].
+unindent([L|T], N, C) when is_list(L) ->
+ unindent(L, N, [T|C]).
width(Txt, Ctxt) ->
- try width(Txt, 0, Ctxt, [])
- catch error:_ -> exit({bad_text,Txt})
- end.
+ width(Txt, 0, Ctxt, []).
width([$\t|T], A, Ctxt, C) ->
- width(T, A + Ctxt#ctxt.tab_width, Ctxt, C);
+ width(T, A + ?TAB_WIDTH, Ctxt, C);
width([$\n|T], _, Ctxt, C) ->
width(unindent([T|C], Ctxt), Ctxt);
width([H|T], A, Ctxt, C) when is_list(H) ->
@@ -502,14 +515,9 @@ width([], A, _, []) -> A.
add_indent(Ctxt, Dx) ->
Ctxt#ctxt{indent = Ctxt#ctxt.indent + Dx}.
-set_class(Ctxt, Class) ->
- Ctxt#ctxt{class = Class}.
-
core_atom(A) -> io_lib:write_string(atom_to_list(A), $').
-is_simple_term(#c_values{es=Es}) ->
- length(Es) < 3 andalso lists:all(fun is_simple_term/1, Es);
is_simple_term(#c_tuple{es=Es}) ->
length(Es) < 4 andalso lists:all(fun is_simple_term/1, Es);
is_simple_term(#c_var{}) -> true;
diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl
index 2b89dc628c..936c5f6106 100644
--- a/lib/compiler/src/rec_env.erl
+++ b/lib/compiler/src/rec_env.erl
@@ -603,7 +603,8 @@ generate(_N, Range) ->
%% same BEAM code.
case rand:export_seed() of
undefined ->
- rand:seed(exsplus, {1,42,2053});
+ _ = rand:seed(exsplus, {1,42,2053}),
+ ok;
_ ->
ok
end,
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index b5b8d8a8ec..dbc27db377 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -374,10 +374,21 @@ expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) ->
T1 = expr(T0, value, Sub),
A1 = body(A0, Ctxt, Sub),
Recv#c_receive{clauses=Cs1,timeout=T1,action=A1};
-expr(#c_apply{op=Op0,args=As0}=App, _, Sub) ->
+expr(#c_apply{anno=Anno,op=Op0,args=As0}=App, _, Sub) ->
Op1 = expr(Op0, value, Sub),
As1 = expr_list(As0, value, Sub),
- App#c_apply{op=Op1,args=As1};
+ case Op1 of
+ #c_var{} ->
+ App#c_apply{op=Op1,args=As1};
+ _ ->
+ add_warning(App, invalid_call),
+ Err = #c_call{anno=Anno,
+ module=#c_literal{val=erlang},
+ name=#c_literal{val=error},
+ args=[#c_tuple{es=[#c_literal{val='badfun'},
+ Op1]}]},
+ make_effect_seq(As1++[Err], Sub)
+ end;
expr(#c_call{module=M0,name=N0}=Call0, Ctxt, Sub) ->
M1 = expr(M0, value, Sub),
N1 = expr(N0, value, Sub),
@@ -3395,6 +3406,8 @@ format_error({no_effect,{erlang,F,A}}) ->
format_error(result_ignored) ->
"the result of the expression is ignored "
"(suppress the warning by assigning the expression to the _ variable)";
+format_error(invalid_call) ->
+ "invalid function call";
format_error(useless_building) ->
"a term is constructed, but never used";
format_error(bin_opt_alias) ->
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index de775097e3..83b3650180 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -510,8 +510,16 @@ unforce(_, Vs) -> Vs.
exprs([E0|Es0], St0) ->
{E1,Eps,St1} = expr(E0, St0),
- {Es1,St2} = exprs(Es0, St1),
- {Eps ++ [E1] ++ Es1,St2};
+ case E1 of
+ #iprimop{name=#c_literal{val=match_fail}} ->
+ %% Must discard the rest of the body, because it
+ %% may refer to variables that have not been bound.
+ %% Example: {ok={error,E}} = foo(), E.
+ {Eps ++ [E1],St1};
+ _ ->
+ {Es1,St2} = exprs(Es0, St1),
+ {Eps ++ [E1] ++ Es1,St2}
+ end;
exprs([], St) -> {[],St}.
%% expr(Expr, State) -> {Cexpr,[PreExp],State}.
@@ -681,9 +689,14 @@ expr({match,L,P0,E0}, St0) ->
Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])),
case P2 of
nomatch ->
- St = add_warning(L, nomatch, St5),
- {#icase{anno=#a{anno=Lanno},
- args=[E2],clauses=[],fc=Fc},Eps1++Eps2,St};
+ St6 = add_warning(L, nomatch, St5),
+ {Expr,Eps3,St} = safe(E1, St6),
+ Eps = Eps1 ++ Eps2 ++ Eps3,
+ Badmatch = c_tuple([#c_literal{val=badmatch},Expr]),
+ Fail = #iprimop{anno=#a{anno=Lanno},
+ name=#c_literal{val=match_fail},
+ args=[Badmatch]},
+ {Fail,Eps,St};
Other when not is_atom(Other) ->
{#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps1++Eps2,St5}
end;
@@ -784,7 +797,7 @@ badmap_term(_Map, #core{in_guard=true}) ->
%% since it is not user-visible.
#c_literal{val=badmap};
badmap_term(Map, #core{in_guard=false}) ->
- #c_tuple{es=[#c_literal{val=badmap},Map]}.
+ c_tuple([#c_literal{val=badmap},Map]).
map_build_pairs(Map, Es0, Ann, St0) ->
{Es,Pre,St1} = map_build_pairs_1(Es0, St0),
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 4a6330fce4..402e3c4912 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2015. All Rights Reserved.
+%% Copyright Ericsson AB 1999-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.
@@ -147,6 +147,7 @@ include_attribute(callback) -> false;
include_attribute(opaque) -> false;
include_attribute(export_type) -> false;
include_attribute(record) -> false;
+include_attribute(optional_callbacks) -> false;
include_attribute(_) -> true.
function({#c_var{name={F,Arity}=FA},Body}, St0) ->
generated by cgit v1.2.3 (git 2.25.1) at 2025-06-11 06:47:25 +0000