aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/compiler/src/cerl.erl6
-rw-r--r--lib/compiler/src/cerl_trees.erl16
-rw-r--r--lib/compiler/src/core_parse.yrl61
-rw-r--r--lib/compiler/src/core_pp.erl73
-rw-r--r--lib/compiler/src/v3_core.erl2
-rw-r--r--lib/compiler/test/compile_SUITE.erl119
6 files changed, 228 insertions, 49 deletions
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index d033050d3c..37ec4e97c9 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,
@@ -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) ->
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/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..88275998be 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").
@@ -38,20 +38,30 @@
item_indent = 2 :: integer(),
body_indent = 4 :: integer(),
tab_width = 8 :: non_neg_integer(),
- line = 0 :: integer()}).
+ line = 0 :: integer(),
+ clean = true :: boolean()}).
-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) ->
@@ -172,7 +182,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 +206,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 +232,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))
@@ -362,7 +380,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),
@@ -387,7 +408,7 @@ format_clause_1(#c_clause{pats=Ps,guard=G,body=B}, Ctxt) ->
width(Ptxt, Ctxt) + 6))];
false ->
[nl_indent(Ctxt2), "when ",
- format_guard(G, add_indent(Ctxt2, 2))]
+ format_guard(G, add_indent(set_class(Ctxt2, expr), 2))]
end++
" ->",
nl_indent(Ctxt2)
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index de775097e3..3299149457 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -784,7 +784,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/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index e1db99b357..72e88370b6 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -31,7 +31,8 @@
binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1,
other_output/1, encrypted_abstr/1,
strict_record/1,
- missing_testheap/1, cover/1, env/1, core/1, asm/1,
+ missing_testheap/1, cover/1, env/1, core/1,
+ core_roundtrip/1, asm/1,
sys_pre_attributes/1, dialyzer/1,
warnings/1, pre_load_check/1
]).
@@ -50,7 +51,7 @@ all() ->
binary, makedep, cond_and_ifdef, listings, listings_big,
other_output, encrypted_abstr,
strict_record,
- missing_testheap, cover, env, core, asm,
+ missing_testheap, cover, env, core, core_roundtrip, asm,
sys_pre_attributes, dialyzer, warnings, pre_load_check].
groups() ->
@@ -790,6 +791,120 @@ compile_forms(Forms, Opts) ->
Other -> throw({error,Other})
end.
+%% Pretty-print core and read it back. Should be identical.
+
+core_roundtrip(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ Outdir = filename:join(PrivDir, atom_to_list(?FUNCTION_NAME)),
+ ok = file:make_dir(Outdir),
+
+ Wc = filename:join(filename:dirname(code:which(?MODULE)), "*.beam"),
+ TestBeams = filelib:wildcard(Wc),
+ test_lib:p_run(fun(F) -> do_core_roundtrip(F, Outdir) end, TestBeams).
+
+do_core_roundtrip(Beam, Outdir) ->
+ try
+ {ok,{Mod,[{abstract_code,{raw_abstract_v1,Abstr}}]}} =
+ beam_lib:chunks(Beam, [abstract_code]),
+ do_core_roundtrip_1(Mod, Abstr, Outdir)
+ catch
+ throw:{error,Error} ->
+ io:format("*** compilation failure '~p' for file ~s\n",
+ [Error,Beam]),
+ error;
+ Class:Error ->
+ io:format("~p: ~p ~p\n~p\n",
+ [Beam,Class,Error,erlang:get_stacktrace()]),
+ error
+ end.
+
+do_core_roundtrip_1(Mod, Abstr, Outdir) ->
+ {ok,Mod,Core0} = compile:forms(Abstr, [to_core0]),
+ do_core_roundtrip_2(Mod, Core0, Outdir),
+
+ %% Primarily, test that annotations are accepted for all
+ %% constructs. Secondarily, smoke test cerl_trees:label/1.
+ {Core,_} = cerl_trees:label(Core0),
+ do_core_roundtrip_2(Mod, Core, Outdir).
+
+do_core_roundtrip_2(M, Core0, Outdir) ->
+ CoreFile = filename:join(Outdir, atom_to_list(M)++".core"),
+ CorePP = core_pp:format_all(Core0),
+ ok = file:write_file(CoreFile, CorePP),
+
+ %% Parse the .core file and return the result as Core Erlang Terms.
+ Core2 = case compile:file(CoreFile, [report_errors,from_core,
+ no_copt,to_core,binary]) of
+ {ok,M,Core1} -> Core1;
+ Other -> throw({error,Other})
+ end,
+ Core = undo_var_translation(Core2),
+ ok = file:delete(CoreFile),
+
+ case cmp_core(Core0, Core, M) of
+ true -> ok;
+ false -> error
+ end,
+
+ ok.
+
+undo_var_translation(Tree) ->
+ F = fun(Node) ->
+ case cerl:is_c_var(Node) of
+ true ->
+ Name0 = cerl:var_name(Node),
+ try atom_to_list(Name0) of
+ "_X"++Name ->
+ cerl:update_c_var(Node, list_to_atom(Name));
+ "_"++Name ->
+ cerl:update_c_var(Node, list_to_atom(Name));
+ _ ->
+ Node
+ catch
+ error:badarg ->
+ Node
+
+ end;
+ false ->
+ Node
+ end
+ end,
+ cerl_trees:map(F, Tree).
+
+cmp_core(E, E, _Mod) ->
+ true;
+cmp_core(M1, M2, Mod) ->
+ cmp_core_fs(cerl:module_defs(M1), cerl:module_defs(M2), Mod).
+
+cmp_core_fs([F1|T1], [F2|T2], Mod) ->
+ cmp_core_f(F1, F2, Mod) andalso cmp_core_fs(T1, T2, Mod);
+cmp_core_fs([], [], _Mod) ->
+ true;
+cmp_core_fs(_, _, _Mod) ->
+ false.
+
+cmp_core_f(E, E, _Mod) ->
+ true;
+cmp_core_f({Name,F1}, {Name,F2}, Mod) ->
+ case diff(F1, F2) of
+ F1 ->
+ true;
+ Diff ->
+ io:format("~p ~p:\n~p\n", [Mod,Name,Diff]),
+ false
+ end.
+
+diff(E, E) ->
+ E;
+diff([H1|T1], [H2|T2]) ->
+ [diff(H1, H2)|diff(T1, T2)];
+diff(T1, T2) when tuple_size(T1) =:= tuple_size(T2) ->
+ L = diff(tuple_to_list(T1), tuple_to_list(T2)),
+ list_to_tuple(L);
+diff(E1, E2) ->
+ {'DIFF',E1,E2}.
+
+
%% Compile to Beam assembly language (.S) and then try to
%% run .S through the compiler again.
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-02 21:08:46 +0000