mercury/compiler/options_file.m

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2002-2011 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: options_file.m.
% Main author: stayl.
%
% Code to deal with options for `mmc --make', including code to parse
% Mercury.options files.
%
%-----------------------------------------------------------------------------%

:- module make.options_file.
:- interface.

:- import_module mdbcomp.sym_name.

:- import_module io.
:- import_module list.
:- import_module maybe.

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

:- type options_variables.

:- func options_variables_init = options_variables.

    % Read a single options file, without searching
    % --options-search-directories.
    % This is used to read the configuration file.
    %
:- pred read_options_file(globals::in, file_name::in, options_variables::in,
    maybe(options_variables)::out, io::di, io::uo) is det.

    % Read a single options file. No searching will be done. The result is
    % the value of the variable MCFLAGS obtained from the file, ignoring
    % settings in the environment. This is used to pass arguments to child
    % mmc processes without exceeding command line limits on crappy operating
    % systems.
    %
    % This is not quite the same as @file syntax as the environment is ignored.
    %
:- pred read_args_file(globals::in, file_name::in, maybe(list(string))::out,
    io::di, io::uo) is det.

    % Read all options files specified by `--options-file' options.
    %
:- pred read_options_files(globals::in, options_variables::in,
    maybe(options_variables)::out, io::di, io::uo) is det.

    % Look up the DEFAULT_MCFLAGS variable.
    %
:- pred lookup_default_options(globals::in, options_variables::in,
    maybe(list(string))::out, io::di, io::uo) is det.

    % Look up all the non-module specific options.
    %
:- pred lookup_mmc_options(globals::in, options_variables::in,
    maybe(list(string))::out, io::di, io::uo) is det.

    % Same as lookup_mmc_options, but also adds the module-specific
    % (MCFLAGS-module) options.
    %
:- pred lookup_mmc_module_options(globals::in, options_variables::in,
    module_name::in, maybe(list(string))::out, io::di, io::uo) is det.

    % Look up $(MAIN_TARGET).
    %
:- pred lookup_main_target(globals::in, options_variables::in,
    maybe(list(string))::out, io::di, io::uo) is det.

    % Look up $(MERCURY_STDLIB_DIR).
    %
:- pred lookup_mercury_stdlib_dir(globals::in, options_variables::in,
    maybe(list(string))::out, io::di, io::uo) is det.

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

:- implementation.

:- import_module libs.globals.
:- import_module libs.options.
:- import_module parse_tree.error_util.

:- import_module assoc_list.
:- import_module bool.
:- import_module char.
:- import_module dir.
:- import_module exception.
:- import_module map.
:- import_module require.
:- import_module std_util.
:- import_module string.
:- import_module term.
:- import_module univ.

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

:- type options_variable == string.

:- type options_file_error
    --->    options_file_error(string).

:- type found_options_file_error
    --->    found_options_file_error.

:- type options_variables == map(options_variable, options_variable_value).

:- type options_variable_value
    --->    options_variable_value(
                list(char),
                list(string),   % split into words.
                variable_source
            ).

:- type variable_source
    --->    options_file
    ;       command_line
    ;       environment.

options_variables_init = map.init.

read_args_file(Globals, OptionsFile, MaybeMCFlags, !IO) :-
    read_options_file(Globals, OptionsFile, options_variables_init,
        MaybeVariables, !IO),
    (
        MaybeVariables = yes(Variables),
        % Ignore settings in the environment -- the parent mmc process
        % will have included those in the file.
        lookup_variable_words_maybe_env(no, Variables, "MCFLAGS", FlagsResult,
            !IO),
        (
            FlagsResult = var_result_set(MCFlags),
            MaybeMCFlags = yes(MCFlags)
        ;
            FlagsResult = var_result_unset,
            io.write_string("mercury_compile: internal error: " ++
                "arguments file does not set MCFLAGS.\n", !IO),
            MaybeMCFlags = no
        ;
            FlagsResult = var_result_error(ErrorSpec),
            MaybeMCFlags = no,
            write_error_spec(ErrorSpec, Globals, 0, _, 0, _, !IO)
        )
    ;
        MaybeVariables = no,
        MaybeMCFlags = no
    ).

read_options_file(Globals, OptionsFile, Variables0, MaybeVariables, !IO) :-
    promise_equivalent_solutions [OptionsFileResult, !:IO] (
        try_io(
            ( pred((Variables1)::out, !.IO::di, !:IO::uo) is det :-
                read_options_file_params(Globals, error, no_search, no,
                    OptionsFile, Variables0, Variables1, !IO)
            ),
            OptionsFileResult, !IO)
    ),
    (
        OptionsFileResult = succeeded(Variables),
        MaybeVariables = yes(Variables)
    ;
        OptionsFileResult = exception(Exception),
        ( if Exception = univ(found_options_file_error) then
            MaybeVariables = no
        else
            rethrow(OptionsFileResult)
        )
    ).

read_options_files(Globals, Variables0, MaybeVariables, !IO) :-
    promise_equivalent_solutions [OptionsFileResult, !:IO] (
        try_io(read_options_file_lookup_params(Globals, Variables0),
            OptionsFileResult, !IO)
    ),
    (
        OptionsFileResult = succeeded(Variables),
        MaybeVariables = yes(Variables)
    ;
        OptionsFileResult = exception(Exception),
        ( if Exception = univ(found_options_file_error) then
            MaybeVariables = no
        else
            rethrow(OptionsFileResult)
        )
    ).

:- pred read_options_file_lookup_params(globals::in,
    options_variables::in, options_variables::out, io::di, io::uo) is det.

