mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 09:53:36 +00:00
191eb9eb64
scripts/Mmake.rules:
Add a rule for the pattern target %.depend_ints which invokes mmc
with --generate-dependencies-ints, just as %.depend invokes mmc
with --generate-dependencies.
Document the reason why this addition requires yet more code duplication.
scripts/Mmake.vars.in:
Add the make variable definitions needed by the new code in Mmake.rules.
compiler/mercury_compile_main.m:
Make it practical to use --generate-dependencies-ints in a multi-directory
project like the Mercury implementation, in which some directories
may use --generate-dependencies-ints as the target of "mmake depend",
while other directories, which come earlier in the build process,
still do "mmake depend" using just --generate-dependencies.
In such cases, mmc --generate-dependencies-ints in the later directory
may fail to generate .int0, .int or .int2 files simply because
the .int3 file of a module they import (from an earlier directory
in which "mmake depend" uses just --generate-dependencies) hasn't been
made yet. (This is what would happen if someone executed "mmake depend"
at the top level in a freshly checked out workspace.)
The practical fix is to simply report this fix using an error message
that still allows the compiler to exit with an exit status that
indicates success.
Most of the rest of this diff is there to make this possible.
compiler/error_spec.m:
Add a new phase, phase_find_files, that specifically indicates
that we couldn't read a file because we couldn't find it.
Give it a string argument naming the file, to allow mercury_compile_main.m
to replace several error_specs that each report not being able to find
one file with a single error_spec that reports not being able to find
many files.
Add a utility function for use by mercury_compile_main.m to construct
that error message.
Add another new phase, phase_make_int, that indicates a problem
we discovered in the code of a Mercury source file while trying
to decide what should got into one of the that module's interface files.
compiler/parse_error.m:
Here also use separate function symbols in the fatal_module_read_error
type for the situations "couldn't find a file" and "couldn't read a file".
Update the predicates constructing error_specs to handle this distinction
(which the callers make using the new function symbol in the above type).
compiler/compile_target_code.m:
compiler/error_util.m:
compiler/grab_modules.m:
compiler/options_file.m:
compiler/parse_module.m:
compiler/read_modules.m:
compiler/recompilation.check.m:
compiler/write_module_interface_files.m:
Conform to the changes above.
compiler/options.m:
Add a way to detect the presence of this diff in an installed compiler.
1678 lines
65 KiB
Mathematica
1678 lines
65 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2002-2011 The University of Melbourne.
|
|
% Copyright (C) 2013-2022 The Mercury team.
|
|
% 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 libs.
|
|
:- import_module libs.file_util.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.error_spec.
|
|
:- import_module parse_tree.maybe_error.
|
|
|
|
:- import_module io.
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type options_variables.
|
|
|
|
:- func options_variables_init(environment_var_map) = options_variables.
|
|
|
|
% read_options_files_named_in_options_file_option(ProgressStream,
|
|
% OptionSearchDirs, OptionsFiles, Variables, Specs, UndefSpecs, !IO):
|
|
%
|
|
% Given OptionSearchDirs, the value of the options_search_directories
|
|
% option, and OptionsFiles, the value of the options_files option,
|
|
% look up and read all the files named in OptionsFiles in OptionSearchDirs.
|
|
% Construct a database of variable name/value pairs from the make variable
|
|
% assignments in those files (and the other files they may include, either
|
|
% directly or indirectly) and return it as Variables.
|
|
%
|
|
% We return two lists of error specs. The first list consists of errors,
|
|
% which should be printed unconditionally. The second list consists
|
|
% of warnings, which should be printed only if the option
|
|
% warn_undefined_options_variables is set.
|
|
%
|
|
:- pred read_options_files_named_in_options_file_option(
|
|
io.text_output_stream::in, list(string)::in,
|
|
list(string)::in, options_variables::out,
|
|
list(error_spec)::out, list(error_spec)::out, io::di, io::uo) is det.
|
|
|
|
% read_named_options_file(ProgressStream, OptionsPathName, !Variables,
|
|
% Specs, UndefSpecs, !IO) :-
|
|
%
|
|
% Read the given options file, without searching
|
|
% --options-search-directories, updating the database of make variable
|
|
% name/value pairs. This is used to read the configuration file.
|
|
%
|
|
% We return two lists of error specs. The first list consists of errors,
|
|
% which should be printed unconditionally. The second list consists
|
|
% of warnings, which should be printed only if the option
|
|
% warn_undefined_options_variables is set.
|
|
%
|
|
:- pred read_named_options_file(io.text_output_stream::in, file_name::in,
|
|
options_variables::in, options_variables::out,
|
|
list(error_spec)::out, list(error_spec)::out, io::di, io::uo) is det.
|
|
|
|
% read_args_file(ProgressStream, OptionsFile, MaybeMCFlags,
|
|
% Specs, UndefSpecs, !IO):
|
|
%
|
|
% 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.
|
|
%
|
|
% We return two lists of error specs. The first list consists of errors,
|
|
% which should be printed unconditionally. The second list consists
|
|
% of warnings, which should be printed only if the option
|
|
% warn_undefined_options_variables is set.
|
|
% XXX But see the comments near the only call to this predicate
|
|
% in mercury_compile_main.m.
|
|
%
|
|
:- pred read_args_file(io.text_output_stream::in, file_name::in,
|
|
maybe(list(string))::out, list(error_spec)::out, list(error_spec)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% If any of the following predicates return error1(Specs), Specs will
|
|
% contain only errors, not warnings. (There is only one piece of code
|
|
% in this module that generates an error_spec with severity_warning,
|
|
% and the only exported operations whose call tree includes that code
|
|
% are ones listed *above*.)
|
|
%
|
|
|
|
% Look up $(MAIN_TARGET).
|
|
%
|
|
:- pred lookup_main_target(options_variables::in,
|
|
maybe1(list(string))::out) is det.
|
|
|
|
% Look up $(MERCURY_STDLIB_DIR).
|
|
%
|
|
:- pred lookup_mercury_stdlib_dir(options_variables::in,
|
|
maybe1(list(string))::out) is det.
|
|
|
|
% Look up the DEFAULT_MCFLAGS variable.
|
|
%
|
|
:- pred lookup_default_options(options_variables::in,
|
|
maybe1(list(string))::out) is det.
|
|
|
|
% Look up all the non-module specific options.
|
|
%
|
|
:- pred lookup_mmc_options(options_variables::in,
|
|
maybe1(list(string))::out) 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,
|
|
maybe1(list(string))::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% dump_options_file(ErrorStream, FileName, Vars, !IO):
|
|
%
|
|
% Write out the given database given by Vars to a file named FileName,
|
|
% for testing the functionality of code that builds such databases.
|
|
% Report any inability to open FileName to ErrorStream.
|
|
%
|
|
:- pred dump_options_file(io.text_output_stream::in, file_name::in,
|
|
options_variables::in, io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module parse_tree.find_module.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module bool.
|
|
:- import_module char.
|
|
:- import_module dir.
|
|
:- import_module int.
|
|
:- import_module io.environment.
|
|
:- import_module map.
|
|
:- import_module one_or_more.
|
|
:- import_module pair.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
:- import_module term_context.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type options_variable == string.
|
|
|
|
:- type options_file_error
|
|
---> options_file_error(string).
|
|
|
|
:- type found_options_file_error
|
|
---> found_options_file_error.
|
|
|
|
:- type options_variable_value
|
|
---> options_variable_value(
|
|
list(char), % The variable's value.
|
|
list(string), % The variable's value split into words.
|
|
variable_source
|
|
).
|
|
|
|
:- type variable_source
|
|
---> options_file
|
|
; command_line
|
|
; environment.
|
|
|
|
:- type options_variables
|
|
---> options_variables(
|
|
ov_opts :: map(options_variable, options_variable_value),
|
|
ov_env :: map(options_variable, string)
|
|
).
|
|
|
|
options_variables_init(EnvVarMap) = Variables :-
|
|
map.init(OptsMap),
|
|
Variables = options_variables(OptsMap, EnvVarMap).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
read_options_files_named_in_options_file_option(ProgressStream,
|
|
OptionSearchDirs, OptionsFiles, Variables, Specs, UndefSpecs, !IO) :-
|
|
io.environment.get_environment_var_map(EnvVarMap, !IO),
|
|
Variables0 = options_variables_init(EnvVarMap),
|
|
list.foldl5(
|
|
read_options_file_set_params(ProgressStream, OptionSearchDirs),
|
|
OptionsFiles, Variables0, Variables,
|
|
[], IOSpecs, [], ParseSpecs, [], UndefSpecs, !IO),
|
|
Specs = IOSpecs ++ ParseSpecs.
|
|
|
|
:- pred read_options_file_set_params(io.text_output_stream::in,
|
|
list(string)::in, string::in,
|
|
options_variables::in, options_variables::out,
|
|
list(error_spec)::in, list(error_spec)::out,
|
|
list(error_spec)::in, list(error_spec)::out,
|
|
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
|
|
|
|
read_options_file_set_params(ProgressStream, OptionSearchDirs, OptionsFile,
|
|
!Variables, !IOSpecs, !ParseSpecs, !UndefSpecs, !IO) :-
|
|
MaybeDirName = no,
|
|
( if OptionsFile = "Mercury.options" then
|
|
MaybeSearch = no_search,
|
|
IsOptionsFileOptional = options_file_need_not_exist
|
|
else
|
|
MaybeSearch = search(OptionSearchDirs),
|
|
IsOptionsFileOptional = options_file_must_exist
|
|
),
|
|
SearchInfo = search_info(ProgressStream, MaybeDirName, MaybeSearch),
|
|
read_options_file_params(SearchInfo, pre_stack_base, IsOptionsFileOptional,
|
|
OptionsFile, !Variables, !IOSpecs, !ParseSpecs, !UndefSpecs, !IO).
|
|
|
|
%---------------------%
|
|
|
|
read_named_options_file(ProgressStream, OptionsPathName,
|
|
!Variables, Specs, UndefSpecs, !IO) :-
|
|
SearchInfo = search_info(ProgressStream, no, no_search),
|
|
read_options_file_params(SearchInfo, pre_stack_base,
|
|
options_file_must_exist, OptionsPathName, !Variables,
|
|
[], IOSpecs, [], ParseSpecs, [], UndefSpecs, !IO),
|
|
Specs = IOSpecs ++ ParseSpecs.
|
|
|
|
%---------------------%
|
|
|
|
read_args_file(ProgressStream, OptionsFile, MaybeMCFlags,
|
|
Specs, UndefSpecs, !IO) :-
|
|
io.environment.get_environment_var_map(EnvVarMap, !IO),
|
|
Variables0 = options_variables_init(EnvVarMap),
|
|
read_named_options_file(ProgressStream, OptionsFile, Variables0, Variables,
|
|
Specs0, UndefSpecs, !IO),
|
|
% Ignore settings in the environment -- the parent mmc process
|
|
% will have included those in the file.
|
|
NoEnvVariables = Variables ^ ov_env := map.init,
|
|
lookup_variable_words(NoEnvVariables, "MCFLAGS", FlagsResult),
|
|
(
|
|
FlagsResult = var_result_set(MCFlags),
|
|
MaybeMCFlags = yes(MCFlags),
|
|
Specs = Specs0
|
|
;
|
|
FlagsResult = var_result_unset,
|
|
MaybeMCFlags = no,
|
|
( if Specs0 = [], UndefSpecs = [] then
|
|
Pieces = [words("mercury_compile: internal error:"),
|
|
words("arguments file does not set MCFLAGS."), nl],
|
|
Spec = simplest_no_context_spec($pred, severity_error,
|
|
phase_read_files, Pieces),
|
|
Specs = [Spec | Specs0]
|
|
else
|
|
% Any of the errors in Specs or UndefSpecs could be the reason
|
|
% why we missed a setting of MCFLAGS, so we don't know that
|
|
% an internal error exists.
|
|
Specs = Specs0
|
|
)
|
|
;
|
|
FlagsResult = var_result_error(OoMErrorSpecs),
|
|
MaybeMCFlags = no,
|
|
VarResultSpecs = one_or_more_to_list(OoMErrorSpecs),
|
|
Specs = VarResultSpecs ++ Specs0
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type search
|
|
---> search(list(dir_name))
|
|
% This should be the value of options_search_directories.
|
|
; no_search.
|
|
|
|
:- type search_info
|
|
---> search_info(
|
|
si_progress_stream :: io.text_output_stream,
|
|
si_maybe_dir_name :: maybe(dir_name),
|
|
si_search :: search
|
|
).
|
|
|
|
:- type is_options_file_optional
|
|
---> options_file_need_not_exist
|
|
; options_file_must_exist.
|
|
|
|
% The inclusion stack records, for the options file being processed,
|
|
% which other options files, if any, contained the include directives
|
|
% that lead to it being read. We use it to detect circular inclusions.
|
|
:- type incl_stack
|
|
---> incl_stack_base(
|
|
% The file named here is either read automatically by
|
|
% the compiler (e.g. Mercury.options) or its reading
|
|
% was requested by the user via an --options-file
|
|
% compiler option.
|
|
file_name
|
|
)
|
|
; incl_stack_nested(
|
|
% We read the file named here in response to an "include"
|
|
% directive.
|
|
file_name,
|
|
|
|
% The context of that include directive.
|
|
term_context,
|
|
|
|
% The "provenance" of the file that contains that include
|
|
% directive.
|
|
incl_stack
|
|
).
|
|
|
|
% The pre_incl_stack is a version of the incl_stack *before* file_util.m
|
|
% finds the full pathname of a possibly-searched-for options file for us.
|
|
:- type pre_incl_stack
|
|
---> pre_stack_base
|
|
; pre_stack_nested(term_context, incl_stack).
|
|
|
|
:- pred read_options_file_params(search_info::in,
|
|
pre_incl_stack::in, is_options_file_optional::in,
|
|
string::in, options_variables::in, options_variables::out,
|
|
list(error_spec)::in, list(error_spec)::out,
|
|
list(error_spec)::in, list(error_spec)::out,
|
|
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
|
|
|
|
read_options_file_params(SearchInfo, PreStack0, IsOptionsFileOptional,
|
|
OptionsPathName, !Variables,
|
|
!IOSpecs, !ParseSpecs, !UndefSpecs, !IO) :-
|
|
SearchInfo = search_info(ProgressStream, MaybeDirName, Search),
|
|
% Reading the options file is an activity that is not specific
|
|
% to any module, so it cannot go to a module-specific debug output file.
|
|
% This is why we direct any debugging output we generate to ProgressStream,
|
|
% which is a non-module-specific destination.
|
|
( if OptionsPathName = "-" then
|
|
check_include_for_infinite_recursion(PreStack0, "-", CheckResult),
|
|
(
|
|
CheckResult = include_ok(InclStack0),
|
|
% Read from standard input.
|
|
trace [compiletime(flag("options_file_debug")), io(!TIO)] (
|
|
io.write_string(ProgressStream,
|
|
"Reading options file from stdin... ", !TIO)
|
|
),
|
|
SubSearchInfo =
|
|
SearchInfo ^ si_maybe_dir_name := yes(dir.this_directory),
|
|
read_options_lines(SubSearchInfo, InclStack0,
|
|
io.stdin_stream, "stdin", 1, !Variables,
|
|
!IOSpecs, !ParseSpecs, !UndefSpecs, !IO),
|
|
trace [compiletime(flag("options_file_debug")), io(!TIO)] (
|
|
io.format(ProgressStream, "done.\n", [], !TIO)
|
|
),
|
|
trace [compiletime(flag("options_file_debug_stdin")), io(!TIO)] (
|
|
dump_options_file(ProgressStream, "DUMP_OPTIONS_FILE",
|
|
!.Variables, !TIO)
|
|
)
|
|
;
|
|
CheckResult = include_error(CheckSpec),
|
|
!:ParseSpecs = [CheckSpec | !.ParseSpecs]
|
|
)
|
|
else
|
|
trace [compiletime(flag("options_file_debug")), io(!TIO)] (
|
|
io.format(ProgressStream, "Searching for options file %s... ",
|
|
[s(OptionsPathName)], !TIO)
|
|
),
|
|
(
|
|
Search = search(SearchDirs)
|
|
;
|
|
Search = no_search,
|
|
SearchDirs = [dir.this_directory]
|
|
),
|
|
% XXX There are four distinct paths through this if-then-else.
|
|
% The first, second and fourth of these set FileToFind to a file name
|
|
% that has no dir name component (the first and second because
|
|
% dir.split_name has removed the dir name component, the fourth
|
|
% because dir.split_name has not found any split name component.
|
|
% So why in hell does the third path set FileToFind to a file name
|
|
% that is *known* to have a directory name component?
|
|
% In the original form of this code, the OptionsPathName variable
|
|
% had its original name, OptionsFile0, so it *could* have been
|
|
% a typo, but if so, why hasn't it been caught?
|
|
( if dir.split_name(OptionsPathName, OptionsDir, OptionsFile) then
|
|
( if dir.path_name_is_absolute(OptionsDir) then
|
|
% In this case, the "search" below won't really be a search,
|
|
% but since absolute path names occur rarely, restructuring
|
|
% this code to avoid that "search" is not worthwhile.
|
|
FileToFind = OptionsFile,
|
|
Dirs = [OptionsDir]
|
|
else
|
|
(
|
|
MaybeDirName = yes(DirName),
|
|
Dirs = [DirName/OptionsDir | SearchDirs],
|
|
FileToFind = OptionsFile
|
|
;
|
|
MaybeDirName = no,
|
|
Dirs = SearchDirs,
|
|
FileToFind = OptionsPathName
|
|
)
|
|
)
|
|
else
|
|
Dirs = SearchDirs,
|
|
FileToFind = OptionsPathName
|
|
),
|
|
search_for_file_returning_dir_and_stream(Dirs, FileToFind,
|
|
MaybeDirAndStream, !IO),
|
|
(
|
|
MaybeDirAndStream =
|
|
ok(path_name_and_stream(FoundDir, FoundStream)),
|
|
trace [compiletime(flag("options_file_debug")), io(!TIO)] (
|
|
io.format(ProgressStream, "done.\n", [], !TIO)
|
|
),
|
|
check_include_for_infinite_recursion(PreStack0,
|
|
FoundDir / FileToFind, CheckResult),
|
|
(
|
|
CheckResult = include_ok(InclStack0),
|
|
trace [compiletime(flag("options_file_debug")), io(!TIO)] (
|
|
io.format(ProgressStream, "Reading options file %s... ",
|
|
[s(FoundDir/FileToFind)], !TIO)
|
|
),
|
|
|
|
SubSearchInfo =
|
|
SearchInfo ^ si_maybe_dir_name := yes(FoundDir),
|
|
read_options_lines(SubSearchInfo, InclStack0,
|
|
FoundStream, FileToFind, 1, !Variables,
|
|
!IOSpecs, !ParseSpecs, !UndefSpecs, !IO),
|
|
trace [compiletime(flag("options_file_debug")), io(!TIO)] (
|
|
io.format(ProgressStream, "done.\n", [], !TIO)
|
|
)
|
|
;
|
|
CheckResult = include_error(CheckSpec),
|
|
!:ParseSpecs = [CheckSpec | !.ParseSpecs]
|
|
),
|
|
io.close_input(FoundStream, !IO)
|
|
;
|
|
MaybeDirAndStream = error(Error),
|
|
trace [compiletime(flag("options_file_debug")), io(!TIO)] (
|
|
io.format(ProgressStream, "unsuccessful.\n", [], !TIO)
|
|
),
|
|
(
|
|
IsOptionsFileOptional = options_file_must_exist,
|
|
( if Dirs = [SingleDir] then
|
|
( if SingleDir = dir.this_directory then
|
|
ErrorFile = FileToFind
|
|
else
|
|
ErrorFile = dir.make_path_name(SingleDir, FileToFind)
|
|
)
|
|
else
|
|
ErrorFile = FileToFind
|
|
),
|
|
(
|
|
PreStack0 = pre_stack_base,
|
|
MaybeContext = no
|
|
;
|
|
PreStack0 = pre_stack_nested(Context, _),
|
|
MaybeContext = yes(Context)
|
|
),
|
|
Pieces = [words("Cannot open options file"),
|
|
quote(ErrorFile), suffix(":"),
|
|
words(Error), suffix("."), nl],
|
|
Spec = error_spec($pred, severity_error,
|
|
phase_find_files(ErrorFile),
|
|
[error_msg(MaybeContext, always_treat_as_first, 0,
|
|
[always(Pieces)])]),
|
|
!:IOSpecs = [Spec | !.IOSpecs]
|
|
;
|
|
IsOptionsFileOptional = options_file_need_not_exist
|
|
)
|
|
)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- type include_check_result
|
|
---> include_ok(incl_stack)
|
|
; include_error(error_spec).
|
|
|
|
:- pred check_include_for_infinite_recursion(pre_incl_stack::in,
|
|
file_name::in, include_check_result::out) is det.
|
|
|
|
check_include_for_infinite_recursion(PreStack0, PathName, Result) :-
|
|
(
|
|
PreStack0 = pre_stack_base,
|
|
InclStack = incl_stack_base(PathName),
|
|
Result = include_ok(InclStack)
|
|
;
|
|
PreStack0 = pre_stack_nested(Context, InclStack0),
|
|
( if
|
|
pathname_occurs_in_incl_stack(InclStack0, PathName, Context, Spec)
|
|
then
|
|
Result = include_error(Spec)
|
|
else
|
|
InclStack = incl_stack_nested(PathName, Context, InclStack0),
|
|
Result = include_ok(InclStack)
|
|
)
|
|
).
|
|
|
|
:- pred pathname_occurs_in_incl_stack(incl_stack::in, file_name::in,
|
|
term_context::in, error_spec::out) is semidet.
|
|
|
|
pathname_occurs_in_incl_stack(InclStack0, PathName, Context, Spec) :-
|
|
(
|
|
InclStack0 = incl_stack_base(StackPathName0),
|
|
( if PathName = StackPathName0 then
|
|
Pieces = [words("Error: options file"), quote(PathName),
|
|
words("includes itself."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_read_files,
|
|
Context, Pieces)
|
|
else
|
|
fail
|
|
)
|
|
;
|
|
InclStack0 = incl_stack_nested(StackPathName0, Context0, InclStack1),
|
|
( if PathName = StackPathName0 then
|
|
Pieces = [words("Error: options file"), quote(PathName),
|
|
words("includes itself."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_read_files,
|
|
Context, Pieces)
|
|
else
|
|
( if
|
|
pathname_occurs_in_incl_stack_2(InclStack1, PathName,
|
|
[StackPathName0 - Context0], TopDownIncludes)
|
|
then
|
|
TopPathName - TopContext = list.det_head(TopDownIncludes),
|
|
MainPieces = [words("Error: options file"), quote(TopPathName),
|
|
words("indirectly includes itself through"),
|
|
words("the following chain of include directives."), nl],
|
|
MainMsg = simplest_msg(TopContext, MainPieces),
|
|
InclMsgs = list.map(include_context_msg, TopDownIncludes),
|
|
LastMsg = include_context_msg(PathName - Context),
|
|
Spec = error_spec($pred, severity_error, phase_read_files,
|
|
[MainMsg | InclMsgs] ++ [LastMsg])
|
|
else
|
|
fail
|
|
)
|
|
)
|
|
).
|
|
|
|
:- pred pathname_occurs_in_incl_stack_2(incl_stack::in, file_name::in,
|
|
assoc_list(file_name, term_context)::in,
|
|
assoc_list(file_name, term_context)::out) is semidet.
|
|
|
|
pathname_occurs_in_incl_stack_2(InclStack0, PathName, !TopDownIncludes) :-
|
|
(
|
|
InclStack0 = incl_stack_base(StackPathName0),
|
|
PathName = StackPathName0
|
|
;
|
|
InclStack0 = incl_stack_nested(StackPathName0, Context0, InclStack1),
|
|
!:TopDownIncludes = [StackPathName0 - Context0 | !.TopDownIncludes],
|
|
( if PathName = StackPathName0 then
|
|
true
|
|
else
|
|
pathname_occurs_in_incl_stack_2(InclStack1, PathName,
|
|
!TopDownIncludes)
|
|
)
|
|
).
|
|
|
|
:- func include_context_msg(pair(file_name, term_context)) = error_msg.
|
|
|
|
include_context_msg(FileName - Context) = Msg :-
|
|
Pieces = [words("The include directive for"), quote(FileName),
|
|
words("here."), nl],
|
|
Msg = simplest_msg(Context, Pieces).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type maybe_is_first
|
|
---> is_not_first
|
|
; is_first.
|
|
|
|
:- type parse_result(T)
|
|
---> pr_ok(T)
|
|
; pr_eof
|
|
; pr_error(error_spec).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred read_options_lines(search_info::in, incl_stack::in,
|
|
io.text_input_stream::in, file_name::in, int::in,
|
|
options_variables::in, options_variables::out,
|
|
list(error_spec)::in, list(error_spec)::out,
|
|
list(error_spec)::in, list(error_spec)::out,
|
|
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
|
|
|
|
read_options_lines(SearchInfo, InclStack0, InStream, FileName, LineNumber0,
|
|
!Variables, !IOSpecs, !ParseSpecs, !UndefSpecs, !IO) :-
|
|
read_options_line(InStream, FileName, LineNumber0, LineNumber1,
|
|
LineResult, !IO),
|
|
(
|
|
LineResult = pr_ok(LineChars0),
|
|
(
|
|
LineChars0 = []
|
|
;
|
|
LineChars0 = [_ | _],
|
|
parse_options_line(FileName, LineNumber0, LineChars0,
|
|
MaybeOptionsFileLine),
|
|
(
|
|
MaybeOptionsFileLine = ofl_ok(OptionsFileLine),
|
|
(
|
|
OptionsFileLine = ofl_var_defn(SetOrAdd, VarName, Value),
|
|
update_variable(FileName, LineNumber1,
|
|
SetOrAdd, VarName, Value, !Variables,
|
|
!ParseSpecs, !UndefSpecs, !IO)
|
|
;
|
|
OptionsFileLine = ofl_include(IsOptionsFileOptional,
|
|
IncludedFilesChars0),
|
|
expand_any_var_references(!.Variables,
|
|
FileName, LineNumber0,
|
|
IncludedFilesChars0, IncludedFilesChars,
|
|
!ParseSpecs, !UndefSpecs, !IO),
|
|
MaybeIncludedFileNames =
|
|
split_into_words(IncludedFilesChars),
|
|
(
|
|
MaybeIncludedFileNames = ok(IncludedFileNames),
|
|
Context = term_context.context(FileName, LineNumber0),
|
|
PreStack1 = pre_stack_nested(Context, InclStack0),
|
|
list.foldl5(
|
|
read_options_file_params(SearchInfo,
|
|
PreStack1, IsOptionsFileOptional),
|
|
IncludedFileNames, !Variables,
|
|
!IOSpecs, !ParseSpecs, !UndefSpecs, !IO)
|
|
;
|
|
MaybeIncludedFileNames = error(IncludeFileNamesError),
|
|
Spec = report_split_error(FileName, LineNumber0,
|
|
IncludeFileNamesError),
|
|
!:ParseSpecs = [Spec | !.ParseSpecs]
|
|
)
|
|
)
|
|
;
|
|
MaybeOptionsFileLine = ofl_error(ParseSpec),
|
|
!:ParseSpecs = [ParseSpec | !.ParseSpecs]
|
|
)
|
|
),
|
|
LineNumber2 = LineNumber1 + 1,
|
|
read_options_lines(SearchInfo, InclStack0, InStream,
|
|
FileName, LineNumber2, !Variables,
|
|
!IOSpecs, !ParseSpecs, !UndefSpecs, !IO)
|
|
;
|
|
LineResult = pr_error(Spec),
|
|
!:IOSpecs = [Spec | !.IOSpecs]
|
|
;
|
|
LineResult = pr_eof
|
|
).
|
|
|
|
:- pred read_options_line(io.text_input_stream::in, file_name::in,
|
|
int::in, int::out, parse_result(list(char))::out, io::di, io::uo) is det.
|
|
|
|
read_options_line(InStream, FileName, !LineNumber, Result, !IO) :-
|
|
io.ignore_whitespace(InStream, SpaceResult, !IO),
|
|
(
|
|
SpaceResult = ok,
|
|
read_options_line_loop(InStream, FileName, !LineNumber, [],
|
|
Result, !IO)
|
|
;
|
|
SpaceResult = eof,
|
|
Result = pr_eof
|
|
;
|
|
SpaceResult = error(Error),
|
|
Spec = io_error_to_parse_error(FileName, !.LineNumber, Error),
|
|
Result = pr_error(Spec)
|
|
).
|
|
|
|
% If we find an I/O error while reading the line, return pr_error(...).
|
|
% Otherwise, if there is anything on the line, return pr_ok(...)
|
|
% wrapped around the non-comment characters.
|
|
% If there is nothing on the line, return pr_eof.
|
|
%
|
|
:- pred read_options_line_loop(io.text_input_stream::in, file_name::in,
|
|
int::in, int::out, list(char)::in, parse_result(list(char))::out,
|
|
io::di, io::uo) is det.
|
|
|
|
read_options_line_loop(InStream, FileName, !LineNumber, !.RevChars,
|
|
Result, !IO) :-
|
|
io.read_char_unboxed(InStream, CharResult, Char, !IO),
|
|
(
|
|
CharResult = ok,
|
|
( if Char = '#' then
|
|
list.reverse(!.RevChars, Chars),
|
|
skip_comment_line(InStream, SkipResult, !IO),
|
|
(
|
|
( SkipResult = ok
|
|
; SkipResult = eof
|
|
),
|
|
% Even if the skip found an eof, return the line so far
|
|
% before the hash sign (which may be empty). The attempt
|
|
% to read in the next line will find eof again, this time
|
|
% *without* a hash sign, which will cause us to return eof
|
|
% as well.
|
|
Result = pr_ok(Chars)
|
|
;
|
|
SkipResult = error(Error),
|
|
Spec = io_error_to_parse_error(FileName, !.LineNumber, Error),
|
|
Result = pr_error(Spec)
|
|
)
|
|
else if Char = ('\\') then
|
|
io.read_char_unboxed(InStream, CharResult2, Char2, !IO),
|
|
(
|
|
CharResult2 = ok,
|
|
( if Char2 = '\n' then
|
|
!:LineNumber = !.LineNumber + 1,
|
|
!:RevChars = [' ' | !.RevChars]
|
|
else
|
|
!:RevChars = [Char2, Char | !.RevChars]
|
|
),
|
|
read_options_line_loop(InStream, FileName, !LineNumber,
|
|
!.RevChars, Result, !IO)
|
|
;
|
|
CharResult2 = eof,
|
|
Context = term_context.context(FileName, !.LineNumber),
|
|
Pieces = [words("Error: attempt to escape end-of-file."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_read_files,
|
|
Context, Pieces),
|
|
Result = pr_error(Spec)
|
|
;
|
|
CharResult2 = error(Error),
|
|
Spec = io_error_to_parse_error(FileName, !.LineNumber, Error),
|
|
Result = pr_error(Spec)
|
|
)
|
|
else if Char = '\n' then
|
|
% Our caller will increment the line number.
|
|
list.reverse(!.RevChars, Chars),
|
|
Result = pr_ok(Chars)
|
|
else
|
|
!:RevChars = [Char | !.RevChars],
|
|
read_options_line_loop(InStream, FileName, !LineNumber,
|
|
!.RevChars, Result, !IO)
|
|
)
|
|
;
|
|
CharResult = eof,
|
|
(
|
|
!.RevChars = [_ | _],
|
|
list.reverse(!.RevChars, Chars),
|
|
Result = pr_ok(Chars)
|
|
;
|
|
!.RevChars = [],
|
|
Result = pr_eof
|
|
)
|
|
;
|
|
CharResult = error(Error),
|
|
Spec = io_error_to_parse_error(FileName, !.LineNumber, Error),
|
|
Result = pr_error(Spec)
|
|
).
|
|
|
|
:- func io_error_to_parse_error(file_name, int, io.error) = error_spec.
|
|
|
|
io_error_to_parse_error(FileName, LineNumber, Error) = Spec :-
|
|
Context = term_context.context(FileName, LineNumber),
|
|
Msg = io.error_message(Error),
|
|
Pieces = [words("I/O error:"), words(Msg), suffix("."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_read_files,
|
|
Context, Pieces).
|
|
|
|
:- func report_split_error(file_name, int, string) = error_spec.
|
|
|
|
report_split_error(FileName, LineNumber, Msg) = Spec :-
|
|
Context = term_context.context_init(FileName, LineNumber),
|
|
Pieces = [words("Error:"), words(Msg), suffix("."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_read_files,
|
|
Context, Pieces).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred skip_comment_line(io.text_input_stream::in, io.result::out,
|
|
io::di, io::uo) is det.
|
|
|
|
skip_comment_line(InStream, Result, !IO) :-
|
|
io.read_char_unboxed(InStream, CharResult, Char, !IO),
|
|
(
|
|
CharResult = ok,
|
|
( if Char = '\n' then
|
|
Result = ok
|
|
else
|
|
skip_comment_line(InStream, Result, !IO)
|
|
)
|
|
;
|
|
CharResult = eof,
|
|
Result = eof
|
|
;
|
|
CharResult = error(Error),
|
|
Result = error(Error)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type maybe_options_file_line
|
|
---> ofl_ok(options_file_line)
|
|
; ofl_error(error_spec).
|
|
|
|
:- type options_file_line
|
|
---> ofl_var_defn(
|
|
vd_set_or_add :: set_or_add,
|
|
vd_var :: options_variable,
|
|
vd_value :: list(char)
|
|
)
|
|
; ofl_include(
|
|
i_exist :: is_options_file_optional,
|
|
i_incl_file_name :: list(char)
|
|
).
|
|
|
|
:- type set_or_add
|
|
---> soa_set
|
|
; soa_add.
|
|
|
|
:- pred parse_options_line(file_name::in, int::in,
|
|
list(char)::in, maybe_options_file_line::out) is det.
|
|
|
|
parse_options_line(FileName, LineNumber, Line0, MaybeOptionsFileLine) :-
|
|
( if
|
|
( if Line0 = [('-') | Line1] then
|
|
IsOptionsFileOptional = options_file_need_not_exist,
|
|
Line2 = Line1
|
|
else
|
|
IsOptionsFileOptional = options_file_must_exist,
|
|
Line2 = Line0
|
|
),
|
|
list.append(string.to_char_list("include"), AfterInclude0, Line2)
|
|
then
|
|
list.drop_while(char.is_whitespace, AfterInclude0, AfterInclude),
|
|
MaybeOptionsFileLine = ofl_ok(
|
|
ofl_include(IsOptionsFileOptional, AfterInclude))
|
|
else
|
|
parse_variable_name(FileName, LineNumber, Line0, Line1,
|
|
MaybeVarName),
|
|
(
|
|
MaybeVarName = ovos_spec(Spec),
|
|
MaybeOptionsFileLine = ofl_error(Spec)
|
|
;
|
|
MaybeVarName = ovos_var_name(VarName),
|
|
list.drop_while(char.is_whitespace, Line1, Line2),
|
|
( if
|
|
(
|
|
( Line2 = [('=') | Line3]
|
|
; Line2 = [(':'), ('=') | Line3]
|
|
),
|
|
SetOrAdd = soa_set
|
|
;
|
|
Line2 = [('+'), ('=') | Line3],
|
|
SetOrAdd = soa_add
|
|
)
|
|
then
|
|
list.drop_while(char.is_whitespace, Line3, VarValue),
|
|
MaybeOptionsFileLine = ofl_ok(
|
|
ofl_var_defn(SetOrAdd, VarName, VarValue))
|
|
else
|
|
Line2Str = string.from_char_list(Line2),
|
|
Context = term_context.context(FileName, LineNumber),
|
|
Pieces = [words("Expected"), quote("="), suffix(","),
|
|
quote(":="), words("or"), quote("+="),
|
|
words("after"), quote(VarName), suffix(","),
|
|
words("got"), quote(Line2Str), suffix("."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_read_files,
|
|
Context, Pieces),
|
|
MaybeOptionsFileLine = ofl_error(Spec)
|
|
)
|
|
)
|
|
).
|
|
|
|
:- type opt_var_or_spec
|
|
---> ovos_var_name(options_variable)
|
|
; ovos_spec(error_spec).
|
|
|
|
:- pred parse_variable_name(file_name::in, int::in,
|
|
list(char)::in, list(char)::out, opt_var_or_spec::out) is det.
|
|
|
|
parse_variable_name(FileName, LineNumber, Chars0, Chars, MaybeVarName) :-
|
|
do_parse_variable_name(Chars0, Chars, is_first, [], RevVarNameChars),
|
|
string.from_rev_char_list(RevVarNameChars, VarName),
|
|
( if VarName = "" then
|
|
list.take_while_not(char.is_whitespace, Chars, FirstWordChars),
|
|
Pieces = [words("expected variable name before"),
|
|
quote(string.from_char_list(FirstWordChars)), suffix("."), nl],
|
|
Context = term_context.context(FileName, LineNumber),
|
|
Spec = simplest_spec($pred, severity_error, phase_read_files,
|
|
Context, Pieces),
|
|
MaybeVarName = ovos_spec(Spec)
|
|
else
|
|
MaybeVarName = ovos_var_name(VarName)
|
|
).
|
|
|
|
:- pred do_parse_variable_name(list(char)::in, list(char)::out,
|
|
maybe_is_first::in, list(char)::in, list(char)::out) is det.
|
|
|
|
do_parse_variable_name([], [], _, !RevVarNameChars).
|
|
do_parse_variable_name([Char | Chars0], Chars, IsFirst, !RevVarNameChars) :-
|
|
( if
|
|
not char.is_whitespace(Char),
|
|
(
|
|
IsFirst = is_first,
|
|
char.is_alpha(Char)
|
|
;
|
|
IsFirst = is_not_first,
|
|
( char.is_alnum_or_underscore(Char)
|
|
; Char = ('-')
|
|
; Char = ('.')
|
|
)
|
|
)
|
|
then
|
|
!:RevVarNameChars = [Char | !.RevVarNameChars],
|
|
do_parse_variable_name(Chars0, Chars, is_not_first, !RevVarNameChars)
|
|
else
|
|
Chars = [Char | Chars0]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- func split_into_words(list(char)) = maybe_error(list(string)).
|
|
|
|
split_into_words(Chars) = Result :-
|
|
split_into_words_loop(Chars, [], RevWords, MaybeError),
|
|
list.reverse(RevWords, Words),
|
|
(
|
|
MaybeError = no,
|
|
Result = ok(Words)
|
|
;
|
|
MaybeError = yes(Msg),
|
|
Result = error(Msg)
|
|
).
|
|
|
|
:- pred split_into_words_loop(list(char)::in,
|
|
list(string)::in, list(string)::out, maybe(string)::out) is det.
|
|
|
|
split_into_words_loop(Chars0, !RevWords, MaybeError) :-
|
|
list.drop_while(char.is_whitespace, Chars0, Chars1),
|
|
(
|
|
Chars1 = [],
|
|
MaybeError = no
|
|
;
|
|
Chars1 = [_ | _],
|
|
get_word(Chars1, Chars, Word, MaybeError0),
|
|
(
|
|
MaybeError0 = no,
|
|
!:RevWords = [Word | !.RevWords],
|
|
split_into_words_loop(Chars, !RevWords, MaybeError)
|
|
;
|
|
MaybeError0 = yes(_),
|
|
MaybeError = MaybeError0
|
|
)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
% get_word(Chars0, Chars, Word, MaybeError):
|
|
%
|
|
% Read one word from Chars0, returning the remaining characters in Chars
|
|
% and the word itself in Word, if MaybeError = no. If MaybeError is
|
|
% yes(Error), then Error will describe the error, abd the none of
|
|
% the other return values will be meaningful.
|
|
%
|
|
% A word is defined as a sequence of either
|
|
% - non-whitespace characters,
|
|
% - characters escaped with a backslash (which may be whitespace chars), or
|
|
% - strings starting and ending with unescaped double quotes (which may
|
|
% also contain whitespace chars).
|
|
%
|
|
:- pred get_word(list(char)::in, list(char)::out,
|
|
string::out, maybe(string)::out) is det.
|
|
|
|
get_word(Chars0, Chars, Word, MaybeError) :-
|
|
get_word_acc(Chars0, Chars, [], RevWord, MaybeError),
|
|
Word = string.from_rev_char_list(RevWord).
|
|
|
|
:- pred get_word_acc(list(char)::in, list(char)::out,
|
|
list(char)::in, list(char)::out, maybe(string)::out) is det.
|
|
|
|
get_word_acc([], [], RevWord, RevWord, no).
|
|
get_word_acc([Char | Chars0], Chars, RevWord0, RevWord, MaybeError) :-
|
|
( if char.is_whitespace(Char) then
|
|
Chars = Chars0,
|
|
RevWord = RevWord0,
|
|
MaybeError = no
|
|
else if Char = '"' then
|
|
get_string_acc(Chars0, Chars1, [], RevStringChars, MaybeError0),
|
|
(
|
|
MaybeError0 = no,
|
|
get_word_acc(Chars1, Chars, RevStringChars ++ RevWord0, RevWord,
|
|
MaybeError)
|
|
;
|
|
MaybeError0 = yes(_),
|
|
Chars = Chars0,
|
|
RevWord = RevWord0,
|
|
MaybeError = MaybeError0
|
|
)
|
|
else if Char = ('\\') then
|
|
(
|
|
Chars0 = [],
|
|
Chars = [],
|
|
RevWord = [Char | RevWord0],
|
|
MaybeError = no
|
|
;
|
|
Chars0 = [Char2 | Chars1],
|
|
( if
|
|
( Char2 = '"'
|
|
; Char2 = ('\\')
|
|
)
|
|
then
|
|
RevWord1 = [Char2 | RevWord0]
|
|
else
|
|
RevWord1 = [Char2, Char | RevWord0]
|
|
),
|
|
get_word_acc(Chars1, Chars, RevWord1, RevWord, MaybeError)
|
|
)
|
|
else
|
|
get_word_acc(Chars0, Chars, [Char | RevWord0], RevWord, MaybeError)
|
|
).
|
|
|
|
% get_string_acc(Chars0, Chars, RevString0, RevString, MaybeError):
|
|
%
|
|
% Read the part of a double-quoted string from Chars0 that occurs
|
|
% after the initial double quote, returning the remaining characters
|
|
% in Chars and adding the characters of the string itself in reverse
|
|
% to RevString0 yielding RevString, if MaybeError = no. If MaybeError is
|
|
% yes(Error), then Error will describe the error, abd the none of
|
|
% the other return values will be meaningful.
|
|
%
|
|
:- pred get_string_acc(list(char)::in, list(char)::out,
|
|
list(char)::in, list(char)::out, maybe(string)::out) is det.
|
|
|
|
get_string_acc([], [], RevString0, RevString0, MaybeError) :-
|
|
MaybeError = yes("unterminated string").
|
|
get_string_acc([Char | Chars0], Chars, RevString0, RevString, MaybeError) :-
|
|
( if Char = '"' then
|
|
Chars = Chars0,
|
|
RevString = RevString0,
|
|
MaybeError = no
|
|
else if Char = ('\\') then
|
|
(
|
|
Chars0 = [Char2 | Chars1],
|
|
( if Char2 = '"' then
|
|
RevString1 = [Char2 | RevString0]
|
|
else
|
|
RevString1 = [Char2, Char | RevString0]
|
|
),
|
|
get_string_acc(Chars1, Chars, RevString1, RevString, MaybeError)
|
|
;
|
|
Chars0 = [],
|
|
Chars = Chars0,
|
|
RevString = RevString0,
|
|
MaybeError = yes("unterminated string")
|
|
)
|
|
else
|
|
get_string_acc(Chars0, Chars, [Char | RevString0], RevString,
|
|
MaybeError)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred update_variable(file_name::in, int::in,
|
|
set_or_add::in, options_variable::in, list(char)::in,
|
|
options_variables::in, options_variables::out,
|
|
list(error_spec)::in, list(error_spec)::out,
|
|
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
|
|
|
|
update_variable(FileName, LineNumber, SetOrAdd, VarName, NewValue0,
|
|
!Variables, !ParseSpecs, !UndefSpecs, !IO) :-
|
|
expand_any_var_references(!.Variables, FileName, LineNumber,
|
|
NewValue0, NewValue1, !ParseSpecs, !UndefSpecs, !IO),
|
|
MaybeWords1 = split_into_words(NewValue1),
|
|
(
|
|
MaybeWords1 = ok(Words1),
|
|
!.Variables = options_variables(OptsMap0, EnvMap),
|
|
( if map.search(EnvMap, VarName, EnvValue) then
|
|
Value = string.to_char_list(EnvValue),
|
|
MaybeWords = split_into_words(Value),
|
|
(
|
|
MaybeWords = ok(Words),
|
|
EnvValueChars = string.to_char_list(EnvValue),
|
|
Entry = options_variable_value(EnvValueChars, Words,
|
|
environment),
|
|
map.set(VarName, Entry, OptsMap0, OptsMap),
|
|
!:Variables = options_variables(OptsMap, EnvMap)
|
|
;
|
|
MaybeWords = error(WordsError),
|
|
Spec = report_split_error(FileName, LineNumber, WordsError),
|
|
!:ParseSpecs = [Spec | !.ParseSpecs]
|
|
)
|
|
else
|
|
( if map.search(!.Variables ^ ov_opts, VarName, OldEntry) then
|
|
OldEntry = options_variable_value(OldValue, OldWords, Source),
|
|
(
|
|
Source = environment
|
|
;
|
|
Source = command_line
|
|
;
|
|
Source = options_file,
|
|
(
|
|
SetOrAdd = soa_set,
|
|
NewValue = NewValue1,
|
|
Words = Words1
|
|
;
|
|
SetOrAdd = soa_add,
|
|
NewValue = OldValue ++ [' ' | NewValue1],
|
|
Words = OldWords ++ Words1
|
|
),
|
|
Entry = options_variable_value(NewValue, Words,
|
|
options_file),
|
|
map.det_update(VarName, Entry, OptsMap0, OptsMap),
|
|
!:Variables = options_variables(OptsMap, EnvMap)
|
|
)
|
|
else
|
|
Entry = options_variable_value(NewValue1, Words1,
|
|
options_file),
|
|
map.det_insert(VarName, Entry, OptsMap0, OptsMap),
|
|
!:Variables = options_variables(OptsMap, EnvMap)
|
|
)
|
|
)
|
|
;
|
|
MaybeWords1 = error(WordsError1),
|
|
Spec = report_split_error(FileName, LineNumber, WordsError1),
|
|
!:ParseSpecs = [Spec | !.ParseSpecs]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred expand_any_var_references(options_variables::in,
|
|
file_name::in, int::in, list(char)::in, list(char)::out,
|
|
list(error_spec)::in, list(error_spec)::out,
|
|
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
|
|
|
|
expand_any_var_references(Variables, FileName, LineNumber, Chars0, Chars,
|
|
!ParseSpecs, !UndefSpecs, !IO) :-
|
|
expand_any_var_references_loop(Variables, FileName, LineNumber,
|
|
Chars0, [], RevChars, !ParseSpecs, set.init, UndefVarNames, !IO),
|
|
list.reverse(RevChars, Chars),
|
|
report_any_undefined_variables(FileName, LineNumber, UndefVarNames,
|
|
!UndefSpecs).
|
|
|
|
:- pred expand_any_var_references_loop(options_variables::in,
|
|
file_name::in, int::in, list(char)::in, list(char)::in, list(char)::out,
|
|
list(error_spec)::in, list(error_spec)::out,
|
|
set(string)::in, set(string)::out, io::di, io::uo) is det.
|
|
|
|
expand_any_var_references_loop(_, _, _,
|
|
[], !RevChars, !ParseSpecs, !UndefVarNames, !IO).
|
|
expand_any_var_references_loop(Variables, FileName, LineNumber,
|
|
[Char | Chars], !RevChars, !ParseSpecs, !UndefVarNames, !IO) :-
|
|
( if Char = '$' then
|
|
(
|
|
Chars = [],
|
|
Spec = report_unterminated_variable_reference(FileName, LineNumber,
|
|
!.RevChars),
|
|
!:ParseSpecs = [Spec | !.ParseSpecs]
|
|
;
|
|
Chars = [Char2 | Chars1],
|
|
( if Char2 = '$' then
|
|
!:RevChars = ['$' | !.RevChars],
|
|
expand_any_var_references_loop(Variables, FileName, LineNumber,
|
|
Chars1, !RevChars, !ParseSpecs, !UndefVarNames, !IO)
|
|
else
|
|
( if
|
|
( Char2 = '(', EndChar = ')'
|
|
; Char2 = '{', EndChar = '}'
|
|
)
|
|
then
|
|
parse_variable_name(FileName, LineNumber, Chars1, Chars2,
|
|
MaybeVarName0),
|
|
(
|
|
MaybeVarName0 = ovos_spec(_),
|
|
MaybeVarName = MaybeVarName0,
|
|
( if Chars2 = [EndChar | Chars3] then
|
|
Chars4 = Chars3
|
|
else
|
|
Chars4 = Chars2
|
|
)
|
|
;
|
|
MaybeVarName0 = ovos_var_name(_),
|
|
( if Chars2 = [EndChar | Chars3] then
|
|
Chars4 = Chars3,
|
|
MaybeVarName = MaybeVarName0
|
|
else
|
|
Chars4 = Chars2,
|
|
RefSpec = report_unterminated_variable_reference(
|
|
FileName, LineNumber, !.RevChars),
|
|
MaybeVarName = ovos_spec(RefSpec)
|
|
)
|
|
)
|
|
else
|
|
Chars4 = Chars1,
|
|
VarName0 = string.char_to_string(Char2),
|
|
MaybeVarName = ovos_var_name(VarName0)
|
|
),
|
|
(
|
|
MaybeVarName = ovos_var_name(VarName),
|
|
lookup_variable_value(Variables, VarName, VarValueChars,
|
|
!UndefVarNames),
|
|
!:RevChars = list.reverse(VarValueChars) ++ !.RevChars
|
|
;
|
|
MaybeVarName = ovos_spec(ParseSpec),
|
|
% There is no well-formed variable name to look up.
|
|
% We could try to put the characters that compose
|
|
% the malformed variable name to !RevChars, but I (zs)
|
|
% don't see any point.
|
|
!:ParseSpecs = [ParseSpec | !.ParseSpecs]
|
|
),
|
|
expand_any_var_references_loop(Variables, FileName, LineNumber,
|
|
Chars4, !RevChars, !ParseSpecs, !UndefVarNames, !IO)
|
|
)
|
|
)
|
|
else
|
|
!:RevChars = [Char | !.RevChars],
|
|
expand_any_var_references_loop(Variables, FileName, LineNumber,
|
|
Chars, !RevChars, !ParseSpecs, !UndefVarNames, !IO)
|
|
).
|
|
|
|
:- func report_unterminated_variable_reference(file_name, int, list(char))
|
|
= error_spec.
|
|
|
|
report_unterminated_variable_reference(FileName, LineNumber, RevChars)
|
|
= Spec :-
|
|
Context = term_context.context_init(FileName, LineNumber),
|
|
Pieces = [words("Error: unterminated reference to a variable after"),
|
|
quote(string.from_rev_char_list(RevChars)), suffix("."), nl],
|
|
Spec = simplest_spec($pred, severity_error, phase_read_files,
|
|
Context, Pieces).
|
|
|
|
:- pred report_any_undefined_variables(file_name::in, int::in,
|
|
set(string)::in, list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
report_any_undefined_variables(FileName, LineNumber, UndefVarNamesSet,
|
|
!UndefSpecs) :-
|
|
set.to_sorted_list(UndefVarNamesSet, UndefVarNames),
|
|
(
|
|
UndefVarNames = []
|
|
;
|
|
( UndefVarNames = [_], VarVars = "variable", IsAre = "is"
|
|
; UndefVarNames = [_, _ | _], VarVars = "variables", IsAre = "are"
|
|
),
|
|
UndefVarNamesPieces = list_to_quoted_pieces(UndefVarNames),
|
|
Context = term_context.context_init(FileName, LineNumber),
|
|
Pieces = [words("Warning:"), words(VarVars) | UndefVarNamesPieces] ++
|
|
[words(IsAre), words("undefined."), nl],
|
|
Spec = simplest_spec($pred, severity_warning, phase_read_files,
|
|
Context, Pieces),
|
|
!:UndefSpecs = [Spec | !.UndefSpecs]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
lookup_main_target(Variables, MaybeMainTarget) :-
|
|
lookup_variable_words(Variables, "MAIN_TARGET", MainTargetResult),
|
|
(
|
|
MainTargetResult = var_result_set(MainTarget),
|
|
MaybeMainTarget = ok1(MainTarget)
|
|
;
|
|
MainTargetResult = var_result_unset,
|
|
MaybeMainTarget = ok1([])
|
|
;
|
|
MainTargetResult = var_result_error(OoMSpecs),
|
|
MaybeMainTarget = error1(one_or_more_to_list(OoMSpecs))
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
lookup_mercury_stdlib_dir(Variables, MaybeMerStdlibDir) :-
|
|
lookup_variable_words(Variables, "MERCURY_STDLIB_DIR", MerStdlibDirResult),
|
|
(
|
|
MerStdlibDirResult = var_result_set(MerStdlibDir),
|
|
MaybeMerStdlibDir = ok1(MerStdlibDir)
|
|
;
|
|
MerStdlibDirResult = var_result_unset,
|
|
MaybeMerStdlibDir = ok1([])
|
|
;
|
|
MerStdlibDirResult = var_result_error(OoMSpecs),
|
|
MaybeMerStdlibDir = error1(one_or_more_to_list(OoMSpecs))
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
lookup_default_options(Variables, Result) :-
|
|
lookup_mmc_maybe_module_options(Variables, default, Result).
|
|
|
|
lookup_mmc_options(Variables, Result) :-
|
|
lookup_mmc_maybe_module_options(Variables, non_module_specific, Result).
|
|
|
|
lookup_mmc_module_options(Variables, ModuleName, Result) :-
|
|
lookup_mmc_maybe_module_options(Variables, module_specific(ModuleName),
|
|
Result).
|
|
|
|
:- pred lookup_mmc_maybe_module_options(options_variables::in,
|
|
options_variable_class::in, maybe1(list(string))::out) is det.
|
|
|
|
lookup_mmc_maybe_module_options(Variables, MaybeModuleName, Result) :-
|
|
VariableTypes = options_variable_types,
|
|
list.map_foldl(
|
|
lookup_options_variable(Variables, MaybeModuleName),
|
|
VariableTypes, VariableTypesMaybeValues, [], Specs),
|
|
(
|
|
Specs = [],
|
|
MmcOptLists =
|
|
list.map(convert_to_mmc_options, VariableTypesMaybeValues),
|
|
list.condense(MmcOptLists, MmcOpts),
|
|
Result = ok1(MmcOpts)
|
|
;
|
|
Specs = [_ | _],
|
|
% Returning error1 here is correct because all error_specs in Specs
|
|
% will have severity_error. There is (as of 2022 jan 23) exactly
|
|
% one place in this module that generates an error_spec whose
|
|
% severity is NOT severity_error, but it is not reachable from
|
|
% lookup_options_variable.
|
|
Result = error1(Specs)
|
|
).
|
|
|
|
:- 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
|
|
; 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,
|
|
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(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(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(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(one_or_more(error_spec)).
|
|
|
|
:- pred lookup_options_variable(options_variables::in,
|
|
options_variable_class::in, options_variable_type::in,
|
|
pair(options_variable_type, maybe(list(string)))::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
lookup_options_variable(Variables, OptionsVariableClass, FlagsVar,
|
|
FlagsVar - MaybeValues, !Specs) :-
|
|
VarName = options_variable_name(FlagsVar),
|
|
lookup_variable_words(Variables, "DEFAULT_" ++ VarName,
|
|
DefaultFlagsResult),
|
|
(
|
|
OptionsVariableClass = default,
|
|
FlagsResult = var_result_unset,
|
|
ExtraFlagsResult = var_result_unset
|
|
;
|
|
( OptionsVariableClass = module_specific(_)
|
|
; OptionsVariableClass = non_module_specific
|
|
),
|
|
lookup_variable_words(Variables, VarName, FlagsResult),
|
|
lookup_variable_words(Variables, "EXTRA_" ++ VarName, ExtraFlagsResult)
|
|
),
|
|
( 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(Variables, ModuleVarName, ModuleFlagsResult)
|
|
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.
|
|
|
|
Result =
|
|
DefaultFlagsResult `combine_var_results`
|
|
FlagsResult `combine_var_results`
|
|
ExtraFlagsResult `combine_var_results`
|
|
ModuleFlagsResult,
|
|
|
|
% Check the result is valid for the variable type.
|
|
(
|
|
Result = var_result_unset,
|
|
MaybeValues = no
|
|
;
|
|
Result = var_result_set(Values),
|
|
( if FlagsVar = ml_libs then
|
|
NotLibLPrefix =
|
|
( pred(LibFlag::in) is semidet :-
|
|
not string.prefix(LibFlag, "-l")
|
|
),
|
|
BadLibs = list.filter(NotLibLPrefix, Values),
|
|
(
|
|
BadLibs = [],
|
|
MaybeValues = yes(Values)
|
|
;
|
|
BadLibs = [_ | _],
|
|
MaybeValues = no,
|
|
Pieces = [words("Error: MLLIBS must contain only"),
|
|
quote("-l"), words("options, found") |
|
|
list_to_pieces(
|
|
list.map(func(Lib) = add_quotes(Lib), BadLibs))]
|
|
++ [suffix(".")],
|
|
Spec = simplest_no_context_spec($pred, severity_error,
|
|
phase_read_files, Pieces),
|
|
!:Specs = [Spec | !.Specs]
|
|
)
|
|
else
|
|
MaybeValues = yes(Values)
|
|
)
|
|
;
|
|
Result = var_result_error(OoMSpecs),
|
|
MaybeValues = no,
|
|
!:Specs = one_or_more_to_list(OoMSpecs) ++ !.Specs
|
|
).
|
|
|
|
:- func combine_var_results(variable_result(list(T)), variable_result(list(T)))
|
|
= variable_result(list(T)).
|
|
|
|
combine_var_results(ResultA, ResultB) = Result :-
|
|
(
|
|
ResultA = var_result_unset,
|
|
Result = ResultB
|
|
;
|
|
ResultA = var_result_set(SA),
|
|
(
|
|
ResultB = var_result_unset,
|
|
Result = ResultA
|
|
;
|
|
ResultB = var_result_set(SB),
|
|
Result = var_result_set(SA ++ SB)
|
|
;
|
|
ResultB = var_result_error(_),
|
|
Result = ResultB
|
|
)
|
|
;
|
|
ResultA = var_result_error(EA),
|
|
(
|
|
( ResultB = var_result_unset
|
|
; ResultB = var_result_set(_)
|
|
),
|
|
Result = ResultA
|
|
;
|
|
ResultB = var_result_error(EB),
|
|
Result = var_result_error(EA ++ EB)
|
|
)
|
|
).
|
|
|
|
:- pred lookup_variable_words(options_variables::in, options_variable::in,
|
|
variable_result(list(string))::out) is det.
|
|
|
|
lookup_variable_words(Variables, VarName, Result) :-
|
|
Variables = options_variables(OptsMap, EnvMap),
|
|
( if map.search(EnvMap, VarName, EnvValue) then
|
|
SplitResult = split_into_words(string.to_char_list(EnvValue)),
|
|
(
|
|
SplitResult = ok(EnvWords),
|
|
Result = var_result_set(EnvWords)
|
|
;
|
|
SplitResult = error(Msg),
|
|
Pieces = [words("Error: in environment variable"),
|
|
quote(VarName), suffix(":"), words(Msg), nl],
|
|
ErrorSpec = simplest_no_context_spec($pred, severity_error,
|
|
phase_read_files, Pieces),
|
|
Result = var_result_error(one_or_more(ErrorSpec, []))
|
|
)
|
|
else
|
|
( if map.search(OptsMap, VarName, MapValue) then
|
|
MapValue = options_variable_value(_, Words, _),
|
|
Result = var_result_set(Words)
|
|
else
|
|
Result = var_result_unset
|
|
)
|
|
).
|
|
|
|
:- pred lookup_variable_value(options_variables::in,
|
|
string::in, list(char)::out, set(string)::in, set(string)::out) is det.
|
|
|
|
lookup_variable_value(Variables, VarName, ValueChars, !UndefVarNames) :-
|
|
Variables = options_variables(OptsMap, EnvMap),
|
|
( if map.search(EnvMap, VarName, EnvValue) then
|
|
ValueChars = string.to_char_list(EnvValue)
|
|
else
|
|
( if map.search(OptsMap, VarName, Entry) then
|
|
Entry = options_variable_value(ValueChars, _, _)
|
|
else
|
|
ValueChars = [],
|
|
set.insert(VarName, !UndefVarNames)
|
|
)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
dump_options_file(ProgressStream, FileName, Variables, !IO) :-
|
|
io.open_output(FileName, OpenResult, !IO),
|
|
(
|
|
OpenResult = ok(DumpStream),
|
|
write_options_variables(DumpStream, Variables, !IO),
|
|
io.close_output(DumpStream, !IO)
|
|
;
|
|
OpenResult = error(Error),
|
|
ErrorMsg = io.error_message(Error),
|
|
io.format(ProgressStream, "mercury_compile: %s\n", [s(ErrorMsg)], !IO),
|
|
io.set_exit_status(1, !IO)
|
|
).
|
|
|
|
% Write out the given database to the given stream. Intended only
|
|
% for testing the functionality of code that builds such databases.
|
|
%
|
|
:- pred write_options_variables(io.text_output_stream::in,
|
|
options_variables::in, io::di, io::uo) is det.
|
|
|
|
write_options_variables(DumpStream, Variables, !IO) :-
|
|
Variables = options_variables(OptsMap, _EnvMap),
|
|
map.foldl(write_options_variable_value(DumpStream), OptsMap, !IO).
|
|
% tests/options_file/basic_test depends on dumping only OptsMap.
|
|
% You can uncomment this call for debugging.
|
|
% map.foldl(write_env_variable_value(DumpStream), EnvMap, !IO).
|
|
|
|
:- pred write_options_variable_value(io.text_output_stream::in,
|
|
string::in, options_variable_value::in, io::di, io::uo) is det.
|
|
|
|
write_options_variable_value(DumpStream, VarName, OptVarValue, !IO) :-
|
|
% The contents of _ValueChars is implicit in ValueWords, so
|
|
% printing it out would just clutter the output and make it
|
|
% harder to read.
|
|
OptVarValue = options_variable_value(_ValueChars, ValueWords, Src),
|
|
io.format(DumpStream, "%-24s ", [s(VarName ++ " ->")], !IO),
|
|
io.write(DumpStream, Src, !IO),
|
|
io.write_string(DumpStream, " ", !IO),
|
|
io.write_line(DumpStream, ValueWords, !IO).
|
|
|
|
:- pred write_env_variable_value(io.text_output_stream::in,
|
|
string::in, string::in, io::di, io::uo) is det.
|
|
:- pragma consider_used(pred(write_env_variable_value/5)).
|
|
|
|
write_env_variable_value(DumpStream, VarName, VarValue, !IO) :-
|
|
% The contents of _ValueChars is implicit in ValueWords, so
|
|
% printing it out would just clutter the output and make it
|
|
% harder to read.
|
|
io.format(DumpStream, "%-24s %s\n",
|
|
[s(VarName ++ " ->"), s(VarValue)], !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module make.options_file.
|
|
%---------------------------------------------------------------------------%
|