path: root/lib/stdlib/src/escript.erl

%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2007-2013. 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(escript).

%% Useful functions that can be called from scripts.
-export([script_name/0, create/2, extract/2]).

%% Internal API.
-export([start/0, start/1, parse_file/1]).

%%-----------------------------------------------------------------------

-define(SHEBANG,  "/usr/bin/env escript").
-define(COMMENT,  "This is an -*- erlang -*- file").

%%-----------------------------------------------------------------------

-type mode()   :: 'native' | 'compile' | 'debug' | 'interpret' | 'run'.
-type source() :: 'archive' | 'beam' | 'text'.

-record(state, {file         :: file:filename(),
                module       :: module(),
                forms_or_bin,
                source       :: source(),
                n_errors     :: non_neg_integer(),
                mode         :: mode(),
                exports_main :: boolean(),
                has_records  :: boolean()}).

-type shebang() :: string().
-type comment() :: string().
-type emu_args() :: string().

-record(sections, {type,
		   shebang  :: shebang(),
		   comment  :: comment(),
		   emu_args :: emu_args(),
		   body}).

-record(extract_options, {compile_source}).

-type zip_file() ::
	  file:filename()
	| {file:filename(), binary()}
	| {file:filename(), binary(), file:file_info()}.
-type section() ::
	  shebang
	| {shebang, shebang() | default | undefined}
	| comment
	| {comment, comment() | default | undefined}
	| {emu_args, emu_args() | undefined}
	| {source, file:filename() | binary()}
	| {beam, file:filename() | binary()}
	| {archive, zip:filename() | binary()}
	| {archive, [zip_file()], [zip:create_option()]}.

%%-----------------------------------------------------------------------

%% Create a complete escript file with both header and body
-spec create(file:filename() | binary, [section()]) ->
		    ok | {ok, binary()} | {error, term()}.