read_options_file_lookup_params(Globals, !Variables, !IO) :-
    globals.lookup_accumulating_option(Globals, options_files, OptionsFiles),
    list.foldl2(read_options_file_set_params(Globals), OptionsFiles,
        !Variables, !IO).

:- pred read_options_file_set_params(globals::in, string::in,
    options_variables::in, options_variables::out, io::di, io::uo) is det.

read_options_file_set_params(Globals, OptionsFile, !Vars, !IO) :-
    ( if OptionsFile = "Mercury.options" then
        ErrorIfNotExist = no_error,
        Search = no_search
    else
        ErrorIfNotExist = error,
        Search = search
    ),
    read_options_file_params(Globals, ErrorIfNotExist, Search, no, OptionsFile,
        !Vars, !IO).

:- type error_if_not_exist
    --->    error
    ;       no_error.

:- type search
    --->    search
    ;       no_search.

:- pred read_options_file_params(globals::in, error_if_not_exist::in,
    search::in, maybe(dir_name)::in, string::in, options_variables::in,
    options_variables::out, io::di, io::uo) is det.

read_options_file_params(Globals, ErrorIfNotExist, Search, MaybeDirName,
        OptionsFile0, !Variables, !IO) :-
    ( if OptionsFile0 = "-" then
        % Read from standard input.
        debug_make_msg(Globals, write_reading_options_file_stdin, !IO),
        read_options_lines(Globals, dir.this_directory, !Variables, !IO),
        debug_make_msg(Globals, write_done, !IO)
    else
        debug_make_msg(Globals, write_reading_options_file(OptionsFile0), !IO),
        (
            Search = search,
            globals.lookup_accumulating_option(Globals,
                options_search_directories, SearchDirs)
        ;
            Search = no_search,
            SearchDirs = [dir.this_directory]
        ),
        ( if dir.split_name(OptionsFile0, OptionsDir, OptionsFile) then
            ( if dir.path_name_is_absolute(OptionsDir) then
                FileToFind = OptionsFile,
                Dirs = [OptionsDir]
            else
                (
                    MaybeDirName = yes(DirName),
                    FileToFind = OptionsFile,
                    Dirs = [DirName/OptionsDir | SearchDirs]
                ;
                    MaybeDirName = no,
                    Dirs = SearchDirs,
                    FileToFind = OptionsFile0
                )
            )
        else
            Dirs = SearchDirs,
            FileToFind = OptionsFile0
        ),
        search_for_file_returning_dir_and_stream(Dirs, FileToFind,
            MaybeDirAndStream, !IO),
        (
            MaybeDirAndStream =
                ok(path_name_and_stream(FoundDir, FoundStream)),
            debug_make_msg(Globals,
                write_reading_options_file(FoundDir/FileToFind), !IO),

            % XXX Instead of setting and unsetting the input stream,
            % we should simply pass FoundStream to read_options_lines.
            % However, when I (zs) tried that, I quickly found that
            % the call tree of read_options_lines includes many predicates
            % for which it is not at all clear whether they *intend*
            % to read from a current standard input that originates as
            % FoundStream, or they just *happen* to do so.
            %
            % XXX The changeover would also be simpler if there was an easy way
            % to detect calls that read from the current input stream.

            io.set_input_stream(FoundStream, OldInputStream, !IO),
            read_options_lines(Globals, FoundDir, !Variables, !IO),
            io.set_input_stream(OldInputStream, _FoundStream, !IO),
            io.close_input(FoundStream, !IO)
        ;
            MaybeDirAndStream = error(_),
            (
                ErrorIfNotExist = error,
                ( if Dirs = [SingleDir] then
                    ErrorFile = maybe_add_path_name(SingleDir, FileToFind)
                else
                    ErrorFile = FileToFind
                ),
                ErrorSpec = error_spec(severity_error, phase_read_files,
                    [error_msg(no, do_not_treat_as_first, 0,
                        [always([words("Error reading options file"),
                            quote(ErrorFile), suffix(".")])])]),
                write_error_spec(ErrorSpec, Globals, 0, _, 0, _, !IO)
            ;
                ErrorIfNotExist = no_error
            )
        ),
        debug_make_msg(Globals, write_done, !IO)
    ).

:- pred write_reading_options_file_stdin(io::di, io::uo) is det.

write_reading_options_file_stdin(!IO) :-
    io.write_string("Reading options file from stdin...", !IO).

:- pred write_reading_options_file(string::in, io::di, io::uo) is det.

write_reading_options_file(FileName, !IO) :-
    io.write_string("Reading options file ", !IO),
    io.write_string(FileName, !IO),
    io.nl(!IO).

:- pred write_done(io::di, io::uo) is det.

write_done(!IO) :-
    io.write_string("done.\n", !IO).

:- func maybe_add_path_name(dir_name, file_name) = file_name.

maybe_add_path_name(Dir, File) =
    ( if Dir = dir.this_directory then
        File
    else
        dir.make_path_name(Dir, File)
    ).

:- pred read_options_lines(globals::in, dir_name::in, options_variables::in,
    options_variables::out, io::di, io::uo) is det.

