mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 17:33:38 +00:00
1811 lines
70 KiB
Mathematica
1811 lines
70 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2002-2011 The University of Melbourne.
|
|
% Copyright (C) 2013-2025 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 libs.options.
|
|
:- 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 compiler_arg_pack
|
|
---> compiler_arg_pack(
|
|
% The structure constructed by most of this module,
|
|
% containing the values of make-like variables that we get
|
|
% either from the environment of the compiler process,
|
|
% or from configuration/options files.
|
|
cap_eov :: env_optfile_variables,
|
|
|
|
% A sequence of option values that express the values
|
|
% of environment variables such as MERCURY_COLOR_SCHEME
|
|
% and NO_COLOR. Computed by get_args_representing_env_vars.
|
|
cap_env_var_args :: list(string),
|
|
|
|
% The contents of the command line (or of its args file
|
|
% replacement), separated into the arguments that represent
|
|
% options, and the ones that do not do so.
|
|
cap_option_args :: list(string),
|
|
cap_nonoption_args :: list(string)
|
|
).
|
|
|
|
:- type compiler_params
|
|
---> compiler_params(
|
|
% The first three fields of a compiler_arg_pack.
|
|
% Used by code that iterates over the nonoption arguments.
|
|
cp_eov :: env_optfile_variables,
|
|
cp_env_var_args :: list(string),
|
|
cp_option_args :: list(string)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type env_optfile_variables.
|
|
|
|
:- func env_optfile_variables_init(environment_var_map)
|
|
= env_optfile_variables.
|
|
|
|
% read_options_files_named_in_options_file_option(ProgressStream,
|
|
% OptionTable, Variables, Specs, UndefSpecs, !IO):
|
|
%
|
|
% Given OptionSearchDirs, the value of the options_search_directories
|
|
% option in OptionTable, 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, option_table::in, env_optfile_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, env_optfile_variables::in, env_optfile_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. We use this mechanism 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 we ignore
|
|
% the environment.
|
|
%
|
|
% 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(env_optfile_variables::in,
|
|
maybe1(list(string))::out) is det.
|
|
|
|
% Look up $(MERCURY_STDLIB_DIR).
|
|
%
|
|
:- pred lookup_mercury_stdlib_dir(env_optfile_variables::in,
|
|
maybe1(list(string))::out) is det.
|
|
|
|
% Look up the DEFAULT_MCFLAGS variable.
|
|
%
|
|
:- pred lookup_default_options(env_optfile_variables::in,
|
|
maybe1(list(string))::out) is det.
|
|
|
|
% Look up all the non-module specific options.
|
|
%
|
|
:- pred lookup_mmc_options(env_optfile_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(env_optfile_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,
|
|
env_optfile_variables::in, io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module parse_tree.find_module.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module char.
|
|
:- import_module dir.
|
|
:- import_module getopt.
|
|
:- 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.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Values of this type contain the values of options we get from
|
|
% two sources: environment variables, and configuration/options files
|
|
% (such as Mercury.config and Mercury.options).
|
|
:- type env_optfile_variables
|
|
---> env_optfile_variables(
|
|
% This field contains the set of all the environment variables
|
|
% of the current process. Most of these are not related to
|
|
% Mercury, so preprocessing all environment variable values
|
|
% would yield lots of diagnostics about settings that have
|
|
% nothing to do with Mercury.
|
|
%
|
|
% We cannot pre-process the set that are relevant to Mercury
|
|
% either, because we don't know what that set is.
|
|
% The reason is the presence of module names in
|
|
% options variable name of forms such as MCFLAGS-modulename.
|
|
%
|
|
% We therefore process the values of environment variables
|
|
% (meaning, we check whether they can be split up into words
|
|
% cleanly) only when the compiler looks up a key in this map.
|
|
eov_env :: map(env_optfile_var, string),
|
|
|
|
% This field contains the variable values we get from
|
|
% one or more configuration and/or options files,
|
|
% with the exception that if a variable name occurs in
|
|
% eov_env, then it won't occur in eov_opts, even if
|
|
% the options file(s) we read in do define that variable.
|
|
% This is because an entry in eov_env will override
|
|
% any eov_opts entry it shadows.
|
|
eov_opts :: map(env_optfile_var, env_optfile_var_value)
|
|
).
|
|
|
|
:- type env_optfile_var == string.
|
|
|
|
:- type env_optfile_var_value
|
|
---> env_optfile_var_value(
|
|
% The variable's value, as the exact list of chars we read,
|
|
% with any gaps between any two part-definitions (meaning
|
|
% definition components extended using ":=" syntax)
|
|
% being a single space.
|
|
%
|
|
% We use this to expand references to $(varname).
|
|
list(char),
|
|
|
|
% The variable's value, split into words.
|
|
%
|
|
% This is the field that the rest of the compiler consults.
|
|
list(string)
|
|
).
|
|
|
|
env_optfile_variables_init(EnvVarMap) = Variables :-
|
|
map.init(OptsMap),
|
|
Variables = env_optfile_variables(EnvVarMap, OptsMap).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
read_options_files_named_in_options_file_option(ProgressStream, OptionTable,
|
|
Variables, Specs, UndefSpecs, !IO) :-
|
|
getopt.lookup_accumulating_option(OptionTable, options_files,
|
|
OptionsFiles),
|
|
io.environment.get_environment_var_map(EnvVarMap, !IO),
|
|
Variables0 = env_optfile_variables_init(EnvVarMap),
|
|
list.foldl5(
|
|
read_options_file_set_params(ProgressStream, OptionTable),
|
|
OptionsFiles, Variables0, Variables,
|
|
[], IOSpecs, [], ParseSpecs, [], UndefSpecs, !IO),
|
|
Specs = IOSpecs ++ ParseSpecs.
|
|
|
|
:- pred read_options_file_set_params(io.text_output_stream::in,
|
|
option_table::in, string::in,
|
|
env_optfile_variables::in, env_optfile_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, OptionTable, OptionsFile,
|
|
!Variables, !IOSpecs, !ParseSpecs, !UndefSpecs, !IO) :-
|
|
MaybeDirName = no,
|
|
( if OptionsFile = "Mercury.options" then
|
|
SearchAuthDirs = search_auth_cur_dir,
|
|
IsOptionsFileOptional = options_file_need_not_exist
|
|
else
|
|
SearchAuthDirs = get_search_auth_options_file_dirs(OptionTable),
|
|
IsOptionsFileOptional = options_file_must_exist
|
|
),
|
|
SearchInfo = search_info(ProgressStream, MaybeDirName, SearchAuthDirs),
|
|
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, search_auth_cur_dir),
|
|
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 = env_optfile_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 OptionsFile.
|
|
NoEnvVariables = Variables ^ eov_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 = no_ctxt_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_info
|
|
---> search_info(
|
|
si_progress_stream :: io.text_output_stream,
|
|
si_maybe_dir_name :: maybe(dir_name),
|
|
si_search_which_dirs :: search_auth_tail_dirs
|
|
).
|
|
|
|
:- 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,
|
|
env_optfile_variables::in, env_optfile_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, SearchAuthDirs0),
|
|
% 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)
|
|
),
|
|
% 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,
|
|
% OptionsPathName, 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,
|
|
SearchAuthDirs = search_auth_this_dir(OptionsDir)
|
|
else
|
|
(
|
|
MaybeDirName = yes(DirName),
|
|
RelOptionsDir = DirName / OptionsDir,
|
|
SearchAuthDirs = search_auth_this_dir_and(RelOptionsDir,
|
|
SearchAuthDirs0),
|
|
FileToFind = OptionsFile
|
|
;
|
|
MaybeDirName = no,
|
|
SearchAuthDirs = coerce(SearchAuthDirs0),
|
|
FileToFind = OptionsPathName
|
|
)
|
|
)
|
|
else
|
|
SearchAuthDirs = coerce(SearchAuthDirs0),
|
|
FileToFind = OptionsPathName
|
|
),
|
|
search_for_file_returning_dir_and_stream(SearchAuthDirs, FileToFind,
|
|
SearchDirs, 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 SearchDirs = [SingleDir] then
|
|
( if SingleDir = dir.this_directory then
|
|
ErrorFile = FileToFind
|
|
else
|
|
ErrorFile = dir.make_path_name(SingleDir, FileToFind)
|
|
)
|
|
else
|
|
ErrorFile = FileToFind
|
|
),
|
|
Phase = phase_find_files(ErrorFile),
|
|
Pieces = [words("Error: cannot open options file"),
|
|
quote(ErrorFile), suffix(":"),
|
|
words(Error), suffix("."), nl],
|
|
(
|
|
PreStack0 = pre_stack_base,
|
|
Spec = no_ctxt_spec($pred, severity_error, Phase, Pieces)
|
|
;
|
|
PreStack0 = pre_stack_nested(Context, _),
|
|
Spec = spec($pred, severity_error, Phase, Context, 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 = 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 = 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 = 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 = 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).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% NOTE: It would be nice if we could just use io.read_file_as_string here,
|
|
% because it would avoid the need to check for error when reading in
|
|
% *every* *single* *character*. Unfortunately, we cannot, because
|
|
% that predicate does not work for stdin.
|
|
%
|
|
:- pred read_options_lines(search_info::in, incl_stack::in,
|
|
io.text_input_stream::in, file_name::in, int::in,
|
|
env_optfile_variables::in, env_optfile_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 = 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 = 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 = 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 :: env_optfile_var,
|
|
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("Error: expected"), quote("="), suffix(","),
|
|
quote(":="), words("or"), quote("+="),
|
|
words("after"), quote(VarName), suffix(","),
|
|
words("got"), quote(Line2Str), suffix("."), nl],
|
|
Spec = spec($pred, severity_error, phase_read_files,
|
|
Context, Pieces),
|
|
MaybeOptionsFileLine = ofl_error(Spec)
|
|
)
|
|
)
|
|
).
|
|
|
|
:- type opt_var_or_spec
|
|
---> ovos_var_name(env_optfile_var)
|
|
; 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 = 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, and 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, and 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, env_optfile_var::in, list(char)::in,
|
|
env_optfile_variables::in, env_optfile_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, NewChars0,
|
|
!Variables, !ParseSpecs, !UndefSpecs, !IO) :-
|
|
expand_any_var_references(!.Variables, FileName, LineNumber,
|
|
NewChars0, NewChars1, !ParseSpecs, !UndefSpecs, !IO),
|
|
MaybeWords1 = split_into_words(NewChars1),
|
|
(
|
|
MaybeWords1 = ok(Words1),
|
|
!.Variables = env_optfile_variables(EnvMap, OptsMap0),
|
|
( if map.search(EnvMap, VarName, EnvStr) then
|
|
% We do not need to insert the VarName/Words1 pair into OptsMap0,
|
|
% because, due to the presence of VarName key in EnvMap,
|
|
% it will never be consulted.
|
|
%
|
|
% However, the first time we get here for a given VarName
|
|
% is the first time we learn that the environment variable
|
|
% with that name is relevant to Mercury, and therefore we should
|
|
% check whether it splits into words cleanly.
|
|
%
|
|
% Should we check that here and now, or should we leave it
|
|
% to lookup_variable_words predicate, which is invoked when
|
|
% the compiler wants to use this environment variable?
|
|
% There are arguments in favor of both options.
|
|
%
|
|
% Checking now means that we detect and report errors in the value
|
|
% of an environment variable as early as possible after that
|
|
% envvar is set to a value we do not consider acceptable.
|
|
%
|
|
% On the other hand, if two envvars relevant to a Mercury program,
|
|
% say MCFLAGS-mod_a and MCFLAGS-mod_b, both have the same error,
|
|
% but only MCFLAGS-mod_a appears in a Mercury.options file, then
|
|
% the code here would report the error only for the first envvar,
|
|
% leaving the second to be reported by lookup_variable_words.
|
|
% That would seem to violate the law of least astonishment.
|
|
%
|
|
% Reporting any errors here and now preserves old behavior.
|
|
% XXX The question is: *should* we preserve this old behavior?
|
|
SplitResult = split_into_words(string.to_char_list(EnvStr)),
|
|
(
|
|
SplitResult = ok(_)
|
|
;
|
|
SplitResult = error(Msg),
|
|
Spec = split_error_msg_to_error_spec(VarName, Msg),
|
|
!:ParseSpecs = [Spec | !.ParseSpecs]
|
|
)
|
|
else
|
|
( if map.search(OptsMap0, VarName, OldOptsEntry) then
|
|
OldOptsEntry = env_optfile_var_value(OldChars, OldWords),
|
|
(
|
|
SetOrAdd = soa_set,
|
|
NewChars = NewChars1,
|
|
NewWords = Words1
|
|
;
|
|
SetOrAdd = soa_add,
|
|
NewChars = OldChars ++ [' ' | NewChars1],
|
|
NewWords = OldWords ++ Words1
|
|
),
|
|
NewOptsEntry = env_optfile_var_value(NewChars, NewWords),
|
|
map.det_update(VarName, NewOptsEntry, OptsMap0, OptsMap)
|
|
else
|
|
NewOptsEntry = env_optfile_var_value(NewChars1, Words1),
|
|
map.det_insert(VarName, NewOptsEntry, OptsMap0, OptsMap)
|
|
),
|
|
!Variables ^ eov_opts := OptsMap
|
|
)
|
|
;
|
|
MaybeWords1 = error(WordsError1),
|
|
Spec = report_split_error(FileName, LineNumber, WordsError1),
|
|
!:ParseSpecs = [Spec | !.ParseSpecs]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred expand_any_var_references(env_optfile_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(env_optfile_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 = 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 = quote_list_to_pieces("and", UndefVarNames),
|
|
Context = term_context.context_init(FileName, LineNumber),
|
|
Pieces = [words("Warning:"), words(VarVars) | UndefVarNamesPieces] ++
|
|
[words(IsAre), words("undefined."), nl],
|
|
Severity = severity_warning(warn_undefined_options_variables),
|
|
Spec = spec($pred, Severity, 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(env_optfile_variables::in,
|
|
env_optfile_var_class::in, maybe1(list(string))::out) is det.
|
|
|
|
lookup_mmc_maybe_module_options(Variables, EnvOptFileVarClass, Result) :-
|
|
RevVarIds = list.reverse(env_optfile_var_ids),
|
|
list.foldl2(
|
|
lookup_env_optfile_var(Variables, EnvOptFileVarClass),
|
|
RevVarIds, [], MmcOptions, [], Specs),
|
|
(
|
|
Specs = [],
|
|
Result = ok1(MmcOptions)
|
|
;
|
|
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_env_optfile_var.
|
|
Result = error1(Specs)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type variable_result(T)
|
|
---> var_result_set(T)
|
|
; var_result_unset
|
|
; var_result_error(one_or_more(error_spec)).
|
|
|
|
:- pred lookup_env_optfile_var(env_optfile_variables::in,
|
|
env_optfile_var_class::in, env_optfile_var_id::in,
|
|
list(string)::in, list(string)::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
lookup_env_optfile_var(Variables, EnvOptFileVarClass, FlagsVarId,
|
|
!AllMmcOptions, !Specs) :-
|
|
% NOTE: The order in which we add these lists of flags are added together
|
|
% is important. In the resulting set the flags must occur in the order
|
|
%
|
|
% - first from DefaultFlagsResult
|
|
% - then from FlagsResult
|
|
% - then from ExtraFlagsResult
|
|
% - then from ModuleFlagsResult.
|
|
%
|
|
% Failing to maintain this order will result in the user being unable
|
|
% to override the default value of many of the compiler's options.
|
|
%
|
|
% On the other hand, there is no point in not exploiting the fact
|
|
% that for some values of EnvOptFileVarClass, some of those sources
|
|
% of flags do not exist.
|
|
get_env_optfile_var_info(FlagsVarId, VarName, DefaultVarName, ExtraVarName,
|
|
TargetSpecific, OptionSpec),
|
|
lookup_variable_words(Variables, DefaultVarName, DefaultFlagsResult),
|
|
(
|
|
EnvOptFileVarClass = default,
|
|
Result = DefaultFlagsResult
|
|
;
|
|
EnvOptFileVarClass = non_module_specific,
|
|
lookup_variable_words(Variables, VarName, FlagsResult),
|
|
lookup_variable_words(Variables, ExtraVarName, ExtraFlagsResult),
|
|
Result =
|
|
DefaultFlagsResult `combine_var_results`
|
|
FlagsResult `combine_var_results`
|
|
ExtraFlagsResult
|
|
;
|
|
EnvOptFileVarClass = module_specific(ModuleName),
|
|
lookup_variable_words(Variables, VarName, FlagsResult),
|
|
lookup_variable_words(Variables, ExtraVarName, ExtraFlagsResult),
|
|
(
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
ModuleFileNameBase = sym_name_to_string(ModuleName),
|
|
ModuleVarName = VarNameMinus ++ ModuleFileNameBase,
|
|
lookup_variable_words(Variables, ModuleVarName, ModuleFlagsResult),
|
|
Result =
|
|
DefaultFlagsResult `combine_var_results`
|
|
FlagsResult `combine_var_results`
|
|
ExtraFlagsResult `combine_var_results`
|
|
ModuleFlagsResult
|
|
;
|
|
TargetSpecific = not_target_specific,
|
|
Result =
|
|
DefaultFlagsResult `combine_var_results`
|
|
FlagsResult `combine_var_results`
|
|
ExtraFlagsResult
|
|
)
|
|
),
|
|
|
|
% Check whether the result is valid for the variable type.
|
|
(
|
|
Result = var_result_unset
|
|
% Leave !AllMmcOptions as is.
|
|
;
|
|
Result = var_result_set(VarValues),
|
|
( if FlagsVarId = ml_libs then
|
|
check_ml_libs_values(VarValues, !Specs)
|
|
else
|
|
true
|
|
),
|
|
(
|
|
OptionSpec = mmc_flags,
|
|
MmcOptions = VarValues
|
|
;
|
|
OptionSpec = option(InitialOptions, OptionName),
|
|
MmcOptions = list.condense([InitialOptions |
|
|
list.map((func(Word) = [OptionName, Word]), VarValues)])
|
|
),
|
|
!:AllMmcOptions = MmcOptions ++ !.AllMmcOptions
|
|
;
|
|
Result = var_result_error(OoMSpecs),
|
|
% Leave !AllMmcOptions as is.
|
|
!:Specs = one_or_more_to_list(OoMSpecs) ++ !.Specs
|
|
).
|
|
|
|
:- pred check_ml_libs_values(list(string)::in,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
check_ml_libs_values(VarValues, !Specs) :-
|
|
NotLibLPrefix =
|
|
( pred(LibFlag::in) is semidet :-
|
|
not string.prefix(LibFlag, "-l")
|
|
),
|
|
BadLibs = list.filter(NotLibLPrefix, VarValues),
|
|
(
|
|
BadLibs = []
|
|
;
|
|
BadLibs = [_ | _],
|
|
Pieces = [words("Error: MLLIBS must contain only"),
|
|
quote("-l"), words("options, found")] ++
|
|
quote_list_to_pieces("and", BadLibs) ++ [suffix(".")],
|
|
Spec = no_ctxt_spec($pred, severity_error,
|
|
phase_read_files, Pieces),
|
|
!:Specs = [Spec | !.Specs]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type env_optfile_var_class
|
|
---> default
|
|
; non_module_specific
|
|
; module_specific(module_name).
|
|
|
|
:- type env_optfile_var_id
|
|
---> 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 env_optfile_var_ids = list(env_optfile_var_id).
|
|
|
|
env_optfile_var_ids =
|
|
% `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].
|
|
|
|
:- type mmc_option_spec
|
|
---> mmc_flags
|
|
% The options can be passed directly to mmc.
|
|
|
|
; option(
|
|
% 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.
|
|
initial_options :: list(string),
|
|
option_name :: string
|
|
).
|
|
|
|
:- type maybe_target_specific
|
|
---> not_target_specific
|
|
; target_specific(string).
|
|
% The string should be VarNameMinus (see below).
|
|
|
|
:- pred get_env_optfile_var_info(env_optfile_var_id::in,
|
|
string::out, string::out, string::out,
|
|
maybe_target_specific::out, mmc_option_spec::out) is det.
|
|
|
|
get_env_optfile_var_info(VarId, VarName, DefaultVarName, ExtraVarName,
|
|
TargetSpecific, OptionSpec) :-
|
|
(
|
|
VarId = grade_flags,
|
|
VarName = "GRADEFLAGS",
|
|
TargetSpecific = not_target_specific,
|
|
OptionSpec = mmc_flags
|
|
;
|
|
VarId = mmc_flags,
|
|
VarName = "MCFLAGS",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = mmc_flags
|
|
;
|
|
VarId = c_flags,
|
|
VarName = "CFLAGS",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = option([], "--cflag")
|
|
;
|
|
VarId = gcc_flags,
|
|
VarName = "GCC_FLAGS",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = option([], "--gcc-flag")
|
|
;
|
|
VarId = clang_flags,
|
|
VarName = "CLANG_FLAGS",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = option([], "--clang-flag")
|
|
;
|
|
VarId = msvc_flags,
|
|
VarName = "MSVC_FLAGS",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = option([], "--msvc-flag")
|
|
;
|
|
VarId = java_flags,
|
|
VarName = "JAVACFLAGS",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = option([], "--java-flag")
|
|
;
|
|
VarId = csharp_flags,
|
|
VarName = "CSCFLAGS",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = option([], "--csharp-flag")
|
|
;
|
|
VarId = ml_objs,
|
|
VarName = "MLOBJS",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = option([], "--link-object")
|
|
;
|
|
VarId = ml_libs,
|
|
VarName = "MLLIBS",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = mmc_flags
|
|
;
|
|
VarId = ld_flags,
|
|
VarName = "LDFLAGS",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = option([], "--ld-flag")
|
|
;
|
|
VarId = ld_libflags,
|
|
VarName = "LD_LIBFLAGS",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = option([], "--ld-libflag")
|
|
;
|
|
VarId = c2init_args,
|
|
VarName = "C2INITARGS",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = option([], "--init-file")
|
|
;
|
|
VarId = libraries,
|
|
VarName = "LIBRARIES",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = option([], "--mercury-library")
|
|
;
|
|
VarId = lib_dirs,
|
|
VarName = "LIB_DIRS",
|
|
TargetSpecific = not_target_specific,
|
|
OptionSpec = option([], "--mercury-library-directory")
|
|
;
|
|
VarId = lib_grades,
|
|
VarName = "LIBGRADES",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = option(["--no-libgrade"], "--libgrade")
|
|
;
|
|
VarId = lib_linkages,
|
|
VarName = "LIB_LINKAGES",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = option(["--no-lib-linkage"], "--lib-linkage")
|
|
;
|
|
VarId = install_prefix,
|
|
VarName = "INSTALL_PREFIX",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = option([], "--install-prefix")
|
|
;
|
|
VarId = stdlib_dir,
|
|
VarName = "MERCURY_STDLIB_DIR",
|
|
TargetSpecific = not_target_specific,
|
|
OptionSpec = option([], "--mercury-stdlib-dir")
|
|
;
|
|
VarId = config_dir,
|
|
VarName = "MERCURY_CONFIG_DIR",
|
|
TargetSpecific = not_target_specific,
|
|
OptionSpec = option([], "--mercury-config-dir")
|
|
;
|
|
VarId = linkage,
|
|
VarName = "LINKAGE",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = option([], "--linkage")
|
|
;
|
|
VarId = mercury_linkage,
|
|
VarName = "MERCURY_LINKAGE",
|
|
VarNameMinus = VarName ++ "-",
|
|
TargetSpecific = target_specific(VarNameMinus),
|
|
OptionSpec = option([], "--mercury-linkage")
|
|
),
|
|
% XXX There should be an optimization to
|
|
% - move these two calls into each switch arm above, and then
|
|
% - evaluate all copies of both calls at compile time.
|
|
DefaultVarName = "DEFAULT_" ++ VarName,
|
|
ExtraVarName = "EXTRA_" ++ VarName.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred lookup_variable_words(env_optfile_variables::in, env_optfile_var::in,
|
|
variable_result(list(string))::out) is det.
|
|
|
|
lookup_variable_words(Variables, VarName, Result) :-
|
|
Variables = env_optfile_variables(EnvMap, OptsMap),
|
|
( if map.search(EnvMap, VarName, EnvStr) then
|
|
SplitResult = split_into_words(string.to_char_list(EnvStr)),
|
|
(
|
|
SplitResult = ok(EnvWords),
|
|
Result = var_result_set(EnvWords)
|
|
;
|
|
SplitResult = error(Msg),
|
|
Spec = split_error_msg_to_error_spec(VarName, Msg),
|
|
Result = var_result_error(one_or_more(Spec, []))
|
|
)
|
|
else if map.search(OptsMap, VarName, OptsEntry) then
|
|
OptsEntry = env_optfile_var_value(_, Words),
|
|
Result = var_result_set(Words)
|
|
else
|
|
Result = var_result_unset
|
|
).
|
|
|
|
:- pred lookup_variable_value(env_optfile_variables::in,
|
|
string::in, list(char)::out, set(string)::in, set(string)::out) is det.
|
|
|
|
lookup_variable_value(Variables, VarName, ValueChars, !UndefVarNames) :-
|
|
Variables = env_optfile_variables(EnvMap, OptsMap),
|
|
( if map.search(EnvMap, VarName, EnvStr) then
|
|
ValueChars = string.to_char_list(EnvStr)
|
|
else if map.search(OptsMap, VarName, OptsEntry) then
|
|
OptsEntry = env_optfile_var_value(ValueChars, _)
|
|
else
|
|
ValueChars = [],
|
|
set.insert(VarName, !UndefVarNames)
|
|
).
|
|
|
|
:- func split_error_msg_to_error_spec(string, string) = error_spec.
|
|
|
|
split_error_msg_to_error_spec(VarName, Msg) = Spec :-
|
|
Pieces = [words("Error: in environment variable"),
|
|
quote(VarName), suffix(":"), words(Msg), nl],
|
|
Spec = no_ctxt_spec($pred, severity_error, phase_read_files, Pieces).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- 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)
|
|
)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
dump_options_file(ProgressStream, FileName, Variables, !IO) :-
|
|
io.open_output(FileName, OpenResult, !IO),
|
|
(
|
|
OpenResult = ok(DumpStream),
|
|
write_env_optfile_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_env_optfile_variables(io.text_output_stream::in,
|
|
env_optfile_variables::in, io::di, io::uo) is det.
|
|
|
|
write_env_optfile_variables(DumpStream, Variables, !IO) :-
|
|
Variables = env_optfile_variables(_EnvMap, OptsMap),
|
|
map.foldl(write_env_optfile_var_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_env_optfile_var_value(io.text_output_stream::in,
|
|
string::in, env_optfile_var_value::in, io::di, io::uo) is det.
|
|
|
|
write_env_optfile_var_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 = env_optfile_var_value(_ValueChars, ValueWords),
|
|
io.format(DumpStream, "%-24s %s\n",
|
|
[s(VarName ++ " ->"), s(string(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) :-
|
|
io.format(DumpStream, "%-24s %s\n",
|
|
[s(VarName ++ " ->"), s(VarValue)], !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module make.options_file.
|
|
%---------------------------------------------------------------------------%
|