create(File, Options) when is_list(Options) ->
    try
	S = prepare(Options, #sections{}),
	BinList =
	    [Section || Section <- [S#sections.shebang,
				    S#sections.comment,
				    S#sections.emu_args,
				    S#sections.body],
			Section =/= undefined],
	case File of
	    binary ->
		{ok, list_to_binary(BinList)};
	    _ ->
		case file:write_file(File, BinList) of
		    ok ->
			ok;
		    {error, Reason} ->
			{error, {Reason, File}}
		end
	end
    catch
	throw:PrepareReason ->
	    {error, PrepareReason}
    end.

prepare([H | T], S) ->
    case H of
	{shebang, undefined} ->
	    prepare(T, S);
	shebang ->
	    prepare(T, S#sections{shebang = "#!" ++ ?SHEBANG ++ "\n"});
	{shebang, default} ->
	    prepare(T, S#sections{shebang = "#!" ++ ?SHEBANG ++ "\n"});
	{shebang, Shebang} when is_list(Shebang) ->
	    prepare(T, S#sections{shebang = "#!" ++ Shebang ++ "\n"});
	{comment, undefined} ->
	    prepare(T, S);
	comment ->
	    prepare(T, S#sections{comment = "%% " ++ ?COMMENT ++ "\n"});
	{comment, default} ->
	    prepare(T, S#sections{comment = "%% " ++ ?COMMENT ++ "\n"});
	{comment, Comment} when is_list(Comment) ->
	    prepare(T, S#sections{comment = "%% " ++ Comment ++ "\n"});
	{emu_args, undefined} ->
	    prepare(T, S);
	{emu_args, Args} when is_list(Args) ->
	    prepare(T, S#sections{emu_args = "%%!" ++ Args ++ "\n"});
	{Type, File} when is_list(File) ->
	    case file:read_file(File) of
		{ok, Bin} ->
		    prepare(T, S#sections{type = Type, body = Bin});
		{error, Reason} ->
		    throw({Reason, H})
	    end;
	{Type, Bin} when is_binary(Bin) ->
	    prepare(T, S#sections{type = Type, body = Bin});
	{archive = Type, ZipFiles, ZipOptions}
	  when is_list(ZipFiles), is_list(ZipOptions) ->
	    File = "dummy.zip",
	    case zip:create(File, ZipFiles, ZipOptions ++ [memory]) of
		{ok, {File, ZipBin}} ->
		    prepare(T, S#sections{type = Type, body = ZipBin});
		{error, Reason} ->
		    throw({Reason, H})
	    end;
	_ ->
	    throw({badarg, H})
    end;
prepare([], #sections{body = undefined}) ->
    throw(missing_body);
prepare([], #sections{type = Type} = S)
  when Type =:= source; Type =:= beam; Type =:= archive ->
    S;
prepare([], #sections{type = Type}) ->
    throw({illegal_type, Type});
prepare(BadOptions, _) ->
    throw({badarg, BadOptions}).

-type section_name() :: shebang | comment | emu_args | body .
-type extract_option() :: compile_source | {section, [section_name()]}.
-spec extract(file:filename(), [extract_option()]) ->
        {ok, [section()]} | {error, term()}.

extract(File, Options) when is_list(File), is_list(Options) ->
    try
	EO = parse_extract_options(Options,
				   #extract_options{compile_source = false}),
	{HeaderSz, NextLineNo, Fd, Sections} =
	    parse_header(File, not EO#extract_options.compile_source),
	Type = Sections#sections.type,
	case {Type, EO#extract_options.compile_source} of
	    {source, true} ->
		Bin = compile_source(Type, File, Fd, NextLineNo, HeaderSz);
	    {_, _} ->
		ok = file:close(Fd),
		case file:read_file(File) of
		    {ok, <<_Header:HeaderSz/binary, Bin/binary>>} ->
			ok;
		    {error, ReadReason} ->
			Bin = get_rid_of_compiler_warning,
			throw(ReadReason)
		end
	end,
	return_sections(Sections, Bin)
    catch
	throw:Reason ->
	    {error, Reason}
    end.

parse_extract_options([H | T], EO) ->
    case H of
	compile_source ->
	    EO2 = EO#extract_options{compile_source = true},
	    parse_extract_options(T, EO2);
	_ ->
	    throw({badarg, H})
    end;
parse_extract_options([], EO) ->
    EO.

compile_source(Type, File, Fd, NextLineNo, HeaderSz) ->
    {text, _Module, Forms, _HasRecs, _Mode} =
	do_parse_file(Type, File, Fd, NextLineNo, HeaderSz, false),
    ok = file:close(Fd),
    case compile:forms(Forms, [return_errors, debug_info]) of
	{ok, _, BeamBin} ->
	    BeamBin;
	{error, Errors, Warnings} ->
	    throw({compile, [{errors, format_errors(Errors)},
			     {warnings, format_errors(Warnings)}]})
    end.

format_errors(CompileErrors) ->
    [lists:flatten([File, ":", integer_to_list(LineNo), ": ",
		    Mod:format_error(Error)]) ||
	{File, FileErrors} <- CompileErrors,
	{LineNo, Mod, Error} <- FileErrors].

return_sections(S, Bin) ->
    {ok, [normalize_section(shebang,  S#sections.shebang),
	  normalize_section(comment,  S#sections.comment),
	  normalize_section(emu_args, S#sections.emu_args),
	  normalize_section(S#sections.type, Bin)]}.

normalize_section(Name, undefined) ->
    {Name, undefined};
normalize_section(shebang, "#!" ++ Chars) ->
    Chopped = string:strip(Chars, right, $\n),
    Stripped = string:strip(Chopped, both),
    if
	Stripped =:= ?SHEBANG ->
	    {shebang, default};
	true ->
	    {shebang, Stripped}
    end;
normalize_section(comment, Chars) ->
    Chopped = string:strip(Chars, right, $\n),
    Stripped = string:strip(string:strip(Chopped, left, $%), both),
    if
	Stripped =:= ?COMMENT ->
	    {comment, default};
	true ->
	    {comment, Stripped}
    end;
normalize_section(emu_args, "%%!" ++ Chars) ->
    Chopped = string:strip(Chars, right, $\n),
    Stripped = string:strip(Chopped, both),
    {emu_args, Stripped};
normalize_section(Name, Chars) ->
    {Name, Chars}.

-spec script_name() -> string().

script_name() ->
    [ScriptName|_] = init:get_plain_arguments(),
    ScriptName.

%%
%% Internal API.
%%

-spec start() -> no_return().

start() ->
    start([]).

-spec start([string()]) -> no_return().

start(EscriptOptions) ->
    try
        %% Commands run using -run or -s are run in a process
        %% trap_exit set to false. Because this behaviour is
        %% surprising for users of escript, make sure to reset
        %% trap_exit to false.
        process_flag(trap_exit, false),
        case init:get_plain_arguments() of
            [File|Args] ->
                parse_and_run(File, Args, EscriptOptions);
            [] ->
                io:format("escript: Missing filename\n", []),
                my_halt(127)
        end
    catch
        throw:Str ->
            io:format("escript: ~s\n", [Str]),
            my_halt(127);
        _:Reason ->
            io:format("escript: Internal error: ~p\n", [Reason]),
            io:format("~p\n", [erlang:get_stacktrace()]),
            my_halt(127)
    end.

parse_and_run(File, Args, Options) ->
    CheckOnly = lists:member("s", Options),
    {Source, Module, FormsOrBin, HasRecs, Mode} =
	parse_file(File, CheckOnly),
    Mode2 =
        case lists:member("d", Options) of
            true  ->
		debug;
            false ->
		case lists:member("c", Options) of
		    true  ->
			compile;
		    false ->
			case lists:member("i", Options) of
			    true  -> interpret;
			    false -> 
				case lists:member("n", Options) of
				    true -> native;
				    false -> Mode
				end
			end
		end
        end,
    if
        is_list(FormsOrBin) ->
            case Mode2 of
                interpret ->
                    interpret(FormsOrBin, HasRecs, File, Args);
                compile ->
                    case compile:forms(FormsOrBin, [report]) of
                        {ok, Module, BeamBin} ->
                            {module, Module} = code:load_binary(Module, File, BeamBin),
                            run(Module, Args);
                        _Other ->
                            fatal("There were compilation errors.")
                    end;
		native ->
                    case compile:forms(FormsOrBin, [report,native]) of
                        {ok, Module, BeamBin} ->
                            {module, Module} = code:load_binary(Module, File, BeamBin),
                            run(Module, Args);
                        _Other ->
                            fatal("There were compilation errors.")
                    end;
                debug ->
                    case compile:forms(FormsOrBin, [report, debug_info]) of
                        {ok,Module,BeamBin} ->
                            {module, Module} = code:load_binary(Module, File, BeamBin),
                            debug(Module, {Module, File, File, BeamBin}, Args);
                        _Other ->
                            fatal("There were compilation errors.")
                    end
            end;
        is_binary(FormsOrBin) ->
            case Source of
                archive ->
		    {ok, FileInfo} = file:read_file_info(File),
                    case code:set_primary_archive(File, FormsOrBin, FileInfo,
						  fun escript:parse_file/1) of
                        ok when CheckOnly ->
			    case code:load_file(Module) of
				{module, _} ->
				    case erlang:function_exported(Module, main, 1) of
					true ->
					    my_halt(0);
					false ->
					    Text = lists:concat(["Function ", Module,
								 ":main/1 is not exported"]),
					    fatal(Text)
				    end;
				_ ->
				    Text = lists:concat(["Cannot load module ", Module,
							 " from archive"]),
				    fatal(Text)
			    end;
			ok ->
                            case Mode2 of
                                run   -> run(Module, Args);
                                debug -> debug(Module, Module, Args)
                            end;
                        {error, bad_eocd} ->
                            fatal("Not an archive file");
                        {error, Reason} ->
                            fatal(Reason)
                    end;
                beam ->
                    case Mode2 of
                        run ->
                            {module, Module} = code:load_binary(Module, File, FormsOrBin),
                            run(Module, Args);
                        debug ->
			    [Base | Rest] = lists:reverse(filename:split(File)),
			    Base2 = filename:basename(Base, code:objfile_extension()),
			    Rest2 =
				case Rest of
				    ["ebin" | Top] -> ["src" | Top];
				    _ -> Rest
				end,
			    SrcFile = filename:join(lists:reverse([Base2 ++ ".erl" | Rest2])),
			    debug(Module, {Module, SrcFile, File, FormsOrBin}, Args)
                    end
            end
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Parse script
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% Only used as callback by erl_prim_loader
parse_file(File) ->
    try parse_file(File, false) of
	{_Source, _Module, FormsOrBin, _HasRecs, _Mode}
	  when is_binary(FormsOrBin) ->
	    {ok, FormsOrBin};
	_ ->
	    {error, no_archive_bin}
    catch
	throw:Reason ->
	    {error, Reason}
    end.

parse_file(File, CheckOnly) ->
    {HeaderSz, NextLineNo, Fd, Sections} =
	parse_header(File, false),
    do_parse_file(Sections#sections.type,
		  File, Fd, NextLineNo, HeaderSz, CheckOnly).

do_parse_file(Type, File, Fd, NextLineNo, HeaderSz, CheckOnly) ->
    S = initial_state(File),
    #state{mode = Mode,
	   source = Source,
	   module = Module,
	   forms_or_bin = FormsOrBin,
	   has_records = HasRecs} =
	case Type of
	    archive ->
		%% Archive file
		ok = file:close(Fd),
		parse_archive(S, File, HeaderSz);
	    beam ->
		%% Beam file
		ok = file:close(Fd),
		parse_beam(S, File, HeaderSz, CheckOnly);
	    source ->
		%% Source code
		parse_source(S, File, Fd, NextLineNo, HeaderSz, CheckOnly)
        end,
    {Source, Module, FormsOrBin, HasRecs, Mode}.

initial_state(File) ->
    #state{file = File,
	   n_errors = 0,
	   mode = interpret,
	   exports_main = false,
	   has_records = false}.

%% Skip header and make a heuristic guess about the script type
parse_header(File, KeepFirst) ->
    LineNo = 1,
    {ok, Fd} =
        case file:open(File, [read]) of
            {ok, Fd0} ->
                {ok, Fd0};
            {error, R} ->
                fatal(lists:concat([file:format_error(R), ": '", File, "'"]))
        end,

    %% Skip shebang on first line
    {ok, HeaderSz0} = file:position(Fd, cur),
    Line1 = get_line(Fd),
    case classify_line(Line1) of
        shebang ->
            find_first_body_line(Fd, HeaderSz0, LineNo, KeepFirst,
				 #sections{shebang = Line1});
	archive ->
	    {HeaderSz0, LineNo, Fd,
	     #sections{type = archive}};
	beam ->
            {HeaderSz0, LineNo, Fd,
	     #sections{type = beam}};
	_ ->
            find_first_body_line(Fd, HeaderSz0, LineNo, KeepFirst,
				 #sections{})
    end.

find_first_body_line(Fd, HeaderSz0, LineNo, KeepFirst, Sections) ->
    {ok, HeaderSz1} = file:position(Fd, cur),
    %% Look for special comment on second line
    Line2 = get_line(Fd),
    {ok, HeaderSz2} = file:position(Fd, cur),
    case classify_line(Line2) of
	emu_args ->
	    %% Skip special comment on second line
	    Line3 = get_line(Fd),
	    {HeaderSz2, LineNo + 2, Fd,
	     Sections#sections{type = guess_type(Line3),
			       comment = undefined,
			       emu_args = Line2}};
	Line2Type ->
	    %% Look for special comment on third line
	    Line3 = get_line(Fd),
	    {ok, HeaderSz3} = file:position(Fd, cur),
	    Line3Type = classify_line(Line3),
	    if
		Line3Type =:= emu_args ->
		    %% Skip special comment on third line
		    Line4 = get_line(Fd),
		    {HeaderSz3, LineNo + 3, Fd,
		     Sections#sections{type = guess_type(Line4),
				       comment = Line2,
				       emu_args = Line3}};
		Sections#sections.shebang =:= undefined,
		KeepFirst =:= true ->
		    %% No shebang. Use the entire file
		    {HeaderSz0, LineNo, Fd,
		     Sections#sections{type = guess_type(Line2)}};
		Sections#sections.shebang =:= undefined ->
		    %% No shebang. Skip the first line
		    {HeaderSz1, LineNo, Fd,
		     Sections#sections{type = guess_type(Line2)}};
		Line2Type =:= comment ->
		    %% Skip shebang on first line and comment on second
		    {HeaderSz2, LineNo + 2, Fd,
		     Sections#sections{type = guess_type(Line3),
				       comment = Line2}};
		true ->
		    %% Just skip shebang on first line
		    {HeaderSz1, LineNo + 1, Fd,
		     Sections#sections{type = guess_type(Line2)}}
	    end
    end.

classify_line(Line) ->
    case Line of
        "#!" ++ _ -> shebang;
        "PK" ++ _ -> archive;
        "FOR1" ++ _ -> beam;
        "%%!" ++ _ -> emu_args;
        "%" ++ _ -> comment;
        _ -> undefined
   end.

guess_type(Line) ->
    case classify_line(Line) of
	archive -> archive;
	beam    -> beam;
	_       -> source
    end.

get_line(P) ->
    case io:get_line(P, '') of
        eof ->
            fatal("Premature end of file reached");
        Line ->
            Line
    end.

parse_archive(S, File, HeaderSz) ->
    case file:read_file(File) of
	{ok, <<_Header:HeaderSz/binary, Bin/binary>>} ->
	    Mod =
		case init:get_argument(escript) of
		    {ok, [["main", M]]} ->
			%% Use explicit module name
			list_to_atom(M);
		    _ ->
			%% Use escript name without extension as module name
			RevBase = lists:reverse(filename:basename(File)),
			RevBase2 =
			    case lists:dropwhile(fun(X) -> X =/= $. end, RevBase) of
                                [$. | Rest] -> Rest;
                                [] -> RevBase
                            end,
                        list_to_atom(lists:reverse(RevBase2))
		end,
	    S#state{source = archive,
		    mode = run,
		    module = Mod,
		    forms_or_bin = Bin};
	{ok, _} ->
	    fatal("Illegal archive format");
	{error, Reason} ->
	    fatal(file:format_error(Reason))
    end.


parse_beam(S, File, HeaderSz, CheckOnly) ->
    {ok, <<_Header:HeaderSz/binary, Bin/binary>>} =
        file:read_file(File),
    case beam_lib:chunks(Bin, [exports]) of
	{ok, {Module, [{exports, Exports}]}} ->
	    case CheckOnly of
		true ->
		    case lists:member({main, 1}, Exports) of
			true ->
			    my_halt(0);
			false ->
			    Text = lists:concat(["Function ", Module, ":main/1 is not exported"]),
			    fatal(Text)
		    end;
		false ->
		    S#state{source = beam,
			    mode = run,
			    module = Module,
			    forms_or_bin = Bin}
	    end;
	{error, beam_lib, Reason} when is_tuple(Reason) ->
            fatal(element(1, Reason))
    end.

parse_source(S, File, Fd, StartLine, HeaderSz, CheckOnly) ->
    {PreDefMacros, Module} = pre_def_macros(File),
    IncludePath = [],
    %% Read the encoding on the second line, if there is any:
    {ok, _} = file:position(Fd, 0),
    _ = io:get_line(Fd, ''),
    Encoding = epp:set_encoding(Fd),
    {ok, _} = file:position(Fd, HeaderSz),
    case epp:open(File, Fd, StartLine, IncludePath, PreDefMacros) of
        {ok, Epp} ->
            _ = [io:setopts(Fd, [{encoding,Encoding}]) ||
                    Encoding =/= none],
            {ok, FileForm} = epp:parse_erl_form(Epp),
            OptModRes = epp:parse_erl_form(Epp),
            S2 = S#state{source = text, module = Module},
            S3 =
                case OptModRes of
                    {ok, {attribute,_, module, M} = Form} ->
                        epp_parse_file(Epp, S2#state{module = M}, [Form, FileForm]);
                    {ok, _} ->
                        ModForm = {attribute,1,module, Module},
                        epp_parse_file2(Epp, S2, [ModForm, FileForm], OptModRes);
                    {error, _} ->
                        epp_parse_file2(Epp, S2, [FileForm], OptModRes);
                    {eof, _LastLine} = Eof ->
                        S#state{forms_or_bin = [FileForm, Eof]}
                end,
            ok = epp:close(Epp),
            ok = file:close(Fd),
	    check_source(S3, CheckOnly);
	{error, Reason} ->
	    io:format("escript: ~tp\n", [Reason]),
	    fatal("Preprocessor error")
    end.

check_source(S, CheckOnly) ->
    case S of
	#state{n_errors = Nerrs} when Nerrs =/= 0 ->
	    fatal("There were compilation errors.");
	#state{exports_main = ExpMain,
	       forms_or_bin = [FileForm2, ModForm2 | Forms]} ->
	    %% Optionally add export of main/1
	    Forms2 =
		case ExpMain of
		    false -> [{attribute,0,export, [{main,1}]} | Forms];
		    true  -> Forms
		end,
	    Forms3 = [FileForm2, ModForm2 | Forms2],
	    case CheckOnly of
		true ->
		    %% Strong validation and halt
		    case compile:forms(Forms3, [report,strong_validation]) of
			{ok,_} ->
			    my_halt(0);
			_Other ->
			    fatal("There were compilation errors.")
		    end;
		false ->
		    S#state{forms_or_bin = Forms3}
	    end
    end.

pre_def_macros(File) ->
    {MegaSecs, Secs, MicroSecs} = erlang:now(),
    Replace = fun(Char) ->
		      case Char of
			  $\. -> $\_;
                          _ -> Char
                      end
              end,
    CleanBase = lists:map(Replace, filename:basename(File)),
    ModuleStr =
	CleanBase ++ "__" ++
        "escript__" ++
        integer_to_list(MegaSecs) ++ "__" ++
        integer_to_list(Secs) ++ "__" ++
        integer_to_list(MicroSecs),
    Module = list_to_atom(ModuleStr),
    PreDefMacros = [{'MODULE', Module, redefine},
                    {'MODULE_STRING', ModuleStr, redefine}],
    {PreDefMacros, Module}.

epp_parse_file(Epp, S, Forms) ->
    Parsed = epp:parse_erl_form(Epp),
    epp_parse_file2(Epp, S, Forms, Parsed).

epp_parse_file2(Epp, S, Forms, Parsed) ->
    %% io:format("~p\n", [Parsed]),
    case Parsed of
        {ok, Form} ->
            case Form of
                {attribute,_,record, _} ->
		    S2 = S#state{has_records = true},
		    epp_parse_file(Epp, S2, [Form | Forms]);
                {attribute,Ln,mode,NewMode} ->
                    S2 = S#state{mode = NewMode},
                    if
                        NewMode =:= compile; NewMode =:= interpret; NewMode =:= debug; NewMode =:= native ->
                            epp_parse_file(Epp, S2, [Form | Forms]);
                        true ->
                            Args = lists:flatten(io_lib:format("illegal mode attribute: ~p", [NewMode])),
                            io:format("~ts:~w ~s\n", [S#state.file,Ln,Args]),
                            Error = {error,{Ln,erl_parse,Args}},
                            Nerrs= S#state.n_errors + 1,
                            epp_parse_file(Epp, S2#state{n_errors = Nerrs}, [Error | Forms])
                    end;
                {attribute,_,export,Fs} ->
                    case lists:member({main,1}, Fs) of
                        false ->
                            epp_parse_file(Epp, S, [Form | Forms]);
                        true ->
                            epp_parse_file(Epp, S#state{exports_main = true}, [Form | Forms])
                    end;
                _ ->
                    epp_parse_file(Epp, S, [Form | Forms])
            end;
        {error,{Ln,Mod,Args}} = Form ->
            io:format("~ts:~w: ~ts\n",
                      [S#state.file,Ln,Mod:format_error(Args)]),
            epp_parse_file(Epp, S#state{n_errors = S#state.n_errors + 1}, [Form | Forms]);
        {eof, _LastLine} = Eof ->
            S#state{forms_or_bin = lists:reverse([Eof | Forms])}
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Evaluate script
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

debug(Module, AbsMod, Args) ->
    case hidden_apply(debugger, debugger, start, []) of
	{ok, _} ->
	    case hidden_apply(debugger, int, i, [AbsMod]) of
		{module, _} ->
		    hidden_apply(debugger, debugger, auto_attach, [[init]]),
		    run(Module, Args);
		error ->
		    Text = lists:concat(["Cannot load the code for ", Module, " into the debugger"]),
		    fatal(Text)
	    end;
	_ ->
	    fatal("Cannot start the debugger")
    end.

run(Module, Args) ->
    try
        Module:main(Args),
        my_halt(0)
    catch
        Class:Reason ->
            fatal(format_exception(Class, Reason))
    end.

interpret(Forms, HasRecs,  File, Args) ->
    %% Basic validation before execution
    case erl_lint:module(Forms) of
	{ok,Ws} ->
	    report_warnings(Ws);
	{error,Es,Ws} ->
	    report_errors(Es),
	    report_warnings(Ws),
	    fatal("There were compilation errors.")
    end,
    %% Optionally expand records
    Forms2 =
	case HasRecs of
	    false -> Forms;
	    true  -> erl_expand_records:module(Forms, [])
	end,
    Dict = parse_to_dict(Forms2),
    ArgsA = erl_parse:abstract(Args, 0),
    Call = {call,0,{atom,0,main},[ArgsA]},
    try
        erl_eval:expr(Call,
                      erl_eval:new_bindings(),
                      {value,fun(I, J) -> code_handler(I, J, Dict, File) end}),
        my_halt(0)
    catch
        Class:Reason ->
            fatal(format_exception(Class, Reason))
    end.

report_errors(Errors) ->
    lists:foreach(fun ({{F,_L},Eds}) -> list_errors(F, Eds);
                      ({F,Eds}) -> list_errors(F, Eds) end,
                  Errors).

list_errors(F, [{Line,Mod,E}|Es]) ->
    io:fwrite("~ts:~w: ~ts\n", [F,Line,Mod:format_error(E)]),
    list_errors(F, Es);
list_errors(F, [{Mod,E}|Es]) ->
    io:fwrite("~ts: ~ts\n", [F,Mod:format_error(E)]),
    list_errors(F, Es);
list_errors(_F, []) -> ok.

report_warnings(Ws0) ->
    Ws1 = lists:flatmap(fun({{F,_L},Eds}) -> format_message(F, Eds);
                           ({F,Eds}) -> format_message(F, Eds) end,
                  Ws0),
    Ws = ordsets:from_list(Ws1),
    lists:foreach(fun({_,Str}) -> io:put_chars(Str) end, Ws).

format_message(F, [{Line,Mod,E}|Es]) ->
    M = {{F,Line},io_lib:format("~ts:~w: Warning: ~ts\n", [F,Line,Mod:format_error(E)])},
    [M|format_message(F, Es)];
format_message(F, [{Mod,E}|Es]) ->
    M = {none,io_lib:format("~ts: Warning: ~ts\n", [F,Mod:format_error(E)])},
    [M|format_message(F, Es)];
format_message(_, []) -> [].

parse_to_dict(L) -> parse_to_dict(L, dict:new()).

parse_to_dict([{function,_,Name,Arity,Clauses}|T], Dict0) ->
    Dict = dict:store({local, Name,Arity}, Clauses, Dict0),
    parse_to_dict(T, Dict);
parse_to_dict([{attribute,_,import,{Mod,Funcs}}|T], Dict0) ->
    Dict = lists:foldl(fun(I, D) ->
                               dict:store({remote,I}, Mod, D)
                       end, Dict0, Funcs),
    parse_to_dict(T, Dict);
parse_to_dict([_|T], Dict) ->
    parse_to_dict(T, Dict);
parse_to_dict([], Dict) ->
    Dict.

code_handler(local, [file], _, File) ->
    File;
code_handler(Name, Args, Dict, File) ->
    %%io:format("code handler=~p~n",[{Name, Args}]),
    Arity = length(Args),
    case dict:find({local,Name,Arity}, Dict) of
        {ok, Cs} ->
            LF = {value,fun(I, J) -> code_handler(I, J, Dict, File) end},
            case erl_eval:match_clause(Cs, Args,erl_eval:new_bindings(),LF) of
                {Body, Bs} ->
                    eval_exprs(Body, Bs, LF, none, none);
                nomatch ->
                    erlang:error({function_clause,[{local,Name,Args}]})
            end;
        error ->
            case dict:find({remote,{Name,Arity}}, Dict) of
                {ok, Mod} ->
                    %% io:format("Calling:~p~n",[{Mod,Name,Args}]),
                    apply(Mod, Name, Args);
                error ->
                    io:format("Script does not export ~w/~w\n", [Name,Arity]),
                    my_halt(127)
            end
    end.

eval_exprs([E], Bs0, Lf, Ef, _RBs) ->
    RBs1 = value,
    erl_eval:expr(E, Bs0, Lf, Ef, RBs1);
eval_exprs([E|Es], Bs0, Lf, Ef, RBs) ->
    RBs1 = none,
    {value,_V,Bs} = erl_eval:expr(E, Bs0, Lf, Ef, RBs1),
    eval_exprs(Es, Bs, Lf, Ef, RBs).

format_exception(Class, Reason) ->
    Enc = encoding(),
    P = case Enc of
            latin1 -> "P";
            _ -> "tP"
        end,
    PF = fun(Term, I) ->
                 io_lib:format("~." ++ integer_to_list(I) ++ P, [Term, 50])
         end,
    StackTrace = erlang:get_stacktrace(),
    StackFun = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end,
    lib:format_exception(1, Class, Reason, StackTrace, StackFun, PF, Enc).

encoding() ->
    [{encoding, Encoding}] = enc(),
    Encoding.

enc() ->
    case lists:keyfind(encoding, 1, io:getopts()) of
        false -> [{encoding,latin1}]; % should never happen
        Enc -> [Enc]
    end.

fatal(Str) ->
    throw(Str).

my_halt(Reason) ->
    erlang:halt(Reason).

hidden_apply(App, M, F, Args) ->
    try
	apply(fun() -> M end(), F, Args)
    catch
	error:undef ->
	    case erlang:get_stacktrace() of
		[{M,F,Args,_} | _] ->
		    Arity = length(Args),
		    Text = io_lib:format("Call to ~w:~w/~w in application ~w failed.\n",
					 [M, F, Arity, App]),
		    fatal(Text);
		Stk ->
		    erlang:raise(error, undef, Stk)
	    end
    end.