read_options_lines(Globals, Dir, !Variables, !IO) :-
    io.get_line_number(LineNumber, !IO),
    promise_equivalent_solutions [LineResult, !:IO] (
        read_options_lines_2(Globals, Dir, !.Variables, LineResult, !IO)
    ),
    (
        LineResult = succeeded(!:Variables - FoundEOF),
        (
            FoundEOF = yes
        ;
            FoundEOF = no,
            read_options_lines(Globals, Dir, !Variables, !IO)
        )
    ;
        LineResult = exception(Exception),
        ( if Exception = univ(options_file_error(Error)) then
            io.input_stream_name(FileName, !IO),
            Context = term.context_init(FileName, LineNumber),
            write_error_pieces(Globals, Context, 0, [words(Error)], !IO),

            % This will be caught by `read_options_files'. The open options
            % files aren't closed on the way up, but we will be exiting
            % straight away, so that doesn't matter.
            throw(found_options_file_error)
        else
            rethrow(LineResult)
        )
    ;
        LineResult = failed,
        unexpected($module, $pred, "cannot read line")
    ).

:- pred read_options_lines_2(globals::in, dir_name::in, options_variables::in,
    exception_result(pair(options_variables, bool))::out,
    io::di, io::uo) is cc_multi.

read_options_lines_2(Globals, Dir, Variables0, Result, !IO) :-
    try_io(read_options_lines_3(Globals, Dir, Variables0), Result, !IO).

:- pred read_options_lines_3(globals::in, dir_name::in, options_variables::in,
    pair(options_variables, bool)::out, io::di, io::uo) is det.

read_options_lines_3(Globals, Dir, !.Variables, !:Variables - FoundEOF, !IO) :-
    read_options_line(FoundEOF, Line0, !IO),
    (
        Line0 = []
    ;
        Line0 = [_ | _],
        parse_options_line(Line0, ParsedLine),
        (
            ParsedLine = define_variable(VarName, AddToValue, Value),
            update_variable(Globals, VarName, AddToValue, Value,
                !Variables, !IO)
        ;
            ParsedLine = include_options_files(ErrorIfNotExist,
                IncludedFilesChars0),
            expand_variables(!.Variables,
                IncludedFilesChars0, IncludedFilesChars, UndefVars, !IO),
            report_undefined_variables(Globals, UndefVars, !IO),
            IncludedFileNames = split_into_words(IncludedFilesChars),
            list.foldl2(
                read_options_file_params(Globals, ErrorIfNotExist, search,
                    yes(Dir)),
                IncludedFileNames, !Variables, !IO)
        )
    ).

:- pred read_options_line(bool::out, list(char)::out, io::di, io::uo) is det.

read_options_line(FoundEOF, list.reverse(RevChars), !IO) :-
    io.ignore_whitespace(SpaceResult, !IO),
    (
        SpaceResult = ok
    ;
        SpaceResult = eof
    ;
        SpaceResult = error(Error),
        throw(options_file_error(io.error_message(Error)))
    ),
    read_options_line_2(FoundEOF, [], RevChars, !IO).

:- pred read_options_line_2(bool::out, list(char)::in, list(char)::out,
    io::di, io::uo) is det.

read_options_line_2(FoundEOF, !Chars, !IO) :-
    read_item_or_eof(io.read_char, MaybeChar, !IO),
    (
        MaybeChar = yes(Char),
        ( if Char = '#' then
            skip_comment_line(FoundEOF, !IO)
        else if Char = ('\\') then
            read_item_or_eof(io.read_char, MaybeChar2, !IO),
            (
                MaybeChar2 = yes(Char2),
                ( if Char2 = '\n' then
                    !:Chars = [' ' | !.Chars]
                else
                    !:Chars = [Char2, Char | !.Chars]
                ),
                read_options_line_2(FoundEOF, !Chars, !IO)
            ;
                MaybeChar2 = no,
                FoundEOF = yes,
                !:Chars = [Char | !.Chars]
            )
        else if Char = '\n' then
            FoundEOF = no
        else
            !:Chars = [Char | !.Chars],
            read_options_line_2(FoundEOF, !Chars, !IO)
        )
    ;
        MaybeChar = no,
        FoundEOF = yes
    ).

:- pred update_variable(globals::in, options_variable::in, bool::in,
    list(char)::in, options_variables::in, options_variables::out,
    io::di, io::uo) is det.

update_variable(Globals, VarName, AddToValue, NewValue0, !Variables, !IO) :-
    expand_variables(!.Variables, NewValue0, NewValue1, Undef, !IO),
    report_undefined_variables(Globals, Undef, !IO),
    Words1 = split_into_words(NewValue1),
    io.get_environment_var(VarName, MaybeEnvValue, !IO),
    (
        MaybeEnvValue = yes(EnvValue),
        Value = string.to_char_list(EnvValue),
        Words = split_into_words(Value),
        OptVarValue = options_variable_value(string.to_char_list(EnvValue),
            Words, environment),
        map.set(VarName, OptVarValue, !Variables)
    ;
        MaybeEnvValue = no,
        ( if
            map.search(!.Variables, VarName,
                options_variable_value(OldValue, OldWords, Source))
        then
            (
                Source = environment
            ;
                Source = command_line
            ;
                Source = options_file,
                (
                    AddToValue = yes,
                    NewValue = OldValue ++ [' ' |  NewValue1],
                    Words = OldWords ++ Words1
                ;
                    AddToValue = no,
                    NewValue = NewValue1,
                    Words = Words1
                ),
                OptVarValue = options_variable_value(NewValue, Words,
                    options_file),
                map.set(VarName, OptVarValue, !Variables)
            )
        else
            OptVarValue = options_variable_value(NewValue1, Words1,
                options_file),
            map.set(VarName, OptVarValue, !Variables)
        )
    ).

:- pred expand_variables(options_variables::in, list(char)::in,
    list(char)::out, list(string)::out, io::di, io::uo) is det.

expand_variables(Variables, Chars0, Chars, UndefVars, !IO) :-
    expand_variables_2(Variables, Chars0, [], RevChars, [], RevUndefVars, !IO),
    list.reverse(RevChars, Chars),
    list.reverse(RevUndefVars, UndefVars).

:- pred expand_variables_2(options_variables::in, list(char)::in,
    list(char)::in, list(char)::out, list(string)::in, list(string)::out,
    io::di, io::uo) is det.

expand_variables_2(_, [], !RevChars, !RevUndef, !IO).
expand_variables_2(Variables, [Char | Chars], !RevChars, !RevUndef, !IO) :-
    ( if Char = '$' then
        (
            Chars = [],
            throw(options_file_error("unterminated variable reference"))
        ;
            Chars = [Char2 | Chars1],
            ( if Char2 = '$' then
                !:RevChars = ['$' | !.RevChars],
                expand_variables_2(Variables, Chars1, !RevChars, !RevUndef,
                    !IO)
            else
                ( if
                    (
                        Char2 = '(',
                        EndChar = ')'
                    ;
                        Char2 = '{',
                        EndChar = '}'
                    )
                then
                    parse_variable(VarName0, Chars1, Chars2),
                    ( if Chars2 = [EndChar | Chars3] then
                        Chars4 = Chars3,
                        VarName = VarName0
                    else
                        throw(options_file_error(
                            "unterminated variable reference"))
                    )
                else
                    Chars4 = Chars1,
                    VarName = string.char_to_string(Char2)
                ),
                lookup_variable_chars(Variables, VarName, VarChars, !RevUndef,
                    !IO),
                !:RevChars = reverse(VarChars) ++ !.RevChars,
                expand_variables_2(Variables, Chars4, !RevChars, !RevUndef,
                    !IO)
            )
        )
    else
        !:RevChars = [Char | !.RevChars],
        expand_variables_2(Variables, Chars, !RevChars, !RevUndef, !IO)
    ).

:- pred report_undefined_variables(globals::in, list(string)::in,
    io::di, io::uo) is det.

report_undefined_variables(Globals, Vars, !IO) :-
    report_undefined_variables_2(Globals, list.sort_and_remove_dups(Vars),
        !IO).

:- pred report_undefined_variables_2(globals::in, list(string)::in,
    io::di, io::uo) is det.

report_undefined_variables_2(_, [], !IO).
report_undefined_variables_2(Globals, [_ | Rest] @ UndefVars, !IO) :-
    globals.lookup_bool_option(Globals, warn_undefined_options_variables,
        Warn),
    (
        Warn = yes,
        io.input_stream_name(FileName, !IO),
        io.get_line_number(LineNumber, !IO),
        Context = term.context_init(FileName, LineNumber),

        VarList = list_to_pieces(list.map(add_quotes,
            list.sort_and_remove_dups(UndefVars))),
        ( Rest = [], Word = "variable", IsOrAre = "is"
        ; Rest = [_ | _], Word = "variables", IsOrAre = "are"
        ),
        Pieces = [words("Warning: "), words(Word) | VarList]
            ++ [words(IsOrAre), words("undefined.")],
        write_error_pieces(Globals, Context, 0, Pieces, !IO),

        globals.lookup_bool_option(Globals, halt_at_warn, Halt),
        (
            Halt = yes,
            throw(found_options_file_error)
        ;
            Halt = no
        )
    ;
        Warn = no
    ).

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

:- type options_file_line
    --->    define_variable(
                options_variable,
                bool,       % Add to any existing value?
                list(char)
            )
    ;       include_options_files(
                error_if_not_exist,
                list(char)
            ).

:- pred parse_options_line(list(char)::in, options_file_line::out) is det.

parse_options_line(Line0, OptionsFileLine) :-
    ( if
        ( if Line0 = [('-') | Line1] then
            ErrorIfNotExist = no_error,
            Line2 = Line1
        else
            ErrorIfNotExist = error,
            Line2 = Line0
        ),
        list.append(string.to_char_list("include"), Line3, Line2)
    then
        list.drop_while(char.is_whitespace, Line3, Line4),
        OptionsFileLine = include_options_files(ErrorIfNotExist, Line4)
    else
        parse_variable(VarName, Line0, Line1),
        list.drop_while(char.is_whitespace, Line1, Line2),
        ( if Line2 = [('=') | Line3] then
            Add = no,
            Line4 = Line3
        else if Line2 = [('+'), ('=') | Line3] then
            Add = yes,
            Line4 = Line3
        else if Line2 = [(':'), ('=') | Line3] then
            Add = no,
            Line4 = Line3
        else
            throw(options_file_error(
                "expected `=', `:=' or `+=' after `" ++ VarName ++ "'"))
        ),
        list.drop_while(char.is_whitespace, Line4, VarValue),
        OptionsFileLine = define_variable(VarName, Add, VarValue)
    ).

