mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-14 05:12:33 +00:00
672f77c4ec
Estimated hours taken: 20 Branches: main Add a new compiler option. --inform-ite-instead-of-switch. If this is enabled, the compiler will generate informational messages about if-then-elses that it thinks should be converted to switches for the sake of program reliability. Act on the output generated by this option. compiler/simplify.m: Implement the new option. Fix an old bug that could cause us to generate warnings about code that was OK in one duplicated copy but not in another (where a switch arm's code is duplicated due to the case being selected for more than one cons_id). compiler/options.m: Add the new option. Add a way to test for the bug fix in simplify. doc/user_guide.texi: Document the new option. NEWS: Mention the new option. library/*.m: mdbcomp/*.m: browser/*.m: compiler/*.m: deep_profiler/*.m: Convert if-then-elses to switches at most of the sites suggested by the new option. At the remaining sites, switching to switches would have nontrivial downsides. This typically happens with the switched-on type has many functors, and we treat one or two specially (e.g. cons/2 in the cons_id type). Perform misc cleanups in the vicinity of the if-then-else to switch conversions. In a few cases, improve the error messages generated. compiler/accumulator.m: compiler/hlds_goal.m: (Rename and) move insts for particular kinds of goal from accumulator.m to hlds_goal.m, to allow them to be used in other modules. Using these insts allowed us to eliminate some if-then-elses entirely. compiler/exprn_aux.m: Instead of fixing some if-then-elses, delete the predicates containing them, since they aren't used, and (as pointed out by the new option) would need considerable other fixing if they were ever needed again. compiler/lp_rational.m: Add prefixes to the names of the function symbols on some types, since without those prefixes, it was hard to figure out what type the switch corresponding to an old if-then-else was switching on. tests/invalid/reserve_tag.err_exp: Expect a new, improved error message.
1217 lines
41 KiB
Mathematica
1217 lines
41 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2002-2007 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.prim_data.
|
|
|
|
:- 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(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.
|
|
%
|
|
:- pred read_args_file(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(options_variables::in,
|
|
maybe(options_variables)::out, io::di, io::uo) is det.
|
|
|
|
% Look up the DEFAULT_MCFLAGS variable.
|
|
%
|
|
:- pred lookup_default_options(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(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(options_variables::in, module_name::in,
|
|
maybe(list(string))::out, io::di, io::uo) is det.
|
|
|
|
% Look up $(MAIN_TARGET).
|
|
%
|
|
:- pred lookup_main_target(options_variables::in, maybe(list(string))::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module libs.compiler_util.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.options.
|
|
:- import_module parse_tree.error_util.
|
|
:- import_module parse_tree.prog_io.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module bool.
|
|
:- import_module char.
|
|
:- import_module dir.
|
|
:- import_module exception.
|
|
:- import_module map.
|
|
:- import_module std_util.
|
|
:- import_module string.
|
|
:- import_module svmap.
|
|
:- 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(OptionsFile, MaybeMCFlags, !IO) :-
|
|
read_options_file(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,
|
|
globals.io_get_globals(Globals, !IO),
|
|
write_error_spec(ErrorSpec, Globals, 0, _, 0, _, !IO)
|
|
)
|
|
;
|
|
MaybeVariables = no,
|
|
MaybeMCFlags = no
|
|
).
|
|
|
|
read_options_file(OptionsFile, Variables0, MaybeVariables, !IO) :-
|
|
promise_equivalent_solutions [OptionsFileResult, !:IO] (
|
|
try_io((pred((Variables1)::out, !.IO::di, !:IO::uo) is det :-
|
|
read_options_file_params(error, no_search, no, OptionsFile,
|
|
Variables0, Variables1, !IO)
|
|
),
|
|
OptionsFileResult, !IO)
|
|
),
|
|
(
|
|
OptionsFileResult = succeeded(Variables),
|
|
MaybeVariables = yes(Variables)
|
|
;
|
|
OptionsFileResult = exception(Exception),
|
|
( Exception = univ(found_options_file_error) ->
|
|
MaybeVariables = no
|
|
;
|
|
rethrow(OptionsFileResult)
|
|
)
|
|
).
|
|
|
|
read_options_files(Variables0, MaybeVariables, !IO) :-
|
|
promise_equivalent_solutions [OptionsFileResult, !:IO] (
|
|
try_io(read_options_file_lookup_params(Variables0), OptionsFileResult,
|
|
!IO)
|
|
),
|
|
(
|
|
OptionsFileResult = succeeded(Variables),
|
|
MaybeVariables = yes(Variables)
|
|
;
|
|
OptionsFileResult = exception(Exception),
|
|
( Exception = univ(found_options_file_error) ->
|
|
MaybeVariables = no
|
|
;
|
|
rethrow(OptionsFileResult)
|
|
)
|
|
).
|
|
|
|
:- pred read_options_file_lookup_params(
|
|
options_variables::in, options_variables::out, io::di, io::uo) is det.
|
|
|
|
read_options_file_lookup_params(!Variables, !IO) :-
|
|
globals.io_lookup_accumulating_option(options_files, OptionsFiles, !IO),
|
|
list.foldl2(read_options_file_set_params, OptionsFiles, !Variables, !IO).
|
|
|
|
:- pred read_options_file_set_params(string::in,
|
|
options_variables::in, options_variables::out, io::di, io::uo) is det.
|
|
|
|
read_options_file_set_params(OptionsFile, !Vars, !IO) :-
|
|
( OptionsFile = "Mercury.options" ->
|
|
ErrorIfNotExist = no_error,
|
|
Search = no_search
|
|
;
|
|
ErrorIfNotExist = error,
|
|
Search = search
|
|
),
|
|
read_options_file_params(ErrorIfNotExist, Search, no, OptionsFile,
|
|
!Vars, !IO).
|
|
|
|
:- type error_if_not_exist
|
|
---> error
|
|
; no_error.
|
|
|
|
:- type search
|
|
---> search
|
|
; no_search.
|
|
|
|
% read_options_file_params(ErrorIfNotExist, Search, MaybeDirName,
|
|
% FileName, Variables0, Variables).
|
|
%
|
|
:- pred read_options_file_params(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(ErrorIfNotExist, Search, MaybeDirName, OptionsFile0,
|
|
!Variables, !IO) :-
|
|
( OptionsFile0 = "-" ->
|
|
% Read from standard input.
|
|
debug_msg(write_reading_options_file_stdin, !IO),
|
|
read_options_lines(dir.this_directory, !Variables, !IO),
|
|
debug_msg(write_done, !IO)
|
|
;
|
|
debug_msg(write_reading_options_file(OptionsFile0), !IO),
|
|
(
|
|
Search = search,
|
|
globals.io_lookup_accumulating_option(options_search_directories,
|
|
SearchDirs, !IO)
|
|
;
|
|
Search = no_search,
|
|
SearchDirs = [dir.this_directory]
|
|
),
|
|
( dir.split_name(OptionsFile0, OptionsDir, OptionsFile) ->
|
|
( dir.path_name_is_absolute(OptionsDir) ->
|
|
FileToFind = OptionsFile,
|
|
Dirs = [OptionsDir]
|
|
;
|
|
(
|
|
MaybeDirName = yes(DirName),
|
|
FileToFind = OptionsFile,
|
|
Dirs = [DirName/OptionsDir | SearchDirs]
|
|
;
|
|
MaybeDirName = no,
|
|
Dirs = SearchDirs,
|
|
FileToFind = OptionsFile0
|
|
)
|
|
)
|
|
;
|
|
Dirs = SearchDirs,
|
|
FileToFind = OptionsFile0
|
|
),
|
|
io.input_stream(OldInputStream, !IO),
|
|
search_for_file_returning_dir(Dirs, FileToFind, MaybeDir, !IO),
|
|
(
|
|
MaybeDir = ok(FoundDir),
|
|
debug_msg(write_reading_options_file(FoundDir/FileToFind), !IO),
|
|
|
|
read_options_lines(FoundDir, !Variables, !IO),
|
|
io.set_input_stream(OldInputStream, OptionsStream, !IO),
|
|
io.close_input(OptionsStream, !IO)
|
|
;
|
|
MaybeDir = error(_),
|
|
(
|
|
ErrorIfNotExist = error,
|
|
( Dirs = [SingleDir] ->
|
|
ErrorFile = maybe_add_path_name(SingleDir, FileToFind)
|
|
;
|
|
ErrorFile = FileToFind
|
|
),
|
|
ErrorSpec = error_spec(severity_error, phase_read_files,
|
|
[error_msg(no, no, 0,
|
|
[always([words("Error reading options file"),
|
|
quote(ErrorFile), suffix(".")])
|
|
])
|
|
]),
|
|
globals.io_get_globals(Globals, !IO),
|
|
write_error_spec(ErrorSpec, Globals, 0, _, 0, _, !IO)
|
|
;
|
|
ErrorIfNotExist = no_error
|
|
)
|
|
),
|
|
debug_msg(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) =
|
|
( Dir = dir.this_directory ->
|
|
File
|
|
;
|
|
dir.make_path_name(Dir, File)
|
|
).
|
|
|
|
:- pred read_options_lines(dir_name::in, options_variables::in,
|
|
options_variables::out, io::di, io::uo) is det.
|
|
|
|
read_options_lines(Dir, !Variables, !IO) :-
|
|
io.get_line_number(LineNumber, !IO),
|
|
promise_equivalent_solutions [LineResult, !:IO] (
|
|
read_options_lines_2(Dir, !.Variables, LineResult, !IO)
|
|
),
|
|
(
|
|
LineResult = succeeded(!:Variables - FoundEOF),
|
|
(
|
|
FoundEOF = yes
|
|
;
|
|
FoundEOF = no,
|
|
read_options_lines(Dir, !Variables, !IO)
|
|
)
|
|
;
|
|
LineResult = exception(Exception),
|
|
( Exception = univ(options_file_error(Error)) ->
|
|
io.input_stream_name(FileName, !IO),
|
|
write_error_pieces(term.context_init(FileName, LineNumber),
|
|
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'll be exiting straight
|
|
% away so that doesn't matter.
|
|
%
|
|
throw(found_options_file_error)
|
|
;
|
|
rethrow(LineResult)
|
|
)
|
|
;
|
|
LineResult = failed,
|
|
unexpected(this_file, "read_options_lines")
|
|
).
|
|
|
|
:- pred read_options_lines_2(dir_name::in, options_variables::in,
|
|
exception_result(pair(options_variables, bool))::out,
|
|
io::di, io::uo) is cc_multi.
|
|
|
|
read_options_lines_2(Dir, Variables0, Result, !IO) :-
|
|
try_io(read_options_lines_3(Dir, Variables0), Result, !IO).
|
|
|
|
:- pred read_options_lines_3(dir_name::in, options_variables::in,
|
|
pair(options_variables, bool)::out, io::di, io::uo) is det.
|
|
|
|
read_options_lines_3(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(VarName, AddToValue, Value, !Variables, !IO)
|
|
;
|
|
ParsedLine = include_options_files(ErrorIfNotExist,
|
|
IncludedFilesChars0),
|
|
expand_variables(!.Variables,
|
|
IncludedFilesChars0, IncludedFilesChars, UndefVars, !IO),
|
|
report_undefined_variables(UndefVars, !IO),
|
|
IncludedFileNames = split_into_words(IncludedFilesChars),
|
|
list.foldl2(
|
|
read_options_file_params(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),
|
|
( Char = '#' ->
|
|
skip_comment_line(FoundEOF, !IO)
|
|
; Char = ('\\') ->
|
|
read_item_or_eof(io.read_char, MaybeChar2, !IO),
|
|
(
|
|
MaybeChar2 = yes(Char2),
|
|
( Char2 = '\n' ->
|
|
!:Chars = [' ' | !.Chars]
|
|
;
|
|
!:Chars = [Char2, Char | !.Chars]
|
|
),
|
|
read_options_line_2(FoundEOF, !Chars, !IO)
|
|
;
|
|
MaybeChar2 = no,
|
|
FoundEOF = yes,
|
|
!:Chars = [Char | !.Chars]
|
|
)
|
|
; Char = '\n' ->
|
|
FoundEOF = no
|
|
;
|
|
!:Chars = [Char | !.Chars],
|
|
read_options_line_2(FoundEOF, !Chars, !IO)
|
|
)
|
|
;
|
|
MaybeChar = no,
|
|
FoundEOF = yes
|
|
).
|
|
|
|
:- pred update_variable(options_variable::in, bool::in, list(char)::in,
|
|
options_variables::in, options_variables::out, io::di, io::uo) is det.
|
|
|
|
update_variable(VarName, AddToValue, NewValue0, !Variables, !IO) :-
|
|
expand_variables(!.Variables, NewValue0, NewValue1, Undef, !IO),
|
|
report_undefined_variables(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(!.Variables, VarName, OptVarValue, !:Variables)
|
|
;
|
|
MaybeEnvValue = no,
|
|
(
|
|
map.search(!.Variables, VarName,
|
|
options_variable_value(OldValue, OldWords, Source))
|
|
->
|
|
(
|
|
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),
|
|
svmap.set(VarName, OptVarValue, !Variables)
|
|
)
|
|
;
|
|
OptVarValue = options_variable_value(NewValue1, Words1,
|
|
options_file),
|
|
svmap.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) :-
|
|
( Char = '$' ->
|
|
(
|
|
Chars = [],
|
|
throw(options_file_error("unterminated variable reference"))
|
|
;
|
|
Chars = [Char2 | Chars1],
|
|
( Char2 = '$' ->
|
|
!:RevChars = ['$' | !.RevChars],
|
|
expand_variables_2(Variables, Chars1, !RevChars, !RevUndef,
|
|
!IO)
|
|
;
|
|
(
|
|
(
|
|
Char2 = '(',
|
|
EndChar = ')'
|
|
;
|
|
Char2 = '{',
|
|
EndChar = '}'
|
|
)
|
|
->
|
|
parse_variable(VarName0, Chars1, Chars2),
|
|
( Chars2 = [EndChar | Chars3] ->
|
|
Chars4 = Chars3,
|
|
VarName = VarName0
|
|
;
|
|
throw(options_file_error(
|
|
"unterminated variable reference"))
|
|
)
|
|
;
|
|
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)
|
|
)
|
|
)
|
|
;
|
|
!:RevChars = [Char | !.RevChars],
|
|
expand_variables_2(Variables, Chars, !RevChars, !RevUndef, !IO)
|
|
).
|
|
|
|
:- pred report_undefined_variables(list(string)::in, io::di, io::uo) is det.
|
|
|
|
report_undefined_variables(Vars, !IO) :-
|
|
report_undefined_variables_2(list.sort_and_remove_dups(Vars), !IO).
|
|
|
|
:- pred report_undefined_variables_2(list(string)::in, io::di, io::uo) is det.
|
|
|
|
report_undefined_variables_2([], !IO).
|
|
report_undefined_variables_2([_ | Rest] @ UndefVars, !IO) :-
|
|
globals.io_lookup_bool_option(warn_undefined_options_variables, Warn,
|
|
!IO),
|
|
(
|
|
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(Context, 0, Pieces, !IO),
|
|
|
|
globals.io_lookup_bool_option(halt_at_warn, Halt, !IO),
|
|
(
|
|
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) :-
|
|
(
|
|
( Line0 = [('-') | Line1] ->
|
|
ErrorIfNotExist = no_error,
|
|
Line2 = Line1
|
|
;
|
|
ErrorIfNotExist = error,
|
|
Line2 = Line0
|
|
),
|
|
list.append(string.to_char_list("include"), Line3, Line2)
|
|
->
|
|
list.takewhile(char.is_whitespace, Line3, _, Line4),
|
|
OptionsFileLine = include_options_files(ErrorIfNotExist, Line4)
|
|
;
|
|
parse_variable(VarName, Line0, Line1),
|
|
list.takewhile(char.is_whitespace, Line1, _, Line2),
|
|
( Line2 = [('=') | Line3] ->
|
|
Add = no,
|
|
Line4 = Line3
|
|
; Line2 = [('+'), ('=') | Line3] ->
|
|
Add = yes,
|
|
Line4 = Line3
|
|
; Line2 = [(':'), ('=') | Line3] ->
|
|
Add = no,
|
|
Line4 = Line3
|
|
;
|
|
throw(options_file_error(
|
|
"expected `=', `:=' or `+=' after `" ++ VarName ++ "'"))
|
|
),
|
|
list.takewhile(char.is_whitespace, Line4, _, VarValue),
|
|
OptionsFileLine = define_variable(VarName, Add, VarValue)
|
|
).
|
|
|
|
:- pred parse_file_name(file_name::out,
|
|
list(char)::in, list(char)::out) is det.
|
|
|
|
parse_file_name(FileName, Chars0, Chars) :-
|
|
( Chars0 = ['"' | Chars1] ->
|
|
parse_string(FileName, Chars1, Chars)
|
|
;
|
|
list.takewhile(isnt(char.is_whitespace), Chars0,
|
|
FileNameChars, Chars),
|
|
FileName = string.from_char_list(FileNameChars)
|
|
).
|
|
|
|
:- 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),
|
|
( VarName = "" ->
|
|
list.takewhile(isnt(char.is_whitespace), Chars, FirstWord, _),
|
|
throw(options_file_error("expected variable at `" ++
|
|
string.from_char_list(FirstWord) ++ "'"))
|
|
;
|
|
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) :-
|
|
(
|
|
\+ char.is_whitespace(Char),
|
|
(
|
|
IsFirst = yes,
|
|
char.is_alpha(Char)
|
|
;
|
|
IsFirst = no,
|
|
( char.is_alnum_or_underscore(Char)
|
|
; Char = ('-')
|
|
; Char = ('.')
|
|
)
|
|
)
|
|
->
|
|
parse_variable_2(no, [Char | Var0], Var, Chars0, Chars)
|
|
;
|
|
Var = Var0,
|
|
Chars = [Char | Chars0]
|
|
).
|
|
|
|
:- pred parse_string(string::out, list(char)::in, list(char)::out) is det.
|
|
|
|
parse_string(String, Chars0, Chars) :-
|
|
parse_string_chars([], StringChars, Chars0, Chars),
|
|
String = string.from_rev_char_list(StringChars).
|
|
|
|
:- 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) :-
|
|
( Char = '"' ->
|
|
Chars = Chars0,
|
|
String = String0
|
|
; Char = ('\\') ->
|
|
(
|
|
Chars0 = [Char2 | Chars1],
|
|
( Char2 = '"' ->
|
|
String1 = [Char2 | String0]
|
|
;
|
|
String1 = [Char2, Char | String0]
|
|
),
|
|
parse_string_chars(String1, String, Chars1, Chars)
|
|
;
|
|
Chars0 = [],
|
|
throw(options_file_error("unterminated string"))
|
|
)
|
|
;
|
|
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),
|
|
( Char = '\n' ->
|
|
FoundEOF = no
|
|
;
|
|
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),
|
|
( Exception = univ(options_file_error(Msg)) ->
|
|
Result = error(Msg)
|
|
;
|
|
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, Words0) = Words :-
|
|
list.takewhile(char.is_whitespace, Chars0, _, Chars1),
|
|
(
|
|
Chars1 = [],
|
|
Words = Words0
|
|
;
|
|
Chars1 = [_ | _],
|
|
get_word(Word, Chars1, Chars),
|
|
Words = split_into_words_2(Chars, [Word | Words0])
|
|
).
|
|
|
|
:- pred get_word(string::out, list(char)::in, list(char)::out) is det.
|
|
|
|
get_word(string.from_rev_char_list(RevWord), Chars0, Chars) :-
|
|
get_word_2([], RevWord, Chars0, Chars).
|
|
|
|
:- 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) :-
|
|
( char.is_whitespace(Char) ->
|
|
Chars = Chars0,
|
|
RevWord = RevWord0
|
|
; Char = '"' ->
|
|
parse_string_chars([], RevStringChars, Chars0, Chars1),
|
|
get_word_2(RevStringChars ++ RevWord0, RevWord, Chars1, Chars)
|
|
; Char = ('\\') ->
|
|
(
|
|
Chars0 = [],
|
|
RevWord = [Char | RevWord0],
|
|
Chars = []
|
|
;
|
|
Chars0 = [Char2 | Chars1],
|
|
(
|
|
( Char2 = '"'
|
|
; Char2 = ('\\')
|
|
)
|
|
->
|
|
get_word_2([Char2 | RevWord0], RevWord, Chars1, Chars)
|
|
;
|
|
get_word_2([Char2, Char | RevWord0], RevWord, Chars1, Chars)
|
|
)
|
|
)
|
|
;
|
|
get_word_2([Char | RevWord0], RevWord, Chars0, Chars)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
lookup_main_target(Vars, MaybeMainTarget, !IO) :-
|
|
lookup_variable_words_report_error(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_default_options(Vars, Result, !IO) :-
|
|
lookup_mmc_maybe_module_options(Vars, default, Result, !IO).
|
|
|
|
lookup_mmc_options(Vars, Result, !IO) :-
|
|
lookup_mmc_maybe_module_options(Vars, non_module_specific, Result, !IO).
|
|
|
|
lookup_mmc_module_options(Vars, ModuleName, Result, !IO) :-
|
|
lookup_mmc_maybe_module_options(Vars, module_specific(ModuleName), Result,
|
|
!IO).
|
|
|
|
:- pred lookup_mmc_maybe_module_options(options_variables::in,
|
|
options_variable_class::in, maybe(list(string))::out, io::di, io::uo)
|
|
is det.
|
|
|
|
lookup_mmc_maybe_module_options(Vars, MaybeModuleName, Result, !IO) :-
|
|
VariableTypes = options_variable_types,
|
|
list.map_foldl(lookup_options_variable(Vars, MaybeModuleName),
|
|
VariableTypes, Results, !IO),
|
|
(
|
|
list.map(
|
|
(pred(VarResult::in, MaybeValue::out) is semidet :-
|
|
(
|
|
VarResult = var_result_set(Value),
|
|
MaybeValue = yes(Value)
|
|
;
|
|
VarResult = var_result_unset,
|
|
MaybeValue = no
|
|
)
|
|
), Results, Values)
|
|
->
|
|
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))])
|
|
;
|
|
Result = no
|
|
).
|
|
|
|
:- type options_variable_class
|
|
---> default
|
|
; non_module_specific
|
|
; module_specific(module_name).
|
|
|
|
:- type options_variable_type
|
|
---> grade_flags
|
|
; mmc_flags
|
|
; c_flags
|
|
; java_flags
|
|
; ilasm_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).
|
|
|
|
% `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.
|
|
options_variable_types =
|
|
[grade_flags, linkage, mercury_linkage, lib_grades, lib_linkages,
|
|
stdlib_dir, config_dir, mmc_flags, c_flags, java_flags, ilasm_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(java_flags) = "JAVACFLAGS".
|
|
options_variable_name(ilasm_flags) = "MS_ILASM_FLAGS".
|
|
options_variable_name(csharp_flags) = "MS_CSC_FLAGS".
|
|
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(java_flags) = yes.
|
|
options_variable_type_is_target_specific(ilasm_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(java_flags) = option([], "--java-flag").
|
|
mmc_option_type(ilasm_flags) = option([], "--ilasm-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(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(Vars, OptionsVariableClass, FlagsVar, Result, !IO) :-
|
|
VarName = options_variable_name(FlagsVar),
|
|
lookup_variable_words_report_error(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(Vars, VarName, FlagsResult, !IO),
|
|
lookup_variable_words_report_error(Vars, "EXTRA_" ++ VarName,
|
|
ExtraFlagsResult, !IO)
|
|
),
|
|
(
|
|
OptionsVariableClass = module_specific(ModuleName),
|
|
options_variable_type_is_target_specific(FlagsVar) = yes
|
|
->
|
|
ModuleFileNameBase = sym_name_to_string(ModuleName),
|
|
ModuleVarName = VarName ++ "-" ++ ModuleFileNameBase,
|
|
lookup_variable_words_report_error(Vars, ModuleVarName,
|
|
ModuleFlagsResult, !IO)
|
|
;
|
|
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),
|
|
( FlagsVar = ml_libs ->
|
|
NotLibLPrefix =
|
|
(pred(LibFlag::in) is semidet :-
|
|
\+ string.prefix(LibFlag, "-l")
|
|
),
|
|
BadLibs = list.filter(NotLibLPrefix, V),
|
|
(
|
|
BadLibs = [],
|
|
Result = Result0
|
|
;
|
|
BadLibs = [_ | _],
|
|
Pieces = [words("Error: MLLIBS must contain only"),
|
|
words("`-l' 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, no, 0, [always(Pieces)])]),
|
|
globals.io_get_globals(Globals, !IO),
|
|
write_error_spec(ErrorSpec, Globals, 0, _, 0, _, !IO),
|
|
Result = var_result_error(ErrorSpec)
|
|
)
|
|
;
|
|
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(options_variables::in,
|
|
options_variable::in, variable_result(list(string))::out,
|
|
io::di, io::uo) is det.
|
|
|
|
lookup_variable_words_report_error(Vars, VarName, Result, !IO) :-
|
|
lookup_variable_words(Vars, VarName, Result, !IO),
|
|
(
|
|
Result = var_result_error(ErrorSpec),
|
|
globals.io_get_globals(Globals, !IO),
|
|
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, no, 0,
|
|
[always([words("Error: in environment variable"),
|
|
quote(VarName), suffix(":"), words(Msg)
|
|
])]
|
|
)]),
|
|
Result = var_result_error(ErrorSpec)
|
|
)
|
|
;
|
|
MaybeEnvValue = no,
|
|
( map.search(Vars, VarName, MapValue) ->
|
|
MapValue = options_variable_value(_, Words, _),
|
|
Result = var_result_set(Words)
|
|
;
|
|
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,
|
|
( map.search(Variables, Var, options_variable_value(Value0, _, _)) ->
|
|
Value = Value0
|
|
;
|
|
Value = [],
|
|
!:Undef = [Var | !.Undef]
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "options_file.m.".
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module options_file.
|
|
%-----------------------------------------------------------------------------%
|