diff options
Diffstat (limited to 'lib/compiler/src')
-rw-r--r-- | lib/compiler/src/Makefile | 11 | ||||
-rw-r--r-- | lib/compiler/src/compile.erl | 46 | ||||
-rw-r--r-- | lib/compiler/src/compiler.app.src | 1 | ||||
-rw-r--r-- | lib/compiler/src/core_lint.erl | 3 | ||||
-rw-r--r-- | lib/compiler/src/core_scan.erl | 27 | ||||
-rw-r--r-- | lib/compiler/src/sys_core_fold.erl | 149 | ||||
-rw-r--r-- | lib/compiler/src/sys_expand_pmod.erl | 433 | ||||
-rw-r--r-- | lib/compiler/src/sys_pre_expand.erl | 147 |
8 files changed, 163 insertions, 654 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index cbcbf79839..8d54dffd73 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -82,7 +82,6 @@ MODULES = \ sys_core_dsetel \ sys_core_fold \ sys_core_inline \ - sys_expand_pmod \ sys_pre_attributes \ sys_pre_expand \ v3_codegen \ @@ -145,19 +144,19 @@ clean: # ---------------------------------------------------- $(APP_TARGET): $(APP_SRC) ../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ + $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ + $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ $(EGEN)/beam_opcodes.erl $(EGEN)/beam_opcodes.hrl: genop.tab - $(PERL) $(ERL_TOP)/erts/emulator/utils/beam_makeops -compiler -outdir $(EGEN) $< + $(gen_verbose)$(PERL) $(ERL_TOP)/erts/emulator/utils/beam_makeops -compiler -outdir $(EGEN) $< $(EBIN)/beam_asm.beam: $(ESRC)/beam_asm.erl $(EGEN)/beam_opcodes.hrl - $(ERLC) $(ERL_COMPILE_FLAGS) -DCOMPILER_VSN='"$(VSN)"' -o$(EBIN) $< + $(V_ERLC) $(ERL_COMPILE_FLAGS) -DCOMPILER_VSN='"$(VSN)"' -o$(EBIN) $< $(EBIN)/cerl_inline.beam: $(ESRC)/cerl_inline.erl - $(ERLC) $(ERL_COMPILE_FLAGS) +nowarn_shadow_vars -o$(EBIN) $< + $(V_ERLC) $(ERL_COMPILE_FLAGS) +nowarn_shadow_vars -o$(EBIN) $< # ---------------------------------------------------- # Release Target diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index df1af36eeb..5f394f0b65 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -248,6 +248,7 @@ format_error({module_name,Mod,Filename}) -> abstract_code=[], %Abstract code for debugger. options=[] :: [option()], %Options for compilation mod_options=[] :: [option()], %Options for module_info + encoding=none :: none | epp:source_coding(), errors=[], warnings=[]}). @@ -734,8 +735,9 @@ collect_asm([X | Rest], R) -> beam_consult_asm(St) -> case file:consult(St#compile.ifile) of {ok, Forms0} -> + Encoding = epp:read_encoding(St#compile.ifile), {Module, Forms} = preprocess_asm_forms(Forms0), - {ok,St#compile{module=Module, code=Forms}}; + {ok,St#compile{module=Module, code=Forms, encoding=Encoding}}; {error,E} -> Es = [{St#compile.ifile,[{none,?MODULE,{open,E}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} @@ -777,7 +779,8 @@ parse_module(St) -> R = epp:parse_file(St#compile.ifile, IncludePath, pre_defs(Opts)), case R of {ok,Forms} -> - {ok,St#compile{code=Forms}}; + Encoding = epp:read_encoding(St#compile.ifile), + {ok,St#compile{code=Forms,encoding=Encoding}}; {error,E} -> Es = [{St#compile.ifile,[{none,?MODULE,{epp,E}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} @@ -892,7 +895,6 @@ foldl_core_transforms(St, []) -> {ok,St}. %%% Fetches the module name from a list of forms. The module attribute must %%% be present. -get_module([{attribute,_,module,{M,_As}} | _]) -> M; get_module([{attribute,_,module,M} | _]) -> M; get_module([_ | Rest]) -> get_module(Rest). @@ -904,11 +906,8 @@ add_default_base(St, Forms) -> F = St#compile.filename, case F of "" -> - M = case get_module(Forms) of - PackageModule when is_list(PackageModule) -> last(PackageModule); - M0 -> M0 - end, - St#compile{base = atom_to_list(M)}; + M = get_module(Forms), + St#compile{base=atom_to_list(M)}; _ -> St end. @@ -1339,16 +1338,12 @@ save_binary(#compile{code=none}=St) -> {ok,St}; save_binary(#compile{module=Mod,ofile=Outfile, options=Opts}=St) -> %% Test that the module name and output file name match. - %% We must take care to not completely break a packaged module - %% (even though packages still is as an experimental, unsupported - %% feature) - so we will extract the last part of a packaged - %% module name and compare only that. case member(no_error_module_mismatch, Opts) of true -> save_binary_1(St); false -> Base = filename:rootname(filename:basename(Outfile)), - case lists:last(packages:split(Mod)) of + case atom_to_list(Mod) of Base -> save_binary_1(St); _ -> @@ -1424,28 +1419,28 @@ report_warnings(#compile{options=Opts,warnings=Ws0}) -> end. format_message(F, P, [{{Line,Column}=Loc,Mod,E}|Es]) -> - M = {{F,Loc},io_lib:format("~s:~w:~w ~s~s\n", + M = {{F,Loc},io_lib:format("~s:~w:~w ~s~ts\n", [F,Line,Column,P,Mod:format_error(E)])}, [M|format_message(F, P, Es)]; format_message(F, P, [{Line,Mod,E}|Es]) -> - M = {{F,{Line,0}},io_lib:format("~s:~w: ~s~s\n", + M = {{F,{Line,0}},io_lib:format("~s:~w: ~s~ts\n", [F,Line,P,Mod:format_error(E)])}, [M|format_message(F, P, Es)]; format_message(F, P, [{Mod,E}|Es]) -> - M = {none,io_lib:format("~s: ~s~s\n", [F,P,Mod:format_error(E)])}, + M = {none,io_lib:format("~s: ~s~ts\n", [F,P,Mod:format_error(E)])}, [M|format_message(F, P, Es)]; format_message(_, _, []) -> []. %% list_errors(File, ErrorDescriptors) -> ok list_errors(F, [{{Line,Column},Mod,E}|Es]) -> - io:fwrite("~s:~w:~w: ~s\n", [F,Line,Column,Mod:format_error(E)]), + io:fwrite("~s:~w:~w: ~ts\n", [F,Line,Column,Mod:format_error(E)]), list_errors(F, Es); list_errors(F, [{Line,Mod,E}|Es]) -> - io:fwrite("~s:~w: ~s\n", [F,Line,Mod:format_error(E)]), + io:fwrite("~s:~w: ~ts\n", [F,Line,Mod:format_error(E)]), list_errors(F, Es); list_errors(F, [{Mod,E}|Es]) -> - io:fwrite("~s: ~s\n", [F,Mod:format_error(E)]), + io:fwrite("~s: ~ts\n", [F,Mod:format_error(E)]), list_errors(F, Es); list_errors(_F, []) -> ok. @@ -1501,10 +1496,12 @@ src_listing(Ext, St) -> Ext, St). do_src_listing(Lf, Fs) -> - foreach(fun (F) -> io:put_chars(Lf, [erl_pp:form(F),"\n"]) end, + 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, St) -> +listing(Ext, St0) -> + St = St0#compile{encoding = none}, listing(fun(Lf, Fs) -> beam_listing:module(Lf, Fs) end, Ext, St). listing(LFun, Ext, St) -> @@ -1512,6 +1509,7 @@ listing(LFun, Ext, St) -> case file:open(Lfile, [write,delayed_write]) of {ok,Lf} -> Code = restore_expanded_types(Ext, St#compile.code), + output_encoding(Lf, St), LFun(Lf, Code), ok = file:close(Lf), {ok,St}; @@ -1520,6 +1518,12 @@ listing(LFun, Ext, St) -> {error,St#compile{errors=St#compile.errors ++ Es}} end. +output_encoding(F, #compile{encoding = none}) -> + ok = io:setopts(F, [{encoding, epp:default_encoding()}]); +output_encoding(F, #compile{encoding = Encoding}) -> + ok = io:setopts(F, [{encoding, Encoding}]), + ok = io:fwrite(F, <<"%% ~s\n">>, [epp:encoding_to_string(Encoding)]). + restore_expanded_types("P", Fs) -> epp:restore_typed_record_fields(Fs); restore_expanded_types("E", {M,I,Fs0}) -> diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 94c78e68f9..9a02121d8b 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -57,7 +57,6 @@ sys_core_dsetel, sys_core_fold, sys_core_inline, - sys_expand_pmod, sys_pre_attributes, sys_pre_expand, v3_codegen, diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index b513a8965c..21296a8b66 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -247,7 +247,8 @@ gbody(E, Def, Rt, St0) -> false -> St1 end. -gexpr(#c_var{name=N}, Def, _Rt, St) -> expr_var(N, Def, St); +gexpr(#c_var{name=N}, Def, _Rt, St) when is_atom(N); is_integer(N) -> + expr_var(N, Def, St); gexpr(#c_literal{}, _Def, _Rt, St) -> St; gexpr(#c_cons{hd=H,tl=T}, Def, _Rt, St) -> gexpr_list([H,T], Def, St); diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl index 5aab8ae855..0ca2f57dde 100644 --- a/lib/compiler/src/core_scan.erl +++ b/lib/compiler/src/core_scan.erl @@ -1,7 +1,8 @@ +%% -*- coding: utf-8 -*- %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2012. 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 @@ -31,16 +32,16 @@ %% 173 - 176 { - ~ punctuation %% 177 DEL control %% 200 - 237 control -%% 240 - 277 NBSP - � punctuation -%% 300 - 326 � - � uppercase -%% 327 � punctuation -%% 330 - 336 � - � uppercase -%% 337 - 366 � - � lowercase -%% 367 � punctuation -%% 370 - 377 � - � lowercase +%% 240 - 277 NBSP - ¿ punctuation +%% 300 - 326 À - Ö uppercase +%% 327 × punctuation +%% 330 - 336 Ø - Þ uppercase +%% 337 - 366 ß - ö lowercase +%% 367 ÷ punctuation +%% 370 - 377 ø - ÿ lowercase %% %% Many punctuation characters region have special meaning. Must -%% watch using � \327, bvery close to x \170 +%% watch using × \327, bvery close to x \170 -module(core_scan). @@ -239,11 +240,11 @@ scan1([C|Cs], Toks, Pos) when C >= $\200, C =< $\240 -> scan1(Cs, Toks, Pos); scan1([C|Cs], Toks, Pos) when C >= $a, C =< $z -> %Keywords scan_key_word(C, Cs, Toks, Pos); -scan1([C|Cs], Toks, Pos) when C >= $�, C =< $�, C /= $� -> +scan1([C|Cs], Toks, Pos) when C >= $ß, C =< $ÿ, C /= $÷ -> scan_key_word(C, Cs, Toks, Pos); scan1([C|Cs], Toks, Pos) when C >= $A, C =< $Z -> %Variables scan_variable(C, Cs, Toks, Pos); -scan1([C|Cs], Toks, Pos) when C >= $�, C =< $�, C /= $� -> +scan1([C|Cs], Toks, Pos) when C >= $À, C =< $Þ, C /= $× -> scan_variable(C, Cs, Toks, Pos); scan1([C|Cs], Toks, Pos) when C >= $0, C =< $9 -> %Numbers scan_number(C, Cs, Toks, Pos); @@ -308,9 +309,9 @@ scan_name([], Ncs) -> {Ncs,[]}. name_char(C) when C >= $a, C =< $z -> true; -name_char(C) when C >= $�, C =< $�, C /= $� -> true; +name_char(C) when C >= $ß, C =< $ÿ, C /= $÷ -> true; name_char(C) when C >= $A, C =< $Z -> true; -name_char(C) when C >= $�, C =< $�, C /= $� -> true; +name_char(C) when C >= $À, C =< $Þ, C /= $× -> true; name_char(C) when C >= $0, C =< $9 -> true; name_char($_) -> true; name_char($@) -> true; diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 18fba7962b..fbd7452301 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -686,11 +686,14 @@ call_1(#c_call{anno=Anno}, lists, all, [Arg1,Arg2], Sub) -> C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]}, clauses = [CC1, CC2, CC3]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, body=#c_literal{val=true}}, - Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, + Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail(Anno, Err2)}, + body=match_fail([{function_name,{'lists^all',1}}|Anno], Err2)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -713,11 +716,14 @@ call_1(#c_call{anno=Anno}, lists, any, [Arg1,Arg2], Sub) -> C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]}, clauses = [CC1, CC2, CC3]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, body=#c_literal{val=false}}, - Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, + Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail(Anno, Err2)}, + body=match_fail([{function_name,{'lists^any',1}}|Anno], Err2)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -733,11 +739,14 @@ call_1(#c_call{anno=Anno}, lists, foreach, [Arg1,Arg2], Sub) -> C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_seq{arg=#c_apply{anno=Anno, op=F, args=[X]}, body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, body=#c_literal{val=ok}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail(Anno, Err)}, + body=match_fail([{function_name,{'lists^foreach',1}}|Anno], Err)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -756,14 +765,18 @@ call_1(#c_call{anno=Anno}, lists, map, [Arg1,Arg2], Sub) -> op=F, args=[X]}, body=#c_cons{hd=H, + anno=[compiler_generated], tl=#c_apply{anno=Anno, op=Loop, args=[Xs]}}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, body=#c_literal{val=[]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail(Anno, Err)}, + body=match_fail([{function_name,{'lists^map',1}}|Anno], Err)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -780,18 +793,21 @@ call_1(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2], Sub) -> C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_let{vars=[H], arg=#c_apply{anno=Anno, op=F, args=[X]}, - body=#c_call{anno=Anno, + body=#c_call{anno=[compiler_generated|Anno], module=#c_literal{val=erlang}, name=#c_literal{val='++'}, args=[H, #c_apply{anno=Anno, op=Loop, args=[Xs]}]}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, body=#c_literal{val=[]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail(Anno, Err)}, + body=match_fail([{function_name,{'lists^flatmap',1}}|Anno], Err)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -807,7 +823,7 @@ call_1(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2], Sub) -> B = #c_var{name='B'}, Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, - body=#c_cons{hd=X, tl=Xs}}, + body=#c_cons{anno=[compiler_generated], hd=X, tl=Xs}}, CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, body=Xs}, CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, @@ -821,11 +837,14 @@ call_1(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2], Sub) -> op=Loop, args=[Xs]}, body=Case}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, body=#c_literal{val=[]}}, - Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, + Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail(Anno, Err2)}, + body=match_fail([{function_name,{'lists^filter',1}}|Anno], Err2)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -845,10 +864,14 @@ call_1(#c_call{anno=Anno}, lists, foldl, [Arg1,Arg2,Arg3], Sub) -> args=[Xs, #c_apply{anno=Anno, op=F, args=[X, A]}]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, body=A}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=2}]}, + body=A}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail(Anno, Err)}, + body=match_fail([{function_name,{'lists^foldl',2}}|Anno], Err)}, Fun = #c_fun{vars=[Xs, A], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -868,10 +891,14 @@ call_1(#c_call{anno=Anno}, lists, foldr, [Arg1,Arg2,Arg3], Sub) -> args=[X, #c_apply{anno=Anno, op=Loop, args=[Xs, A]}]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, body=A}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=2}]}, + body=A}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail(Anno, Err)}, + body=match_fail([{function_name,{'lists^foldr',2}}|Anno], Err)}, Fun = #c_fun{vars=[Xs, A], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -901,7 +928,10 @@ call_1(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3], Sub) -> op=Loop, args=[Xs, Avar]}, #c_tuple{es=[Xs, Avar]}, - #c_tuple{es=[#c_cons{hd=X, tl=Xs}, Avar]}) + #c_tuple{anno=[compiler_generated], + es=[#c_cons{anno=[compiler_generated], + hd=X, tl=Xs}, + Avar]}) %%% Multiple-value version %%% #c_let{vars=[Xs,A], %%% %% The tuple here will be optimised @@ -910,14 +940,18 @@ call_1(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3], Sub) -> %%% body=#c_values{es=[#c_cons{hd=X, tl=Xs}, %%% A]}} )}, - C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=2}]}, %%% Tuple passing version - body=#c_tuple{es=[#c_literal{val=[]}, Avar]}}, + body=#c_tuple{anno=[compiler_generated], + es=[#c_literal{val=[]}, Avar]}}, %%% Multiple-value version %%% body=#c_values{es=[#c_literal{val=[]}, A]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail(Anno, Err)}, + body=match_fail([{function_name,{'lists^mapfoldl',2}}|Anno], Err)}, Fun = #c_fun{vars=[Xs, Avar], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -955,7 +989,9 @@ call_1(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3], Sub) -> #c_tuple{es=[Xs, Avar]}, Match(#c_apply{anno=Anno, op=F, args=[X, Avar]}, #c_tuple{es=[X, Avar]}, - #c_tuple{es=[#c_cons{hd=X, tl=Xs}, Avar]})) + #c_tuple{anno=[compiler_generated], + es=[#c_cons{anno=[compiler_generated], + hd=X, tl=Xs}, Avar]})) %%% Multiple-value version %%% body=#c_let{vars=[Xs,A], %%% %% The tuple will be optimised away @@ -965,14 +1001,18 @@ call_1(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3], Sub) -> %%% #c_values{es=[#c_cons{hd=X, tl=Xs}, %%% A]})} }, - C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=2}]}, %%% Tuple passing version - body=#c_tuple{es=[#c_literal{val=[]}, Avar]}}, + body=#c_tuple{anno=[compiler_generated], + es=[#c_literal{val=[]}, Avar]}}, %%% Multiple-value version %%% body=#c_values{es=[#c_literal{val=[]}, A]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail(Anno, Err)}, + body=match_fail([{function_name,{'lists^mapfoldr',2}}|Anno], Err)}, Fun = #c_fun{vars=[Xs, Avar], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -2632,16 +2672,19 @@ bsm_nonempty([#c_clause{pats=Ps}|Cs], Pos) -> bsm_nonempty([], _ ) -> false. %% bsm_ensure_no_partition(Cs, Pos) -> ok (exception if problem) -%% We must make sure that binary matching is not partitioned between +%% We must make sure that matching is not partitioned between %% variables like this: %% foo(<<...>>) -> ... -%% foo(Var) when ... -> ... -%% 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. +%% 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). @@ -2649,6 +2692,12 @@ bsm_ensure_no_partition(Cs, Pos) -> %% 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. @@ -2658,8 +2707,7 @@ bsm_ensure_no_partition_2([#c_binary{}=Where|_], 1, _, Vstate, State) -> before when Vstate =:= simple_vars -> within; before -> bsm_problem(Where, Vstate); within when Vstate =:= simple_vars -> within; - within -> bsm_problem(Where, Vstate); - 'after' -> bsm_problem(Where, bin_partition) + 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. @@ -2708,6 +2756,15 @@ bsm_ensure_no_partition_2([#c_var{name=V}|Ps], N, G, Vstate, S) -> 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}|Cs], Pos) -> + case nth(Pos, Ps) of + #c_var{} -> + bsm_ensure_no_partition_after(Cs, Pos); + P -> + bsm_problem(P, 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; @@ -2832,7 +2889,7 @@ format_error(useless_building) -> format_error(bin_opt_alias) -> "INFO: the '=' operator will prevent delayed sub binary optimization"; format_error(bin_partition) -> - "INFO: non-consecutive clauses that match binaries " + "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; " diff --git a/lib/compiler/src/sys_expand_pmod.erl b/lib/compiler/src/sys_expand_pmod.erl deleted file mode 100644 index da644b4f0b..0000000000 --- a/lib/compiler/src/sys_expand_pmod.erl +++ /dev/null @@ -1,433 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2011. 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% -%% --module(sys_expand_pmod). - -%% Expand function definition forms of parameterized module. We assume -%% all record definitions, imports, queries, etc., have been expanded -%% away. Any calls on the form 'foo(...)' must be calls to local -%% functions. Auto-generated functions (module_info,...) have not yet -%% been added to the function definitions, but are listed in 'defined' -%% and 'exports'. The automatic 'new/N' function is neither added to the -%% definitions nor to the 'exports'/'defines' lists yet. - --export([forms/4]). - --record(pmod, {parameters, exports, defined, predef}). - -%% TODO: more abstract handling of predefined/static functions. - -forms(Fs0, Ps, Es0, Ds0) -> - PreDef = [{module_info,0},{module_info,1}], - forms(Fs0, Ps, Es0, Ds0, PreDef). - -forms(Fs0, Ps, Es0, Ds0, PreDef) -> - St0 = #pmod{parameters=Ps,exports=Es0,defined=Ds0, predef=PreDef}, - {Fs1, St1} = forms(Fs0, St0), - Es1 = update_function_names(Es0, St1), - Ds1 = update_function_names(Ds0, St1), - Fs2 = update_forms(Fs1, St1), - {Fs2,Es1,Ds1}. - -%% This is extremely simplistic for now; all functions get an extra -%% parameter, whether they need it or not, except for static functions. - -update_function_names(Es, St) -> - [update_function_name(E, St) || E <- Es]. - -update_function_name(E={F,A}, St) when F =/= new -> - case ordsets:is_element(E, St#pmod.predef) of - true -> E; - false -> {F, A + 1} - end; -update_function_name(E, _St) -> - E. - -update_forms([{function,L,N,A,Cs}|Fs],St) when N =/= new -> - [{function,L,N,A+1,Cs}|update_forms(Fs,St)]; -update_forms([F|Fs],St) -> - [F|update_forms(Fs,St)]; -update_forms([],_St) -> - []. - -%% Process the program forms. - -forms([F0|Fs0],St0) -> - {F1,St1} = form(F0,St0), - {Fs1,St2} = forms(Fs0,St1), - {[F1|Fs1],St2}; -forms([], St0) -> - {[], St0}. - -%% Only function definitions are of interest here. State is not updated. -form({function,Line,Name0,Arity0,Clauses0},St) when Name0 =/= new -> - {Name,Arity,Clauses} = function(Name0, Arity0, Clauses0, St), - {{function,Line,Name,Arity,Clauses},St}; -%% Pass anything else through -form(F,St) -> {F,St}. - -function(Name, Arity, Clauses0, St) -> - Clauses1 = clauses(Clauses0,St), - {Name,Arity,Clauses1}. - -clauses([C|Cs],St) -> - {clause,L,H,G,B} = clause(C,St), - T = {tuple,L,[{var,L,V} || V <- ['_'|St#pmod.parameters]]}, - [{clause,L,H++[{match,L,T,{var,L,'THIS'}}],G,B}|clauses(Cs,St)]; -clauses([],_St) -> []. - -clause({clause,Line,H0,G0,B0},St) -> - H1 = head(H0,St), - G1 = guard(G0,St), - B1 = exprs(B0,St), - {clause,Line,H1,G1,B1}. - -head(Ps,St) -> patterns(Ps,St). - -patterns([P0|Ps],St) -> - P1 = pattern(P0,St), - [P1|patterns(Ps,St)]; -patterns([],_St) -> []. - -string_to_conses([], _Line, Tail) -> - Tail; -string_to_conses([E|Rest], Line, Tail) -> - {cons, Line, {integer, Line, E}, string_to_conses(Rest, Line, Tail)}. - -pattern({var,_Line,_V}=Var,_St) -> Var; -pattern({match,Line,L0,R0},St) -> - L1 = pattern(L0,St), - R1 = pattern(R0,St), - {match,Line,L1,R1}; -pattern({integer,_Line,_I}=Integer,_St) -> Integer; -pattern({char,_Line,_C}=Char,_St) -> Char; -pattern({float,_Line,_F}=Float,_St) -> Float; -pattern({atom,_Line,_A}=Atom,_St) -> Atom; -pattern({string,_Line,_S}=String,_St) -> String; -pattern({nil,_Line}=Nil,_St) -> Nil; -pattern({cons,Line,H0,T0},St) -> - H1 = pattern(H0,St), - T1 = pattern(T0,St), - {cons,Line,H1,T1}; -pattern({tuple,Line,Ps0},St) -> - Ps1 = pattern_list(Ps0,St), - {tuple,Line,Ps1}; -pattern({bin,Line,Fs},St) -> - Fs2 = pattern_grp(Fs,St), - {bin,Line,Fs2}; -pattern({op,_Line,'++',{nil,_},R},St) -> - pattern(R,St); -pattern({op,_Line,'++',{cons,Li,{char,_C2,_I}=Char,T},R},St) -> - pattern({cons,Li,Char,{op,Li,'++',T,R}},St); -pattern({op,_Line,'++',{cons,Li,{integer,_L2,_I}=Integer,T},R},St) -> - pattern({cons,Li,Integer,{op,Li,'++',T,R}},St); -pattern({op,_Line,'++',{string,Li,L},R},St) -> - pattern(string_to_conses(L, Li, R),St); -pattern({op,_Line,_Op,_A}=Op4,_St) -> Op4; -pattern({op,_Line,_Op,_L,_R}=Op5,_St) -> Op5. - -pattern_grp([{bin_element,L1,E1,S1,T1} | Fs],St) -> - S2 = case S1 of - default -> - default; - _ -> - expr(S1,St) - end, - T2 = case T1 of - default -> - default; - _ -> - bit_types(T1) - end, - [{bin_element,L1,expr(E1,St),S2,T2} | pattern_grp(Fs,St)]; -pattern_grp([],_St) -> - []. - -bit_types([]) -> - []; -bit_types([Atom | Rest]) when is_atom(Atom) -> - [Atom | bit_types(Rest)]; -bit_types([{Atom, Integer} | Rest]) when is_atom(Atom), is_integer(Integer) -> - [{Atom, Integer} | bit_types(Rest)]. - -pattern_list([P0|Ps],St) -> - P1 = pattern(P0,St), - [P1|pattern_list(Ps,St)]; -pattern_list([],_St) -> []. - -guard([G0|Gs],St) when is_list(G0) -> - [guard0(G0,St) | guard(Gs,St)]; -guard(L,St) -> - guard0(L,St). - -guard0([G0|Gs],St) -> - G1 = guard_test(G0,St), - [G1|guard0(Gs,St)]; -guard0([],_St) -> []. - -guard_test(Expr={call,Line,{atom,La,F},As0},St) -> - case erl_internal:type_test(F, length(As0)) of - true -> - As1 = gexpr_list(As0,St), - {call,Line,{atom,La,F},As1}; - _ -> - gexpr(Expr,St) - end; -guard_test(Any,St) -> - gexpr(Any,St). - -gexpr({var,_L,_V}=Var,_St) -> Var; -% %% alternative implementation of accessing module parameters -% case index(V,St#pmod.parameters) of -% N when N > 0 -> -% {call,L,{remote,L,{atom,L,erlang},{atom,L,element}}, -% [{integer,L,N+1},{var,L,'THIS'}]}; -% _ -> -% Var -% end; -gexpr({integer,_Line,_I}=Integer,_St) -> Integer; -gexpr({char,_Line,_C}=Char,_St) -> Char; -gexpr({float,_Line,_F}=Float,_St) -> Float; -gexpr({atom,_Line,_A}=Atom,_St) -> Atom; -gexpr({string,_Line,_S}=String,_St) -> String; -gexpr({nil,_Line}=Nil,_St) -> Nil; -gexpr({cons,Line,H0,T0},St) -> - H1 = gexpr(H0,St), - T1 = gexpr(T0,St), - {cons,Line,H1,T1}; -gexpr({tuple,Line,Es0},St) -> - Es1 = gexpr_list(Es0,St), - {tuple,Line,Es1}; -gexpr({call,Line,{atom,_La,F}=Atom,As0},St) -> - true = erl_internal:guard_bif(F, length(As0)), - As1 = gexpr_list(As0,St), - {call,Line,Atom,As1}; -%% Pre-expansion generated calls to erlang:is_record/3 must also be handled -gexpr({call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,is_record}},[_,_,_]=As0},St) -> - As1 = gexpr_list(As0,St), - {call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,is_record}},As1}; -%% Guard BIFs can be remote, but only in the module erlang... -gexpr({call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,F}},As0},St) -> - A = length(As0), - true = - erl_internal:guard_bif(F, A) orelse erl_internal:arith_op(F, A) orelse - erl_internal:comp_op(F, A) orelse erl_internal:bool_op(F, A), - As1 = gexpr_list(As0,St), - {call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,F}},As1}; -%% Unfortunately, writing calls as {M,F}(...) is also allowed. -gexpr({call,Line,{tuple,La,[{atom,Lb,erlang},{atom,Lc,F}]},As0},St) -> - A = length(As0), - true = - erl_internal:guard_bif(F, A) orelse erl_internal:arith_op(F, A) orelse - erl_internal:comp_op(F, A) orelse erl_internal:bool_op(F, A), - As1 = gexpr_list(As0,St), - {call,Line,{tuple,La,[{atom,Lb,erlang},{atom,Lc,F}]},As1}; -gexpr({bin,Line,Fs},St) -> - Fs2 = pattern_grp(Fs,St), - {bin,Line,Fs2}; -gexpr({op,Line,Op,A0},St) -> - true = erl_internal:arith_op(Op, 1) orelse erl_internal:bool_op(Op, 1), - A1 = gexpr(A0,St), - {op,Line,Op,A1}; -gexpr({op,Line,Op,L0,R0},St) -> - true = - Op =:= 'andalso' orelse Op =:= 'orelse' orelse - erl_internal:arith_op(Op, 2) orelse - erl_internal:bool_op(Op, 2) orelse erl_internal:comp_op(Op, 2), - L1 = gexpr(L0,St), - R1 = gexpr(R0,St), - {op,Line,Op,L1,R1}. - -gexpr_list([E0|Es],St) -> - E1 = gexpr(E0,St), - [E1|gexpr_list(Es,St)]; -gexpr_list([],_St) -> []. - -exprs([E0|Es],St) -> - E1 = expr(E0,St), - [E1|exprs(Es,St)]; -exprs([],_St) -> []. - -expr({var,_L,_V}=Var,_St) -> - Var; -% case index(V,St#pmod.parameters) of -% N when N > 0 -> -% {call,L,{remote,L,{atom,L,erlang},{atom,L,element}}, -% [{integer,L,N+1},{var,L,'THIS'}]}; -% _ -> -% Var -% end; -expr({integer,_Line,_I}=Integer,_St) -> Integer; -expr({float,_Line,_F}=Float,_St) -> Float; -expr({atom,_Line,_A}=Atom,_St) -> Atom; -expr({string,_Line,_S}=String,_St) -> String; -expr({char,_Line,_C}=Char,_St) -> Char; -expr({nil,_Line}=Nil,_St) -> Nil; -expr({cons,Line,H0,T0},St) -> - H1 = expr(H0,St), - T1 = expr(T0,St), - {cons,Line,H1,T1}; -expr({lc,Line,E0,Qs0},St) -> - Qs1 = lc_bc_quals(Qs0,St), - E1 = expr(E0,St), - {lc,Line,E1,Qs1}; -expr({bc,Line,E0,Qs0},St) -> - Qs1 = lc_bc_quals(Qs0,St), - E1 = expr(E0,St), - {bc,Line,E1,Qs1}; -expr({tuple,Line,Es0},St) -> - Es1 = expr_list(Es0,St), - {tuple,Line,Es1}; -expr({block,Line,Es0},St) -> - Es1 = exprs(Es0,St), - {block,Line,Es1}; -expr({'if',Line,Cs0},St) -> - Cs1 = icr_clauses(Cs0,St), - {'if',Line,Cs1}; -expr({'case',Line,E0,Cs0},St) -> - E1 = expr(E0,St), - Cs1 = icr_clauses(Cs0,St), - {'case',Line,E1,Cs1}; -expr({'receive',Line,Cs0},St) -> - Cs1 = icr_clauses(Cs0,St), - {'receive',Line,Cs1}; -expr({'receive',Line,Cs0,To0,ToEs0},St) -> - To1 = expr(To0,St), - ToEs1 = exprs(ToEs0,St), - Cs1 = icr_clauses(Cs0,St), - {'receive',Line,Cs1,To1,ToEs1}; -expr({'try',Line,Es0,Scs0,Ccs0,As0},St) -> - Es1 = exprs(Es0,St), - Scs1 = icr_clauses(Scs0,St), - Ccs1 = icr_clauses(Ccs0,St), - As1 = exprs(As0,St), - {'try',Line,Es1,Scs1,Ccs1,As1}; -expr({'fun',_,{function,_,_,_}}=ExtFun,_St) -> - ExtFun; -expr({'fun',Line,Body,Info},St) -> - case Body of - {clauses,Cs0} -> - Cs1 = fun_clauses(Cs0,St), - {'fun',Line,{clauses,Cs1},Info}; - {function,F,A} = Function -> - {F1,A1} = update_function_name({F,A},St), - if A1 =:= A -> - {'fun',Line,Function,Info}; - true -> - %% Must rewrite local fun-name to a fun that does a - %% call with the extra THIS parameter. - As = make_vars(A, Line), - As1 = As ++ [{var,Line,'THIS'}], - Call = {call,Line,{atom,Line,F1},As1}, - Cs = [{clause,Line,As,[],[Call]}], - {'fun',Line,{clauses,Cs},Info} - end; - {function,_M,_F,_A} = Fun4 -> %This is an error in lint! - {'fun',Line,Fun4,Info} - end; -expr({call,Lc,{atom,_,instance}=Name,As0},St) -> - %% All local functions 'instance(...)' are static by definition, - %% so they do not take a 'THIS' argument when called - As1 = expr_list(As0,St), - {call,Lc,Name,As1}; -expr({call,Lc,{atom,_,new}=Name,As0},St) -> - %% All local functions 'new(...)' are static by definition, - %% so they do not take a 'THIS' argument when called - As1 = expr_list(As0,St), - {call,Lc,Name,As1}; -expr({call,Lc,{atom,_,module_info}=Name,As0},St) - when length(As0) =:= 0; length(As0) =:= 1 -> - %% The module_info/0 and module_info/1 functions are also static. - As1 = expr_list(As0,St), - {call,Lc,Name,As1}; -expr({call,Lc,{atom,_Lf,_F}=Atom,As0},St) -> - %% Local function call - needs THIS parameter. - As1 = expr_list(As0,St), - {call,Lc,Atom,As1 ++ [{var,0,'THIS'}]}; -expr({call,Line,F0,As0},St) -> - %% Other function call - F1 = expr(F0,St), - As1 = expr_list(As0,St), - {call,Line,F1,As1}; -expr({'catch',Line,E0},St) -> - E1 = expr(E0,St), - {'catch',Line,E1}; -expr({match,Line,P0,E0},St) -> - E1 = expr(E0,St), - P1 = pattern(P0,St), - {match,Line,P1,E1}; -expr({bin,Line,Fs},St) -> - Fs2 = pattern_grp(Fs,St), - {bin,Line,Fs2}; -expr({op,Line,Op,A0},St) -> - A1 = expr(A0,St), - {op,Line,Op,A1}; -expr({op,Line,Op,L0,R0},St) -> - L1 = expr(L0,St), - R1 = expr(R0,St), - {op,Line,Op,L1,R1}; -%% The following are not allowed to occur anywhere! -expr({remote,Line,M0,F0},St) -> - M1 = expr(M0,St), - F1 = expr(F0,St), - {remote,Line,M1,F1}. - -expr_list([E0|Es],St) -> - E1 = expr(E0,St), - [E1|expr_list(Es,St)]; -expr_list([],_St) -> []. - -icr_clauses([C0|Cs],St) -> - C1 = clause(C0,St), - [C1|icr_clauses(Cs,St)]; -icr_clauses([],_St) -> []. - -lc_bc_quals([{generate,Line,P0,E0}|Qs],St) -> - E1 = expr(E0,St), - P1 = pattern(P0,St), - [{generate,Line,P1,E1}|lc_bc_quals(Qs,St)]; -lc_bc_quals([{b_generate,Line,P0,E0}|Qs],St) -> - E1 = expr(E0,St), - P1 = pattern(P0,St), - [{b_generate,Line,P1,E1}|lc_bc_quals(Qs,St)]; -lc_bc_quals([E0|Qs],St) -> - E1 = expr(E0,St), - [E1|lc_bc_quals(Qs,St)]; -lc_bc_quals([],_St) -> []. - -fun_clauses([C0|Cs],St) -> - C1 = clause(C0,St), - [C1|fun_clauses(Cs,St)]; -fun_clauses([],_St) -> []. - -%% %% Return index from 1 upwards, or 0 if not in the list. -%% -%% index(X,Ys) -> index(X,Ys,1). -%% -%% index(X,[X|Ys],A) -> A; -%% index(X,[Y|Ys],A) -> index(X,Ys,A+1); -%% index(X,[],A) -> 0. - -make_vars(N, L) -> - make_vars(1, N, L). - -make_vars(N, M, L) when N =< M -> - V = list_to_atom("X"++integer_to_list(N)), - [{var,L,V} | make_vars(N + 1, M, L)]; -make_vars(_, _, _) -> - []. diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index e55fb2a037..7d918a55ed 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -28,17 +28,14 @@ %% Main entry point. -export([module/2]). --import(ordsets, [from_list/1,add_element/2,union/2]). +-import(ordsets, [from_list/1,union/2]). -import(lists, [member/2,foldl/3,foldr/3]). -include("../include/erl_bits.hrl"). -record(expand, {module=[], %Module name - parameters=undefined, %Module parameters - package="", %Module package exports=[], %Exports imports=[], %Imports - mod_imports, %Module Imports compile=[], %Compile flags attributes=[], %Attributes callbacks=[], %Callbacks @@ -67,12 +64,8 @@ module(Fs0, Opts0) -> %% Set pre-defined exported functions. PreExp = [{module_info,0},{module_info,1}], - %% Set pre-defined module imports. - PreModImp = [{erlang,erlang},{packages,packages}], - %% Build initial expand record. St0 = #expand{exports=PreExp, - mod_imports=dict:from_list(PreModImp), compile=Opts, defined=PreExp, bitdefault = erl_bits:system_bitdefault(), @@ -80,88 +73,20 @@ module(Fs0, Opts0) -> }, %% Expand the functions. {Tfs,St1} = forms(Fs, define_functions(Fs, St0)), - {Efs,St2} = expand_pmod(Tfs, St1), %% Get the correct list of exported functions. - Exports = case member(export_all, St2#expand.compile) of - true -> gb_sets:to_list(St2#expand.defined); - false -> St2#expand.exports + Exports = case member(export_all, St1#expand.compile) of + true -> gb_sets:to_list(St1#expand.defined); + false -> St1#expand.exports end, %% Generate all functions from stored info. - {Ats,St3} = module_attrs(St2#expand{exports = Exports}), + {Ats,St3} = module_attrs(St1#expand{exports = Exports}), {Mfs,St4} = module_predef_funcs(St3), - {St4#expand.module, St4#expand.exports, Ats ++ Efs ++ Mfs, + {St4#expand.module, St4#expand.exports, Ats ++ Tfs ++ Mfs, St4#expand.compile}. compiler_options(Forms) -> lists:flatten([C || {attribute,_,compile,C} <- Forms]). -expand_pmod(Fs0, St0) -> - case St0#expand.parameters of - undefined -> - {Fs0,St0}; - Ps0 -> - Base = get_base(St0#expand.attributes), - Ps = if is_atom(Base) -> - ['BASE' | Ps0]; - true -> - Ps0 - end, - Def = gb_sets:to_list(St0#expand.defined), - {Fs1,Xs,Ds} = sys_expand_pmod:forms(Fs0, Ps, - St0#expand.exports, - Def), - St1 = St0#expand{exports=Xs,defined=gb_sets:from_list(Ds)}, - {Fs2,St2} = add_instance(Ps, Fs1, St1), - {Fs3,St3} = ensure_new(Base, Ps0, Fs2, St2), - {Fs3,St3#expand{attributes = [{abstract, 0, [true]} - | St3#expand.attributes]}} - end. - -get_base(As) -> - case lists:keyfind(extends, 1, As) of - {extends,_,[Base]} when is_atom(Base) -> - Base; - _ -> - [] - end. - -ensure_new(Base, Ps, Fs, St) -> - case has_new(Fs) of - true -> - {Fs, St}; - false -> - add_new(Base, Ps, Fs, St) - end. - -has_new([{function,_L,new,_A,_Cs} | _Fs]) -> - true; -has_new([_ | Fs]) -> - has_new(Fs); -has_new([]) -> - false. - -add_new(Base, Ps, Fs, St) -> - Vs = [{var,0,V} || V <- Ps], - As = if is_atom(Base) -> - [{call,0,{remote,0,{atom,0,Base},{atom,0,new}},Vs} | Vs]; - true -> - Vs - end, - Body = [{call,0,{atom,0,instance},As}], - add_func(new, Vs, Body, Fs, St). - -add_instance(Ps, Fs, St) -> - Vs = [{var,0,V} || V <- Ps], - AbsMod = [{tuple,0,[{atom,0,St#expand.module}|Vs]}], - add_func(instance, Vs, AbsMod, Fs, St). - -add_func(Name, Args, Body, Fs, St) -> - A = length(Args), - F = {function,0,Name,A,[{clause,0,Args,[],Body}]}, - NA = {Name,A}, - {[F|Fs],St#expand{exports=add_element(NA, St#expand.exports), - defined=gb_sets:add_element(NA, St#expand.defined)}}. - %% define_function(Form, State) -> State. %% Add function to defined if form is a function. @@ -241,15 +166,9 @@ forms([], St) -> {[],St}. %% attribute(Attribute, Value, Line, State) -> State'. %% Process an attribute, this just affects the state. -attribute(module, {Module, As}, _L, St) -> - M = package_to_string(Module), - St#expand{module=list_to_atom(M), - package=packages:strip_last(M), - parameters=As}; attribute(module, Module, _L, St) -> - M = package_to_string(Module), - St#expand{module=list_to_atom(M), - package=packages:strip_last(M)}; + true = is_atom(Module), + St#expand{module=Module}; attribute(export, Es, _L, St) -> St#expand{exports=union(from_list(Es), St#expand.exports)}; attribute(import, Is, _L, St) -> @@ -312,8 +231,6 @@ pattern({tuple,Line,Ps}, St0) -> %%pattern({struct,Line,Tag,Ps}, St0) -> %% {TPs,TPsvs,St1} = pattern_list(Ps, St0), %% {{tuple,Line,[{atom,Line,Tag}|TPs]},TPsvs,St1}; -pattern({record_field,_,_,_}=M, St) -> - {expand_package(M, St),St}; % must be a package name pattern({bin,Line,Es0}, St0) -> {Es1,St1} = pattern_bin(Es0, St0), {{bin,Line,Es1},St1}; @@ -404,8 +321,6 @@ expr({tuple,Line,Es0}, St0) -> %%expr({struct,Line,Tag,Es0}, Vs, St0) -> %% {Es1,Esvs,Esus,St1} = expr_list(Es0, Vs, St0), %% {{tuple,Line,[{atom,Line,Tag}|Es1]},Esvs,Esus,St1}; -expr({record_field,_,_,_}=M, St) -> - {expand_package(M, St),St}; % must be a package name expr({bin,Line,Es0}, St0) -> {Es1,St1} = expr_bin(Es0, St0), {{bin,Line,Es1},St1}; @@ -448,12 +363,9 @@ expr({call,Line,{atom,La,N}=Atom,As0}, St0) -> end end end; -expr({call,Line,{record_field,_,_,_}=M,As0}, St0) -> - expr({call,Line,expand_package(M, St0),As0}, St0); -expr({call,Line,{remote,Lr,M,F},As0}, St0) -> - M1 = expand_package(M, St0), - {[M2,F1|As1],St1} = expr_list([M1,F|As0], St0), - {{call,Line,{remote,Lr,M2,F1},As1},St1}; +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}; @@ -666,32 +578,6 @@ string_to_conses(Line, Cs, Tail) -> foldr(fun (C, T) -> {cons,Line,{char,Line,C},T} end, Tail, Cs). -%% In syntax trees, module/package names are atoms or lists of atoms. - -package_to_string(A) when is_atom(A) -> atom_to_list(A); -package_to_string(L) when is_list(L) -> packages:concat(L). - -expand_package({atom,L,A} = M, St) -> - case dict:find(A, St#expand.mod_imports) of - {ok, A1} -> - {atom,L,A1}; - error -> - case packages:is_segmented(A) of - true -> - M; - false -> - M1 = packages:concat(St#expand.package, A), - {atom,L,list_to_atom(M1)} - end - end; -expand_package(M, _St) -> - case erl_parse:package_segments(M) of - error -> - M; - M1 -> - {atom,element(2,M),list_to_atom(package_to_string(M1))} - end. - %% import(Line, Imports, State) -> %% State' %% imported(Name, Arity, State) -> @@ -699,15 +585,10 @@ expand_package(M, _St) -> %% Handle import declarations and test for imported functions. No need to %% check when building imports as code is correct. -import({Mod0,Fs}, St) -> - Mod = list_to_atom(package_to_string(Mod0)), +import({Mod,Fs}, St) -> + true = is_atom(Mod), Mfs = from_list(Fs), - St#expand{imports=add_imports(Mod, Mfs, St#expand.imports)}; -import(Mod0, St) -> - Mod = package_to_string(Mod0), - Key = list_to_atom(packages:last(Mod)), - St#expand{mod_imports=dict:store(Key, list_to_atom(Mod), - St#expand.mod_imports)}. + St#expand{imports=add_imports(Mod, Mfs, St#expand.imports)}. add_imports(Mod, [F|Fs], Is) -> add_imports(Mod, Fs, orddict:store(F, Mod, Is)); |