:- pred parse_variable(options_variable::out,
    list(char)::in, list(char)::out) is det.

parse_variable(VarName, Chars0, Chars) :-
    parse_variable_2(yes, [], VarList, Chars0, Chars),
    string.from_rev_char_list(VarList, VarName),
    ( if VarName = "" then
        list.take_while(isnt(char.is_whitespace), Chars, FirstWord),
        throw(options_file_error("expected variable at `" ++
            string.from_char_list(FirstWord) ++ "'"))
    else
        true
    ).

:- pred parse_variable_2(bool::in, list(char)::in, list(char)::out,
    list(char)::in, list(char)::out) is det.

parse_variable_2(_, Var, Var, [], []).
parse_variable_2(IsFirst, Var0, Var, [Char | Chars0], Chars) :-
    ( if
        not char.is_whitespace(Char),
        (
            IsFirst = yes,
            char.is_alpha(Char)
        ;
            IsFirst = no,
            ( char.is_alnum_or_underscore(Char)
            ; Char = ('-')
            ; Char = ('.')
            )
        )
    then
        parse_variable_2(no, [Char | Var0], Var, Chars0, Chars)
    else
        Var = Var0,
        Chars = [Char | Chars0]
    ).

:- pred parse_string_chars(list(char)::in, list(char)::out,
    list(char)::in, list(char)::out) is det.

