1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1997-2020. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(erl_compile).
21
22-include("erl_compile.hrl").
23-include("file.hrl").
24
25-export([compile_cmdline/0, compile/2]).
26
27-export_type([cmd_line_arg/0]).
28
29%% Mapping from extension to {M,F} to run the correct compiler.
30
31compiler(".erl") ->    {compile,         compile};
32compiler(".S") ->      {compile,         compile_asm};
33compiler(".abstr") ->  {compile,         compile_abstr};
34compiler(".core") ->   {compile,         compile_core};
35compiler(".mib") ->    {snmpc,           compile};
36compiler(".bin") ->    {snmpc,           mib_to_hrl};
37compiler(".xrl") ->    {leex,            compile};
38compiler(".yrl") ->    {yecc,            compile};
39compiler(".script") -> {systools,        script2boot};
40compiler(".rel") ->    {systools,        compile_rel};
41compiler(".idl") ->    {ic,              compile};
42compiler(".asn1") ->   {asn1ct,          compile_asn1};
43compiler(".asn") ->    {asn1ct,          compile_asn};
44compiler(".py") ->     {asn1ct,          compile_py};
45compiler(_) ->         no.
46
47-type cmd_line_arg() :: atom() | string().
48
49%% Run a compilation based on the command line arguments and then halt.
50%% Intended for one-off compilation by erlc.
51-spec compile_cmdline() -> no_return().
52compile_cmdline() ->
53    cmdline_init(),
54    List = init:get_plain_arguments(),
55    compile_cmdline1(List).
56
57%% Run a compilation. Meant to be used by the compilation server.
58-spec compile(list(), file:filename()) -> 'ok' | {'error', binary()}.
59compile(Args, Cwd) ->
60    try compile1(Args, #options{outdir=Cwd,cwd=Cwd}) of
61        ok ->
62            ok
63    catch
64        throw:{error, Output} ->
65            {error, unicode:characters_to_binary(Output)};
66        C:E:Stk ->
67            {crash, {C,E,Stk}}
68    end.
69
70%% Run the the compiler in a separate process.
71compile_cmdline1(Args) ->
72    {ok, Cwd} = file:get_cwd(),
73    {Pid,Ref} = spawn_monitor(fun() -> exit(compile(Args, Cwd)) end),
74    receive
75        {'DOWN', Ref, process, Pid, Result} ->
76            case Result of
77                ok ->
78                    halt(0);
79                {error, Output} ->
80                    io:put_chars(standard_error, Output),
81                    halt(1);
82                {crash, {C,E,Stk}} ->
83                    io:format(standard_error, "Crash: ~p:~tp\n~tp\n",
84                              [C,E,Stk]),
85                    halt(2)
86            end
87    end.
88
89cmdline_init() ->
90    %% We don't want the current directory in the code path.
91    %% Remove it.
92    Path = [D || D <- code:get_path(), D =/= "."],
93    true = code:set_path(Path),
94    ok.
95
96%% Parse all options.
97compile1(["--"|Files], Opts) ->
98    compile2(Files, Opts);
99compile1(["-"++Option|T], Opts) ->
100    parse_generic_option(Option, T, Opts);
101compile1(["+"++Option|Rest], Opts) ->
102    Term = make_term(Option),
103    Specific = Opts#options.specific,
104    compile1(Rest, Opts#options{specific=[Term|Specific]});
105compile1(Files, Opts) ->
106    compile2(Files, Opts).
107
108parse_generic_option("b"++Opt, T0, Opts) ->
109    {OutputType,T} = get_option("b", Opt, T0),
110    compile1(T, Opts#options{output_type=list_to_atom(OutputType)});
111parse_generic_option("D"++Opt, T0, #options{defines=Defs}=Opts) ->
112    {Val0,T} = get_option("D", Opt, T0),
113    {Key0,Val1} = split_at_equals(Val0, []),
114    Key = list_to_atom(Key0),
115    case Val1 of
116	[] ->
117	    compile1(T, Opts#options{defines=[Key|Defs]});
118	Val2 ->
119	    Val = make_term(Val2),
120	    compile1(T, Opts#options{defines=[{Key,Val}|Defs]})
121    end;
122parse_generic_option("help", _, _Opts) ->
123    usage();
124parse_generic_option("I"++Opt, T0, #options{cwd=Cwd}=Opts) ->
125    {Dir,T} = get_option("I", Opt, T0),
126    AbsDir = filename:absname(Dir, Cwd),
127    compile1(T, Opts#options{includes=[AbsDir|Opts#options.includes]});
128parse_generic_option("M"++Opt, T0, #options{specific=Spec}=Opts) ->
129    {SpecOpts,T} = parse_dep_option(Opt, T0),
130    compile1(T, Opts#options{specific=SpecOpts++Spec});
131parse_generic_option("o"++Opt, T0, #options{cwd=Cwd}=Opts) ->
132    {Dir,T} = get_option("o", Opt, T0),
133    AbsName = filename:absname(Dir, Cwd),
134    case file_or_directory(AbsName) of
135	file ->
136	    compile1(T, Opts#options{outfile=AbsName});
137	directory ->
138	    compile1(T, Opts#options{outdir=AbsName})
139    end;
140parse_generic_option("O"++Opt, T, Opts) ->
141    case Opt of
142	"" ->
143	    compile1(T, Opts#options{optimize=1});
144	_ ->
145	    Term = make_term(Opt),
146	    compile1(T, Opts#options{optimize=Term})
147    end;
148parse_generic_option("v", T, Opts) ->
149    compile1(T, Opts#options{verbose=true});
150parse_generic_option("W"++Warn, T, #options{specific=Spec}=Opts) ->
151    case Warn of
152	"all" ->
153	    compile1(T, Opts#options{warning=999});
154	"error" ->
155	    compile1(T, Opts#options{specific=[warnings_as_errors|Spec]});
156	"" ->
157	    compile1(T, Opts#options{warning=1});
158	_ ->
159	    try	list_to_integer(Warn) of
160		Level ->
161		    compile1(T, Opts#options{warning=Level})
162	    catch
163		error:badarg ->
164		    usage()
165	    end
166    end;
167parse_generic_option("E", T, #options{specific=Spec}=Opts) ->
168    compile1(T, Opts#options{specific=['E'|Spec]});
169parse_generic_option("P", T, #options{specific=Spec}=Opts) ->
170    compile1(T, Opts#options{specific=['P'|Spec]});
171parse_generic_option("S", T, #options{specific=Spec}=Opts) ->
172    compile1(T, Opts#options{specific=['S'|Spec]});
173parse_generic_option(Option, _T, _Opts) ->
174    usage(io_lib:format("Unknown option: -~ts\n", [Option])).
175
176parse_dep_option("", T) ->
177    {[makedep,{makedep_output,standard_io}],T};
178parse_dep_option("D", T) ->
179    {[makedep],T};
180parse_dep_option("MD", T) ->
181    {[makedep_side_effect],T};
182parse_dep_option("F"++Opt, T0) ->
183    {File,T} = get_option("MF", Opt, T0),
184    {[makedep,{makedep_output,File}],T};
185parse_dep_option("G", T) ->
186    {[makedep_add_missing],T};
187parse_dep_option("P", T) ->
188    {[makedep_phony],T};
189parse_dep_option("Q"++Opt, T0) ->
190    {Target,T} = get_option("MT", Opt, T0),
191    {[makedep_quote_target,{makedep_target,Target}],T};
192parse_dep_option("T"++Opt, T0) ->
193    {Target,T} = get_option("MT", Opt, T0),
194    {[{makedep_target,Target}],T};
195parse_dep_option(Opt, _T) ->
196    usage(io_lib:format("Unknown option: -M~ts\n", [Opt])).
197
198-spec usage() -> no_return().
199
200usage() ->
201    usage("").
202
203usage(Error) ->
204    H = [{"-b type","type of output file (e.g. beam)"},
205	 {"-d","turn on debugging of erlc itself"},
206	 {"-Dname","define name"},
207	 {"-Dname=value","define name to have value"},
208	 {"-help","shows this help text"},
209	 {"-I path","where to search for include files"},
210	 {"-M","generate a rule for make(1) describing the dependencies"},
211	 {"-MF file","write the dependencies to 'file'"},
212	 {"-MT target","change the target of the rule emitted by dependency "
213	  "generation"},
214	 {"-MQ target","same as -MT but quote characters special to make(1)"},
215	 {"-MG","consider missing headers as generated files and add them to "
216	  "the dependencies"},
217	 {"-MP","add a phony target for each dependency"},
218	 {"-MD","same as -M -MT file (with default 'file')"},
219	 {"-MMD","generate dependencies as a side-effect"},
220	 {"-o name","name output directory or file"},
221	 {"-pa path","add path to the front of Erlang's code path"},
222	 {"-pz path","add path to the end of Erlang's code path"},
223	 {"-v","verbose compiler output"},
224	 {"-Werror","make all warnings into errors"},
225	 {"-W0","disable warnings"},
226	 {"-Wnumber","set warning level to number"},
227	 {"-Wall","enable all warnings"},
228	 {"-W","enable warnings (default; same as -W1)"},
229	 {"-E","generate listing of expanded code (Erlang compiler)"},
230	 {"-S","generate assembly listing (Erlang compiler)"},
231	 {"-P","generate listing of preprocessed code (Erlang compiler)"},
232	 {"+term","pass the Erlang term unchanged to the compiler"}],
233    Msg = [Error,
234           "Usage: erlc [Options] file.ext ...\n",
235           "Options:\n",
236           [io_lib:format("~-14s ~s\n", [K,D]) || {K,D} <- H]],
237    throw({error, Msg}).
238
239get_option(_Name, [], [[C|_]=Option|T]) when C =/= $- ->
240    {Option,T};
241get_option(_Name, [_|_]=Option, T) ->
242    {Option,T};
243get_option(Name, _, _) ->
244    throw({error, "No value given to -"++Name++" option\n"}).
245
246split_at_equals([$=|T], Acc) ->
247    {lists:reverse(Acc),T};
248split_at_equals([H|T], Acc) ->
249    split_at_equals(T, [H|Acc]);
250split_at_equals([], Acc) ->
251    {lists:reverse(Acc),[]}.
252
253compile2(Files, #options{cwd=Cwd,includes=Incl,outfile=Outfile}=Opts0) ->
254    Opts = Opts0#options{includes=lists:reverse(Incl)},
255    case {Outfile,length(Files)} of
256	{"", _} ->
257	    compile3(Files, Cwd, Opts);
258	{[_|_], 1} ->
259	    compile3(Files, Cwd, Opts);
260	{[_|_], _N} ->
261            throw({error, "Output file name given, but more than one input file.\n"})
262    end.
263
264%% Compile the list of files, until done or compilation fails.
265compile3([File|Rest], Cwd, Options) ->
266    Ext = filename:extension(File),
267    Root = filename:rootname(File),
268    InFile = filename:absname(Root, Cwd),
269    OutFile =
270	case Options#options.outfile of
271	    "" ->
272		filename:join(Options#options.outdir, filename:basename(Root));
273	    Outfile ->
274		filename:rootname(Outfile)
275	end,
276    compile_file(Ext, InFile, OutFile, Options),
277    compile3(Rest, Cwd, Options);
278compile3([], _Cwd, _Options) -> ok.
279
280%% Invoke the appropriate compiler, depending on the file extension.
281compile_file("", Input, _Output, _Options) ->
282    throw({error, io_lib:format("File has no extension: ~ts~n", [Input])});
283compile_file(Ext, Input, Output, Options) ->
284    case compiler(Ext) of
285	no ->
286	    Error = io_lib:format("Unknown extension: '~ts'\n", [Ext]),
287            throw({error, Error});
288	{M, F} ->
289	    try M:F(Input, Output, Options) of
290		ok ->
291                    ok;
292		error ->
293                    throw({error, ""});
294		Other ->
295                    Error = io_lib:format("Compiler function ~w:~w/3 returned:\n~tp~n",
296                                          [M,F,Other]),
297		    throw({error, Error})
298            catch
299		throw:Reason:Stk ->
300		    Error = io_lib:format("Compiler function ~w:~w/3 failed:\n~tp\n~tp\n",
301                                          [M,F,Reason,Stk]),
302		    throw({error, Error})
303	    end
304    end.
305
306%% Guess whether a given name refers to a file or a directory.
307file_or_directory(Name) ->
308    case file:read_file_info(Name) of
309	{ok, #file_info{type=regular}} ->
310	    file;
311	{ok, _} ->
312	    directory;
313	{error, _} ->
314	    case filename:extension(Name) of
315		[] -> directory;
316		_Other -> file
317	    end
318    end.
319
320%% Make an Erlang term given a string.
321make_term(Str) ->
322    case erl_scan:string(Str) of
323	{ok, Tokens, _} ->
324	    case erl_parse:parse_term(Tokens ++ [{dot, erl_anno:new(1)}]) of
325		{ok, Term} ->
326                    Term;
327		{error, {_,_,Reason}} ->
328		    throw({error, io_lib:format("~ts: ~ts~n", [Reason, Str])})
329	    end;
330	{error, {_,_,Reason}, _} ->
331	    throw({error, io_lib:format("~ts: ~ts~n", [Reason, Str])})
332    end.
333