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