parse_string_chars(_, _, [], _) :-
    throw(options_file_error("unterminated string")).
parse_string_chars(String0, String, [Char | Chars0], Chars) :-
    ( if Char = '"' then
        Chars = Chars0,
        String = String0
    else if Char = ('\\') then
        (
            Chars0 = [Char2 | Chars1],
            ( if Char2 = '"' then
                String1 = [Char2 | String0]
            else
                String1 = [Char2, Char | String0]
            ),
            parse_string_chars(String1, String, Chars1, Chars)
        ;
            Chars0 = [],
            throw(options_file_error("unterminated string"))
        )
    else
        parse_string_chars([Char | String0], String, Chars0, Chars)
    ).

:- pred skip_comment_line(bool::out, io::di, io::uo) is det.

skip_comment_line(FoundEOF, !IO) :-
    read_item_or_eof(io.read_char, MaybeChar, !IO),
    (
        MaybeChar = yes(Char),
        ( if Char = '\n' then
            FoundEOF = no
        else
            skip_comment_line(FoundEOF, !IO)
        )
    ;
        MaybeChar = no,
        FoundEOF = yes
    ).

:- pred read_item_or_eof(
    pred(io.result(T), io, io)::(pred(out, di, uo) is det),
    maybe(T)::out, io::di, io::uo) is det.

read_item_or_eof(Pred, MaybeItem, !IO) :-
    Pred(Result, !IO),
    (
        Result = ok(Item),
        MaybeItem = yes(Item)
    ;
        Result = eof,
        MaybeItem = no
    ;
        Result = error(Error),
        throw(options_file_error(io.error_message(Error)))
    ).

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

:- func checked_split_into_words(list(char)) = maybe_error(list(string)).

checked_split_into_words(Chars) = Result :-
    promise_equivalent_solutions [TryResult] (
        try(
            ( pred(Words0::out) is det :-
                Words0 = split_into_words(Chars)
            ), TryResult)
    ),
    (
        TryResult = succeeded(Words),
        Result = ok(Words)
    ;
        TryResult = exception(Exception),
        ( if Exception = univ(options_file_error(Msg)) then
            Result = error(Msg)
        else
            rethrow(TryResult)
        )
    ).

:- func split_into_words(list(char)) = list(string).

split_into_words(Chars) = list.reverse(split_into_words_2(Chars, [])).

:- func split_into_words_2(list(char), list(string)) = list(string).

split_into_words_2(Chars0, RevWords0) = RevWords :-
    list.drop_while(char.is_whitespace, Chars0, Chars1),
    (
        Chars1 = [],
        RevWords = RevWords0
    ;
        Chars1 = [_ | _],
        get_word(Word, Chars1, Chars),
        RevWords = split_into_words_2(Chars, [Word | RevWords0])
    ).

:- pred get_word(string::out, list(char)::in, list(char)::out) is det.

get_word(Word, Chars0, Chars) :-
    get_word_2([], RevWord, Chars0, Chars),
    Word = string.from_rev_char_list(RevWord).

:- pred get_word_2(list(char)::in, list(char)::out,
    list(char)::in, list(char)::out) is det.

get_word_2(RevWord, RevWord, [], []).
get_word_2(RevWord0, RevWord, [Char | Chars0], Chars) :-
    ( if char.is_whitespace(Char) then
        Chars = Chars0,
        RevWord = RevWord0
    else if Char = '"' then
        parse_string_chars([], RevStringChars, Chars0, Chars1),
        get_word_2(RevStringChars ++ RevWord0, RevWord, Chars1, Chars)
    else if Char = ('\\') then
        (
            Chars0 = [],
            RevWord = [Char | RevWord0],
            Chars = []
        ;
            Chars0 = [Char2 | Chars1],
            ( if
                ( Char2 = '"'
                ; Char2 = ('\\')
                )
            then
                get_word_2([Char2 | RevWord0], RevWord, Chars1, Chars)
            else
                get_word_2([Char2, Char | RevWord0], RevWord, Chars1, Chars)
            )
        )
    else
        get_word_2([Char | RevWord0], RevWord, Chars0, Chars)
    ).

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

lookup_main_target(Globals, Vars, MaybeMainTarget, !IO) :-
    lookup_variable_words_report_error(Globals, Vars, "MAIN_TARGET",
        MainTargetResult, !IO),
    (
        MainTargetResult = var_result_set(MainTarget),
        MaybeMainTarget = yes(MainTarget)
    ;
        MainTargetResult = var_result_unset,
        MaybeMainTarget = yes([])
    ;
        MainTargetResult = var_result_error(_),
        MaybeMainTarget = no
    ).

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

lookup_mercury_stdlib_dir(Globals, Vars, MaybeMerStdlibDir, !IO) :-
    lookup_variable_words_report_error(Globals, Vars, "MERCURY_STDLIB_DIR",
        MerStdlibDirResult, !IO),
    (
        MerStdlibDirResult = var_result_set(MerStdlibDir),
        MaybeMerStdlibDir = yes(MerStdlibDir)
    ;
        MerStdlibDirResult = var_result_unset,
        MaybeMerStdlibDir = yes([])
    ;
        MerStdlibDirResult = var_result_error(_),
        MaybeMerStdlibDir = no
    ).

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

lookup_default_options(Globals, Vars, Result, !IO) :-
    lookup_mmc_maybe_module_options(Globals, Vars, default, Result, !IO).

lookup_mmc_options(Globals, Vars, Result, !IO) :-
    lookup_mmc_maybe_module_options(Globals, Vars,
        non_module_specific, Result, !IO).

lookup_mmc_module_options(Globals, Vars, ModuleName, Result, !IO) :-
    lookup_mmc_maybe_module_options(Globals, Vars,
        module_specific(ModuleName), Result, !IO).

:- pred lookup_mmc_maybe_module_options(globals::in, options_variables::in,
    options_variable_class::in, maybe(list(string))::out, io::di, io::uo)
    is det.

lookup_mmc_maybe_module_options(Globals, Vars, MaybeModuleName, Result, !IO) :-
    VariableTypes = options_variable_types,
    list.map_foldl(lookup_options_variable(Globals, Vars, MaybeModuleName),
        VariableTypes, Results, !IO),
    ( if
        list.map(
            ( pred(VarResult::in, MaybeValue::out) is semidet :-
                (
                    VarResult = var_result_set(Value),
                    MaybeValue = yes(Value)
                ;
                    VarResult = var_result_unset,
                    MaybeValue = no
                ;
                    VarResult = var_result_error(_),
                    fail
                )
            ), Results, Values)
    then
        assoc_list.from_corresponding_lists(VariableTypes,
            Values, VariableValues),
        % Default to `-O2', even when mercury_compile is called directly,
        % not by the mmc script.
        Result = yes(["-O2" | list.condense(
            list.map(convert_to_mmc_options, VariableValues))])
    else
        Result = no
    ).

:- type options_variable_class
    --->    default
    ;       non_module_specific
    ;       module_specific(module_name).

:- type options_variable_type
    --->    grade_flags
    ;       mmc_flags
    ;       c_flags
    ;       gcc_flags
    ;       clang_flags
    ;       msvc_flags
    ;       java_flags
    ;       csharp_flags
    ;       erlang_flags
    ;       ml_objs
    ;       ml_libs
    ;       ld_flags
    ;       ld_libflags
    ;       c2init_args
    ;       libraries
    ;       lib_dirs
    ;       lib_grades
    ;       lib_linkages
    ;       install_prefix
    ;       stdlib_dir
    ;       config_dir
    ;       linkage
    ;       mercury_linkage.

:- func options_variable_types = list(options_variable_type).

options_variable_types =
    % `LIBRARIES' should come before `MLLIBS' (Mercury libraries depend on
    % C libraries, but C libraries typically do not depend on Mercury
    % libraries).
    % `MERCURY_STDLIB_DIR' and `MERCURY_CONFIG_DIR' should come before
    % `MCFLAGS'. Settings in `MCFLAGS' (e.g. `--no-mercury-stdlib-dir')
    % should override settings of these in the environment.
    [grade_flags, linkage, mercury_linkage, lib_grades, lib_linkages,
    stdlib_dir, config_dir, mmc_flags, c_flags, gcc_flags, clang_flags,
    msvc_flags, java_flags,
    csharp_flags, erlang_flags,
    ml_objs, lib_dirs, ld_flags, ld_libflags,
    libraries, ml_libs, c2init_args, install_prefix].

:- func options_variable_name(options_variable_type) = string.

options_variable_name(grade_flags) = "GRADEFLAGS".
options_variable_name(mmc_flags) = "MCFLAGS".
options_variable_name(c_flags) = "CFLAGS".
options_variable_name(gcc_flags) = "GCC_FLAGS".
options_variable_name(clang_flags) = "CLANG_FLAGS".
options_variable_name(msvc_flags) = "MSVC_FLAGS".
options_variable_name(java_flags) = "JAVACFLAGS".
options_variable_name(csharp_flags) = "CSCFLAGS".
options_variable_name(erlang_flags) = "ERLANG_FLAGS".
options_variable_name(ml_objs) = "MLOBJS".
options_variable_name(ml_libs) = "MLLIBS".
options_variable_name(ld_flags) = "LDFLAGS".
options_variable_name(ld_libflags) = "LD_LIBFLAGS".
options_variable_name(c2init_args) = "C2INITARGS".
options_variable_name(libraries) = "LIBRARIES".
options_variable_name(lib_dirs) = "LIB_DIRS".
options_variable_name(lib_grades) = "LIBGRADES".
options_variable_name(lib_linkages) = "LIB_LINKAGES".
options_variable_name(install_prefix) = "INSTALL_PREFIX".
options_variable_name(stdlib_dir) = "MERCURY_STDLIB_DIR".
options_variable_name(config_dir) = "MERCURY_CONFIG_DIR".
options_variable_name(linkage) = "LINKAGE".
options_variable_name(mercury_linkage) = "MERCURY_LINKAGE".

:- func options_variable_type_is_target_specific(options_variable_type) = bool.

options_variable_type_is_target_specific(grade_flags) = no.
options_variable_type_is_target_specific(mmc_flags) = yes.
options_variable_type_is_target_specific(c_flags) = yes.
options_variable_type_is_target_specific(gcc_flags) = yes.
options_variable_type_is_target_specific(clang_flags) = yes.
options_variable_type_is_target_specific(msvc_flags) = yes.
options_variable_type_is_target_specific(java_flags) = yes.
options_variable_type_is_target_specific(csharp_flags) = yes.
options_variable_type_is_target_specific(erlang_flags) = yes.
options_variable_type_is_target_specific(ml_objs) = yes.
options_variable_type_is_target_specific(ml_libs) = yes.
options_variable_type_is_target_specific(ld_flags) = yes.
options_variable_type_is_target_specific(ld_libflags) = yes.
options_variable_type_is_target_specific(c2init_args) = yes.
options_variable_type_is_target_specific(libraries) = yes.
options_variable_type_is_target_specific(lib_dirs) = no.
options_variable_type_is_target_specific(install_prefix) = yes.
options_variable_type_is_target_specific(stdlib_dir) = no.
options_variable_type_is_target_specific(config_dir) = no.
options_variable_type_is_target_specific(lib_grades) = yes.
options_variable_type_is_target_specific(lib_linkages) = yes.
options_variable_type_is_target_specific(linkage) = yes.
options_variable_type_is_target_specific(mercury_linkage) = yes.

:- func convert_to_mmc_options(
    pair(options_variable_type, maybe(list(string)))) = list(string).

convert_to_mmc_options(_ - no) = [].
convert_to_mmc_options(VariableType - yes(VariableValue)) =
    convert_to_mmc_options_with_value(VariableType, VariableValue).

:- func convert_to_mmc_options_with_value(options_variable_type, list(string))
    = list(string).

convert_to_mmc_options_with_value(VariableType, VariableValue)
        = OptionsStrings :-
    MMCOptionType = mmc_option_type(VariableType),
    (
        MMCOptionType = mmc_flags,
        OptionsStrings = VariableValue
    ;
        MMCOptionType = option(InitialOptions, OptionName),
        OptionsStrings = list.condense([InitialOptions |
            list.map((func(Word) = [OptionName, Word]), VariableValue)])
    ).

:- type mmc_option_type
    --->    mmc_flags
            % The options can be passed directly to mmc.

    ;       option(
                initial_options :: list(string),
                option_name :: string
            ).
            % The options need to be passed as an argument of an option to mmc.
            % The `initial_options' will be passed before the options generated
            % by the variable. This is useful for clearing an accumulating
            % option.

:- func mmc_option_type(options_variable_type) = mmc_option_type.

mmc_option_type(grade_flags) = mmc_flags.
mmc_option_type(mmc_flags) = mmc_flags.
mmc_option_type(c_flags) = option([], "--cflag").
mmc_option_type(gcc_flags) = option([], "--gcc-flag").
mmc_option_type(clang_flags) = option([], "--clang-flag").
mmc_option_type(msvc_flags) = option([], "--msvc-flag").
mmc_option_type(java_flags) = option([], "--java-flag").
mmc_option_type(csharp_flags) = option([], "--csharp-flag").
mmc_option_type(erlang_flags) = option([], "--erlang-flag").
mmc_option_type(ml_objs) = option([], "--link-object").
mmc_option_type(ml_libs) = mmc_flags.
mmc_option_type(ld_flags) = option([], "--ld-flag").
mmc_option_type(ld_libflags) = option([], "--ld-libflag").
mmc_option_type(c2init_args) = option([], "--init-file").
mmc_option_type(libraries) = option([], "--mercury-library").
mmc_option_type(lib_dirs) = option([], "--mercury-library-directory").
mmc_option_type(lib_grades) = option(["--no-libgrade"], "--libgrade").
mmc_option_type(lib_linkages) = option(["--no-lib-linkage"], "--lib-linkage").
mmc_option_type(install_prefix) = option([], "--install-prefix").
mmc_option_type(stdlib_dir) = option([], "--mercury-stdlib-dir").
mmc_option_type(config_dir) = option([], "--mercury-config-dir").
mmc_option_type(linkage) = option([], "--linkage").
mmc_option_type(mercury_linkage) = option([], "--mercury-linkage").

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

:- type variable_result(T)
    --->    var_result_set(T)
    ;       var_result_unset
    ;       var_result_error(error_spec).

:- pred lookup_options_variable(globals::in, options_variables::in,
    options_variable_class::in, options_variable_type::in,
    variable_result(list(string))::out,
    io::di, io::uo) is det.

lookup_options_variable(Globals, Vars, OptionsVariableClass, FlagsVar, Result,
        !IO) :-
    VarName = options_variable_name(FlagsVar),
    lookup_variable_words_report_error(Globals, Vars, "DEFAULT_" ++ VarName,
        DefaultFlagsResult, !IO),
    (
        OptionsVariableClass = default,
        FlagsResult = var_result_unset,
        ExtraFlagsResult = var_result_unset
    ;
        ( OptionsVariableClass = module_specific(_)
        ; OptionsVariableClass = non_module_specific
        ),
        lookup_variable_words_report_error(Globals, Vars, VarName,
            FlagsResult, !IO),
        lookup_variable_words_report_error(Globals, Vars, "EXTRA_" ++ VarName,
            ExtraFlagsResult, !IO)
    ),
    ( if
        OptionsVariableClass = module_specific(ModuleName),
        options_variable_type_is_target_specific(FlagsVar) = yes
    then
        ModuleFileNameBase = sym_name_to_string(ModuleName),
        ModuleVarName = VarName ++ "-" ++ ModuleFileNameBase,
        lookup_variable_words_report_error(Globals, Vars, ModuleVarName,
            ModuleFlagsResult, !IO)
    else
        ModuleFlagsResult = var_result_unset
    ),

    % NOTE: The order in which these lists of flags are added together is
    % important. In the resulting set the flags from DefaultFlagsResult
    % *must* occur before those in FlagsResult, which in turn *must* occur
    % before those in ExtraFlagsResult ... etc. Failing to maintain this order
    % will result in the user being unable to override the default value
    % of many of the compiler's options.

    Result0 =
        DefaultFlagsResult  `combine_var_results`
        FlagsResult         `combine_var_results`
        ExtraFlagsResult    `combine_var_results`
        ModuleFlagsResult,

    % Check the result is valid for the variable type.
    (
        Result0 = var_result_unset,
        Result = var_result_unset
    ;
        Result0 = var_result_error(E),
        Result = var_result_error(E)
    ;
        Result0 = var_result_set(V),
        ( if FlagsVar = ml_libs then
            NotLibLPrefix =
                ( pred(LibFlag::in) is semidet :-
                    not string.prefix(LibFlag, "-l")
                ),
            BadLibs = list.filter(NotLibLPrefix, V),
            (
                BadLibs = [],
                Result = Result0
            ;
                BadLibs = [_ | _],
                Pieces = [words("Error: MLLIBS must contain only"),
                    quote("-l"), words("options, found") |
                    list_to_pieces(
                        list.map(func(Lib) = add_quotes(Lib), BadLibs))]
                    ++ [suffix(".")],
                ErrorSpec = error_spec(severity_error, phase_read_files,
                    [error_msg(no, do_not_treat_as_first, 0,
                        [always(Pieces)])]),
                write_error_spec(ErrorSpec, Globals, 0, _, 0, _, !IO),
                Result = var_result_error(ErrorSpec)
            )
        else
            Result = Result0
        )
    ).

:- func combine_var_results(variable_result(list(T)), variable_result(list(T)))
    = variable_result(list(T)).

combine_var_results(var_result_unset, var_result_unset) = var_result_unset.
combine_var_results(var_result_unset, var_result_set(V)) = var_result_set(V).
combine_var_results(var_result_unset, var_result_error(E)) =
    var_result_error(E).
combine_var_results(var_result_set(V1), var_result_set(V2)) =
    var_result_set(V1 ++ V2).
combine_var_results(var_result_set(V), var_result_unset) = var_result_set(V).
combine_var_results(var_result_set(_), var_result_error(E)) =
    var_result_error(E).
combine_var_results(var_result_error(E), _) = var_result_error(E).

:- pred lookup_variable_words_report_error(globals::in, options_variables::in,
    options_variable::in, variable_result(list(string))::out,
    io::di, io::uo) is det.

lookup_variable_words_report_error(Globals, Vars, VarName, Result, !IO) :-
    lookup_variable_words(Vars, VarName, Result, !IO),
    (
        Result = var_result_error(ErrorSpec),
        write_error_spec(ErrorSpec, Globals, 0, _, 0, _, !IO)
    ;
        Result = var_result_set(_)
    ;
        Result = var_result_unset
    ).

:- pred lookup_variable_words(options_variables::in, options_variable::in,
    variable_result(list(string))::out, io::di, io::uo) is det.

lookup_variable_words(Vars, VarName, Result, !IO) :-
    lookup_variable_words_maybe_env(yes, Vars, VarName, Result, !IO).

:- pred lookup_variable_words_maybe_env(bool::in, options_variables::in,
    options_variable::in, variable_result(list(string))::out,
    io::di, io::uo) is det.

lookup_variable_words_maybe_env(LookupEnv, Vars, VarName, Result, !IO) :-
    (
        LookupEnv = yes,
        io.get_environment_var(VarName, MaybeEnvValue, !IO)
    ;
        LookupEnv = no,
        MaybeEnvValue = no
    ),
    (
        MaybeEnvValue = yes(EnvValue),
        SplitResult = checked_split_into_words(string.to_char_list(EnvValue)),
        (
            SplitResult = ok(EnvWords),
            Result = var_result_set(EnvWords)
        ;
            SplitResult = error(Msg),
            ErrorSpec = error_spec(severity_error, phase_read_files,
                [error_msg(no, do_not_treat_as_first, 0,
                    [always([words("Error: in environment variable"),
                        quote(VarName), suffix(":"), words(Msg), nl])]
                )]),
            Result = var_result_error(ErrorSpec)
        )
    ;
        MaybeEnvValue = no,
        ( if map.search(Vars, VarName, MapValue) then
            MapValue = options_variable_value(_, Words, _),
            Result = var_result_set(Words)
        else
            Result = var_result_unset
        )
    ).

:- pred lookup_variable_chars(options_variables::in, string::in,
    list(char)::out, list(string)::in, list(string)::out,
    io::di, io::uo) is det.

lookup_variable_chars(Variables, Var, Value, !Undef, !IO) :-
    io.get_environment_var(Var, MaybeValue, !IO),
    (
        MaybeValue = yes(ValueString),
        Value = string.to_char_list(ValueString)
    ;
        MaybeValue = no,
        ( if
            map.search(Variables, Var, options_variable_value(Value0, _, _))
        then
            Value = Value0
        else
            Value = [],
            !:Undef = [Var | !.Undef]
        )
    ).

%-----------------------------------------------------------------------------%
:- end_module make.options_file.
%-----------------------------------------------------------------------------%