mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 01:13:30 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
mercury/compiler/fact_table_gen.m
Zoltan Somogyi b560f66ab9 Move four modules from check_hlds.m to hlds.m. 
After this, I think all modules in the check_hlds package belong there.

compiler/inst_match.m:
compiler/mode_test.m:
    Move these modules from the check_hlds package to the hlds package
    because most of their uses are outside the semantic analysis passes
    that the check_hlds package is intended to contain.

compiler/inst_merge.m:
    Move this module from the check_hlds package to the hlds package
    because it is imported by only two modules, instmap.m and inst_match.m,
    and after this diff, both are in the hlds package.

compiler/implementation_defined_literals.m:
    Move this module from the check_hlds package to the hlds package
    because it does a straightforward program transformation that
    does not have anything to do with semantic analysis (though its
    invocation does happen between semantic analysis passes).

compiler/notes/compiler_design.html:
    Update the documentation of the goal_path.m module. (I checked the
    documentation of the moved modules, which did not need updates,
    and found the need for this instead.)

compiler/*.m:
    Conform to the changes above. (For many modules, this deletes
    their import of the check_hlds package itself.)
2026-02-27 15:16:44 +11:00

3946 lines
150 KiB
Mathematica
Raw Permalink Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1996-2001, 2003-2012 The University of Melbourne.
% Copyright (C) 2013-2018, 2020-2026 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: fact_table_gen.m.
% Main author: dmo.
%
% This module handles compilation of fact tables contained in external files
% that have been declared with a `pragma fact_table' declaration.
%
% The facts are processed one by one. Each fact is read in and type and mode
% checked. If there are no modes with input arguments, the data is written
% out to arrays of C structures as each fact is processed. If there are input
% modes, the input arguments for each mode are written out to a temporary
% sort file -- one sort file per input mode. The output arguments are also
% included in the sort file for the primary input mode. (At the moment,
% the primary input mode is the one with the lowest ProcId number, however
% this may change in the future to select the mode that is likely to give
% the biggest increase in efficiency by being the primary mode).
%
% After all the facts have been read, the sort files are sorted by the Unix
% `sort' program. They are then scanned for duplicate input keys to infer
% the determinisms of each mode.
%
% The sort files are then read back in one by one and hash tables are created
% for each input mode. While the sort file for the primary input mode is
% being read, the output arguments are also read back in and output as C
% arrays in another temporary file. (This file is concatenated to the end
% of the fact table C file after all the hash tables have been created.)
% This means that the output data for identical keys in the primary input
% mode will be grouped together allowing the code that accesses this mode
% to be just pick the next item in the data array when backtracking.
%
% The inferred determinism for each mode is added to the proc_info. If a
% determinism has been declared for the procedure, it will be tested against
% the inferred determinism later on in det_check_proc.m.
%
% XXX All combinations of `in' and `out' arguments are now supported for all
% determinisms. Only the builtin `string', `int' and `float' types are
% supported at the moment.
%
% XXX Cross compilation is not supported for fact tables that are indexed on
% floats.
%
%---------------------------------------------------------------------------%
:- module ll_backend.fact_table_gen.
:- interface.
:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.
:- import_module parse_tree.error_spec.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_data_foreign.
:- import_module io.
:- import_module list.
%---------------------------------------------------------------------------%
:- type fact_table_arg_check_result
---> fact_table_args_ok(fact_table_gen_info)
; fact_table_args_not_ok(list(error_spec)).
:- type fact_table_gen_info.
% Check whether the declaration of the given predicate and its mode(s)
% are suitable for fact tables. If not, return a message for each error.
% Otherwise, return an opaque data structure that the caller can give
% to the other two exported predicates of this module to generate code
% for the predicate.
%
:- pred fact_table_check_args(module_info::in, prog_context::in,
pred_id::in, pred_info::in, fact_table_arg_check_result::out) is det.
% fact_table_compile_facts(ProgressStream, ModuleInfo, FactTableFileName,
% Context, GenInfo, HeaderCode, PrimaryProcId, !PredInfo, !Specs, !IO):
%
% Compile the fact table in FactFileName for PredInfo into a separate .c
% file. Return error specs for any errors discovered while processing the
% contents of FactTableFileName, such as syntax errors (such as found fact
% for wrong predicate, found fact with wrong number of arguments, found
% fact in function form when expecting fact for predicate), type errors
% (expected int, found float) and mode errors (expected int,
% found variable).
%
:- pred fact_table_compile_facts(io.text_output_stream::in, module_info::in,
string::in, prog_context::in, fact_table_gen_info::in, string::out,
proc_id::out, pred_info::in, pred_info::out,
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
% fact_table_generate_c_code_for_proc(ModuleInfo, PredName,
% ProcId, PrimaryProcId, ProcInfo, GenInfo, VarSet, PragmaVars,
% ProcCode, ExtraCode):
%
% Generate C code to look up a fact table in a given mode.
% ProcCode is the C code for the procedure, ExtraCode is extra C code
% that should be included in the module. VarSet is the varset of
% the foreign_proc our caller should construct, and PragmaVars
% are its arguments.
%
% Model_non foreign_procs were not supported by the compiler when this
% code was written. To get around this, the C_ProcCode generated for
% model_non code pops off the stack frame that is automatically created
% by the compiler and jumps to the code contained in ExtraCode.
% ExtraCode declares the required labels and creates a new stack frame
% with the required number of framevars. It then does all the work required
% to look up the fact table.
%
:- pred fact_table_generate_c_code_for_proc(module_info::in, sym_name::in,
proc_id::in, proc_id::in, proc_info::in, fact_table_gen_info::in,
prog_varset::out, list(pragma_var)::out, string::out, string::out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module backend_libs.
:- import_module backend_libs.c_util.
:- import_module hlds.arg_info.
:- import_module hlds.code_model.
:- import_module hlds.hlds_error_util.
:- import_module hlds.hlds_llds.
:- import_module hlds.hlds_markers.
:- import_module hlds.hlds_proc_util.
:- import_module hlds.inst_test.
:- import_module hlds.mode_test.
:- import_module hlds.mode_util.
:- import_module libs.
:- import_module libs.file_util.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module libs.system_cmds.
:- import_module ll_backend.llds_out.
:- import_module ll_backend.llds_out.llds_out_data.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.builtin_lib_types.
:- import_module parse_tree.file_names.
:- import_module parse_tree.parse_tree_out_term.
:- import_module parse_tree.parse_tree_out_type.
:- import_module parse_tree.prog_foreign.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_util.
:- import_module assoc_list.
:- import_module bool.
:- import_module char.
:- import_module cord.
:- import_module float.
:- import_module int.
:- import_module integer.
:- import_module io.call_system.
:- import_module io.file.
:- import_module library.
:- import_module map.
:- import_module maybe.
:- import_module mercury_term_parser.
:- import_module pair.
:- import_module require.
:- import_module string.
:- import_module term.
:- import_module term_context.
:- import_module varset.
%---------------------------------------------------------------------------%
% This is the data structure we construct if the semantic checks
% on the fact table predicate and its procedures all succeed.
:- type fact_table_gen_info
---> fact_table_gen_info(
% Information about the arguments of the predicate.
fgti_arg_infos :: list(fact_arg_info),
% Information about each procedure of the predicate.
ftgi_proc_info_map :: fact_table_proc_map,
% We record the identities of kinds of procedures for use
% by fact_table_compile_facts: the procedure (if any)
% whose args are all inputs, and the procedures that have
% both input and output arguments.
ftgi_all_in_proc_id :: maybe(proc_id),
ftgi_in_out_proc_ids :: list(proc_id)
).
%---------------------%
% The most important information we record about each predicate argument
% is its type, which must be one of the types supported in fact tables.
% However, some parts of fact_table_compile_facts also want to know,
% for each argument, whether it has a given in mode in *any* procedure.
:- type fact_arg_info
---> fact_arg_info(
fact_arg_type,
maybe_input_for_some_mode,
maybe_in_or_output_for_some_mode
).
% XXX UINT - handle uints here too when we support them in fact tables.
:- type fact_arg_type
---> fact_arg_type_int
; fact_arg_type_float
; fact_arg_type_string.
:- type maybe_input_for_some_mode
---> is_not_input_for_any_mode
; is_input_for_some_mode.
% XXX I think the bool that this bespoke type replaces was originally
% meant to be set only for arguments that are output in some mode,
% but then the code whose job is to fill it in set if the arg
% is ever either input *or* output, which (since these are the only
% two modes we support in fact table predicates) means it is *always*
% set to is_in_or_output_for_some_mode.
:- type maybe_in_or_output_for_some_mode
---> is_not_in_or_output_for_any_mode
; is_in_or_output_for_some_mode.
%---------------------%
% We record, for each argument of each procedure,
%
% - the name of the C variable holding it,
% - whether its mode is input or output,
% - whether we need to make it unique when we copy it out of the table
% (this matters only for strings), and
% - the pragma var that should represent this argument in the
% foreign proc.
%
% All this info is in the fact_table_var type.
% The mode class effectively summarizes the arguments' modes, while
% the prog_varset here contains the variables in the pragma_vars,
%
:- type fact_table_proc_map == map(proc_id, fact_table_proc_info).
:- type fact_table_proc_info
---> fact_table_proc_info(
list(fact_table_var),
fact_table_mode_class,
prog_varset
).
:- type fact_table_var
---> fact_table_var(
ftv_name :: string,
ftv_mode :: fact_table_mode,
ftv_make_unique :: maybe_make_unique,
ftv_pragma_var :: pragma_var
).
:- type fact_table_mode
---> fully_in
; fully_out.
:- type maybe_make_unique
---> do_not_make_unique
; make_unique.
:- type fact_table_mode_class
---> all_in
; in_out
; all_out.
%---------------------------------------------------------------------------%
% Proc_stream contains information about an open sort file for
% a particular procedure.
%
:- type proc_stream
---> proc_stream(
proc_id, % ID of procedure.
list(fact_table_mode), % The modes of the arguments.
string, % The name of the sort file.
io.text_output_stream % Sort file stream.
).
:- type hash_entry
---> hash_entry(
fact_arg, % Lookup key.
hash_index, % Pointer to next hash table or index to fact data.
int % Position of next entry with same hash value.
).
% Data structure used to build up a hash table before writing it out
% as a C array.
:- type hash_table
---> hash_table(
int, % Size of hash table.
map(int, hash_entry)
).
:- type hash_index
---> fact(int) % Index into fact table.
; hash_table(int, string). % Hash table for next arg.
% Sort_file_line contains the information read in from a sort file
% after sorting.
:- type sort_file_line
---> sort_file_line(
list(fact_arg), % Input arguments.
int, % Index of fact in original file.
list(fact_arg) % Output arguments.
).
:- type fact_arg
---> fact_arg_int(int)
; fact_arg_float(float)
; fact_arg_string(string).
:- type inferred_determinism
---> inferred(determinism) % Determinism has been inferred.
; not_yet % Determinism has not yet been inferred.
; error. % An error occurred trying to infer
% determinism.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
fact_table_check_args(ModuleInfo, PragmaContext, PredId, PredInfo, Result) :-
pred_info_get_arg_types(PredInfo, Types),
(
Types = [],
% We can say "predicate" because a function has at least one argument,
% the result.
Pieces = [words("Error:"), pragma_decl("fact_table"),
words("declaration for a")] ++
color_as_incorrect([words("predicate without arguments.")]) ++
[nl],
Spec = spec($pred, severity_error, phase_fact_table_check,
PragmaContext, Pieces),
% Since there are no arguments, they cannot have an unsupported
% type or mode.
Result = fact_table_args_not_ok([Spec])
;
Types = [_ | _],
init_fact_arg_infos(PredInfo, Types, FactArgInfos0, [], TypeSpecs),
ProcIds = pred_info_all_procids(PredInfo),
(
ProcIds = [],
ModePieces = [words("Error:"), pragma_decl("fact_table"),
words("declaration for a predicate with")] ++
color_as_incorrect([words("no declared modes.")]) ++
[nl],
ModeSpec = spec($pred, severity_error, phase_fact_table_check,
PragmaContext, ModePieces),
ModeSpecs = [ModeSpec],
FactArgInfos = FactArgInfos0, % dummy; won't be used
map.init(FactTableProcMap), % dummy; won't be used
MaybeAllInProcId = no, % dummy; won't be used
InOutProcIds = [] % dummy; won't be used
;
ProcIds = [_ | _],
fact_table_check_proc_modes(ModuleInfo, PredId, PredInfo, ProcIds,
FactArgInfos0, FactArgInfos, map.init, FactTableProcMap,
[], RevAllInProcIds, [], RevInOutProcIds, [], ModeSpecs0),
list.reverse(RevAllInProcIds, AllInProcIds),
list.reverse(RevInOutProcIds, InOutProcIds),
(
AllInProcIds = [],
MaybeAllInProcId = no,
ModeSpecs = ModeSpecs0
;
AllInProcIds = [AllInProcId],
MaybeAllInProcId = yes(AllInProcId),
ModeSpecs = ModeSpecs0
;
AllInProcIds = [_, _ | _],
AllInPieces = [words("Error:"), pragma_decl("fact_table"),
words("declaration for a predicate with")] ++
color_as_incorrect([words("more than one mode"),
words("in which all arguments are input.")]) ++
[nl],
AllInSpec = spec($pred, severity_error,
phase_fact_table_check, PragmaContext, AllInPieces),
ModeSpecs = [AllInSpec | ModeSpecs0],
MaybeAllInProcId = no % dummy; won't be used
)
),
Specs = TypeSpecs ++ ModeSpecs,
(
Specs = [],
GenInfo = fact_table_gen_info(FactArgInfos, FactTableProcMap,
MaybeAllInProcId, InOutProcIds),
Result = fact_table_args_ok(GenInfo)
;
Specs = [_ | _],
Result = fact_table_args_not_ok(Specs)
)
).
:- pred fact_table_check_proc_modes(module_info::in, pred_id::in,
pred_info::in, list(proc_id)::in,
list(fact_arg_info)::in, list(fact_arg_info)::out,
fact_table_proc_map::in, fact_table_proc_map::out,
list(proc_id)::in, list(proc_id)::out,
list(proc_id)::in, list(proc_id)::out,
list(error_spec)::in, list(error_spec)::out) is det.
fact_table_check_proc_modes(_, _, _, [],
!FactArgInfos, !FactTableProcMap,
!RevAllInProcIds, !RevInOutProcIds, !Specs).
fact_table_check_proc_modes(ModuleInfo, PredId, PredInfo, [ProcId | ProcIds],
!FactArgInfos, !FactTableProcMap,
!RevAllInProcIds, !RevInOutProcIds, !Specs) :-
pred_info_get_arg_types(PredInfo, ArgTypes),
pred_info_get_proc_table(PredInfo, ProcTable),
map.lookup(ProcTable, ProcId, ProcInfo),
proc_info_get_argmodes(ProcInfo, ArgModes),
PredProcId = proc(PredId, ProcId),
varset.init(VarSet0),
check_proc_arg_modes(ModuleInfo, PredProcId, ProcInfo,
1, ArgTypes, ArgModes, FactTableVars, VarSet0, VarSet,
[], ArgModeSpecs),
(
ArgModeSpecs = [_ | _],
!:Specs = ArgModeSpecs ++ !.Specs
% There is no point in processing this procedure any further.
;
ArgModeSpecs = [],
FactTableModes = list.map((func(fact_table_var(_, M, _, _)) = M),
FactTableVars),
fill_in_fact_arg_infos(FactTableModes, !FactArgInfos),
list.sort_and_remove_dups(FactTableModes, PresentModes),
( if PresentModes = [fully_in] then
ModeClass = all_in,
!:RevAllInProcIds = [ProcId | !.RevAllInProcIds]
else if PresentModes = [fully_in, fully_out] then
ModeClass = in_out,
!:RevInOutProcIds = [ProcId | !.RevInOutProcIds]
else if PresentModes = [fully_out] then
ModeClass = all_out
else
unexpected($pred, "impossible mode class")
),
FactTableProcInfo =
fact_table_proc_info(FactTableVars, ModeClass, VarSet),
map.det_insert(ProcId, FactTableProcInfo, !FactTableProcMap)
),
fact_table_check_proc_modes(ModuleInfo, PredId, PredInfo, ProcIds,
!FactArgInfos, !FactTableProcMap,
!RevAllInProcIds, !RevInOutProcIds, !Specs).
%-------------%
% Initialise list of fact argument information. Input and output flags
% are initialised to `no' and filled in correctly by
% infer_determinism_pass_1.
%
:- pred init_fact_arg_infos(pred_info::in, list(mer_type)::in,
list(fact_arg_info)::out,
list(error_spec)::in, list(error_spec)::out) is det.
init_fact_arg_infos(_, [], [], !Specs).
init_fact_arg_infos(PredInfo, [Type | Types], [Info | Infos], !Specs) :-
( if
Type = builtin_type(BuiltinType),
(
BuiltinType = builtin_type_int(int_type_int),
FactArgTypePrime = fact_arg_type_int
;
BuiltinType = builtin_type_float,
FactArgTypePrime = fact_arg_type_float
;
BuiltinType = builtin_type_string,
FactArgTypePrime = fact_arg_type_string
)
then
FactArgType = FactArgTypePrime
else
pred_info_get_typevarset(PredInfo, TVarSet),
TypeStr = mercury_type_to_string(TVarSet, print_name_only, Type),
pred_info_get_context(PredInfo, Context),
Pieces = [words("Error: type")] ++
color_as_subject([quote(TypeStr)]) ++
[words("is")] ++
color_as_incorrect([words("not allowed")]) ++
[words("in fact tables."),
words("The only types allowed in fact tables are")] ++
color_as_correct([quote("int"), suffix(","),
quote("float"), suffix(",")]) ++
[words("and")] ++
color_as_correct([quote("string"), suffix(".")]) ++
[nl],
add_error_context_and_pieces(Context, Pieces, !Specs),
FactArgType = fact_arg_type_int % Dummy; won't be used.
),
Info = fact_arg_info(FactArgType,
is_not_input_for_any_mode, is_not_in_or_output_for_any_mode),
init_fact_arg_infos(PredInfo, Types, Infos, !Specs).
:- pred check_proc_arg_modes(module_info::in, pred_proc_id::in, proc_info::in,
int::in, list(mer_type)::in, list(mer_mode)::in, list(fact_table_var)::out,
prog_varset::in, prog_varset::out,
list(error_spec)::in, list(error_spec)::out) is det.
check_proc_arg_modes(_, _, _, _, [], [], [], !VarSet, !Specs).
check_proc_arg_modes(_, _, _, _, [], [_ | _], _, !VarSet, !Specs) :-
unexpected($pred, "list length mismatch").
check_proc_arg_modes(_, _, _, _, [_ | _], [], _, !VarSet, !Specs) :-
unexpected($pred, "list length mismatch").
check_proc_arg_modes(ModuleInfo, PredProcId, ProcInfo,
ArgNum, [Type | Types], [Mode | Modes],
[FactTableVar | FactTableVars], !VarSet, !Specs) :-
( if mode_get_insts_semidet(ModuleInfo, Mode, _, FinalInst) then
( if mode_is_fully_input(ModuleInfo, Type, Mode) then
FactTableMode = fully_in
else if mode_is_fully_output(ModuleInfo, Type, Mode) then
FactTableMode = fully_out
else
ProcPieces = describe_one_proc_name(ModuleInfo, yes(color_subject),
should_not_module_qualify, PredProcId),
proc_info_get_context(ProcInfo, Context),
Pieces = [words("Error: the"), pragma_decl("fact_table"),
words("declaration requires all the arguments of")] ++
ProcPieces ++
[words("to be either fully input or fully output,"),
words("but the"), nth_fixed(ArgNum), words("argument is")] ++
color_as_incorrect([words("neither.")]) ++
[nl],
Spec = spec($pred, severity_error, phase_fact_table_check,
Context, Pieces),
!:Specs = [Spec | !.Specs],
FactTableMode = fully_in % dummy; won't be used.
),
( if inst_is_not_partly_unique(ModuleInfo, FinalInst) then
MakeUnique = do_not_make_unique
else
MakeUnique = make_unique
)
else
% Module qualification will catch and report this error,
% so generating an error message here for the user would be redundant.
% However, we *did* find an error that prevents us from generating
% fact table code for this procedure, and we have to signal this
% by an error_spec. So we generate and return an empty error_spec.
proc_info_get_context(ProcInfo, Context),
Spec = spec($pred, severity_error, phase_fact_table_check,
Context, []),
!:Specs = [Spec | !.Specs],
FactTableMode = fully_in, % dummy; won't be used.
MakeUnique = do_not_make_unique % dummy; won't be used.
),
% The name we set is the default name for an unnamed variable,
% because old hand-written C code uses this name.
% This works only because for variables in foreign_procs never have
% their variable numbers appended to their name, precisely to avoid
% mismatches with the foreign language code inside the foreign_proc.
string.format("V_%d", [i(ArgNum)], VarName),
varset.new_named_var(VarName, Var, !VarSet),
PragmaVar = pragma_var(Var, VarName, Mode, bp_native_if_possible),
FactTableVar =
fact_table_var(VarName, FactTableMode, MakeUnique, PragmaVar),
check_proc_arg_modes(ModuleInfo, PredProcId, ProcInfo,
ArgNum + 1, Types, Modes, FactTableVars, !VarSet, !Specs).
:- pred fill_in_fact_arg_infos(list(fact_table_mode)::in,
list(fact_arg_info)::in, list(fact_arg_info)::out) is det.
fill_in_fact_arg_infos([], [], []).
fill_in_fact_arg_infos([_ | _], [], _) :-
unexpected($pred, "too many argmodes").
fill_in_fact_arg_infos([], [_ | _], _) :-
unexpected($pred, "too many fact_arg_infos").
fill_in_fact_arg_infos([FactTableMode | FactTableModes],
[Info0 | Infos0], [Info | Infos]) :-
Info0 = fact_arg_info(Type, IsInput, _IsOutput),
(
FactTableMode = fully_in,
% XXX Info = fact_arg_info(Type, yes, IsOutput)
% XXX currently the first input mode requires _all_ arguments to be
% written in the fact data table so it can do lookups on backtracking.
% This may change if it is found to be less efficient than doing these
% lookups via the hash table.
Info = fact_arg_info(Type,
is_input_for_some_mode, is_in_or_output_for_some_mode)
;
FactTableMode = fully_out,
Info = fact_arg_info(Type, IsInput, is_in_or_output_for_some_mode)
),
fill_in_fact_arg_infos(FactTableModes, Infos0, Infos).
%---------------------------------------------------------------------------%
fact_table_compile_facts(ProgressStream, ModuleInfo, FactTableFileName,
Context, GenInfo, HeaderCode, PrimaryProcId, !PredInfo, !Specs, !IO) :-
module_info_get_globals(ModuleInfo, Globals),
io.open_input(FactTableFileName, FactTableFileResult, !IO),
(
FactTableFileResult = ok(FactTableFileStream),
% XXX LEGACY
fact_table_file_name_return_dirs(Globals, $pred,
ext_cur_ngs_gs(ext_cur_ngs_gs_target_c), FactTableFileName,
Dirs, _DirsProposed, OutputFileName, _OutFileNameProposed),
create_any_dirs_on_path(Dirs, !IO),
io.open_output(OutputFileName, OpenResult, !IO),
(
OpenResult = ok(OutputStream),
pred_info_get_module_name(!.PredInfo, ModuleName),
pred_info_get_name(!.PredInfo, PredName),
PredSymName = qualified(ModuleName, PredName),
fact_table_size(Globals, FactTableSize),
get_maybe_progress_output_stream(ModuleInfo, ProgressStream,
MaybeProgressStream),
compile_fact_table_in_file(MaybeProgressStream,
FactTableFileStream, FactTableFileName, OutputStream,
FactTableSize, ModuleInfo, PredSymName, GenInfo,
HeaderCode, PrimaryProcId, MaybeDataFileName,
!PredInfo, !Specs, !IO),
io.close_output(OutputStream, !IO),
(
MaybeDataFileName = no
;
MaybeDataFileName = yes(DataFileName),
append_data_table(MaybeProgressStream,
OutputFileName, DataFileName, !Specs, !IO)
)
;
OpenResult = error(Error),
add_file_open_error(yes(Context), FactTableFileName, "output",
Error, !Specs, !IO),
HeaderCode = "",
PrimaryProcId = invalid_proc_id
),
io.close_input(FactTableFileStream, !IO)
;
FactTableFileResult = error(Error),
pred_info_get_markers(!.PredInfo, PredMarkers0),
add_marker(marker_fact_table_semantic_errors,
PredMarkers0, PredMarkers),
pred_info_set_markers(PredMarkers, !PredInfo),
add_file_open_error(yes(Context), FactTableFileName, "input",
Error, !Specs, !IO),
HeaderCode = "",
PrimaryProcId = invalid_proc_id
).
:- pred compile_fact_table_in_file(maybe(io.text_output_stream)::in,
io.text_input_stream::in, string::in, io.text_output_stream::in,
int::in, module_info::in, sym_name::in, fact_table_gen_info::in,
string::out, proc_id::out, maybe(string)::out,
pred_info::in, pred_info::out,
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
compile_fact_table_in_file(MaybeProgressStream, FileStream, FileName,
OutputStream, FactTableSize, ModuleInfo, PredSymName, GenInfo,
HeaderCode, PrimaryProcId, MaybeDataFileName,
!PredInfo, !Specs, !IO) :-
infer_determinism_pass_1(GenInfo, WriteHashTables, WriteDataTable,
!PredInfo),
create_fact_table_header(PredSymName, FactArgInfos,
HeaderCode0, StructName),
GenInfo = fact_table_gen_info(FactArgInfos, FactTableProcMap,
MaybeAllInProcId, InOutProcIds),
% We need to get the order right for CheckProcs because the first
% procedure in list is used to derive the primary lookup key.
% XXX Document what "getting the order right" means ...
%
% If there is an all_in procedure, it needs to be put on the end of
% the list so a sort file is created for it. This is required when
% building the hash table, not for determinism inference.
(
MaybeAllInProcId = yes(AllInProcId),
CheckProcs = InOutProcIds ++ [AllInProcId]
;
MaybeAllInProcId = no,
CheckProcs = InOutProcIds
),
io.write_string(OutputStream, fact_table_file_header(FileName), !IO),
io.write_string(OutputStream, HeaderCode0, !IO),
open_sort_files(FactTableProcMap, CheckProcs, ProcStreams,
[], OpenSpecs, !IO),
% As the documentation on the fact_table_size predicate says,
% we impose a limit on the size of the arrays we generate.
% The data table may need to be broken into pieces to respect
% this limit.
%
% The nice way to do this would be to
%
% - generate all the array entries we need,
% - break them into chunks that respect the maximum size, and then
% - write out each chunk with its prologue and epilogue, with
% the prologue containing the start of the subarray's definition,
% including an opening brace, and the prologue containing
% the matching close brace and the final semicolon.
%
% This two level loop (first over the chunks, then over the entries
% in each chunk) is nice because there is a natural place to put
% the prologues and epilogues.
%
% Unfortunately, this design also requires the whole array to be
% in memory at the same time. Since fact tables may be extremely large,
% we want to avoid this. We therefore adopt a cruder approach using
% a single loop over the entries. In this approach, most loop
% iterations just process one entry, but when the entry is the last
% entry in what *would have been* a chunk, we also output the epilogue,
% and if there are any more entries after it, then the prologue as
% well. This requires us to handle the initial prologue and the final
% epilogue here, outside the loop.
(
WriteDataTable = write_data_table,
(
CheckProcs = [],
MaybeOutput = yes(OutputStream - StructName),
% Outputs opening brace for first fact array.
write_new_data_array_opening_brace(OutputStream, StructName,
0, !IO),
WriteDataAfterSorting = do_not_write_data_table
;
CheckProcs = [_ | _],
MaybeOutput = no,
WriteDataAfterSorting = write_data_table
)
;
WriteDataTable = do_not_write_data_table,
MaybeOutput = no,
WriteDataAfterSorting = do_not_write_data_table
),
list.length(FactArgInfos, NumFactArgInfos),
FactNum0 = 0,
CompileSpecs0 = [],
read_in_and_compile_facts(FileStream, FileName, MaybeProgressStream,
FactTableSize, !.PredInfo, NumFactArgInfos, FactArgInfos,
ProcStreams, MaybeOutput, FactNum0, FactNum,
CompileSpecs0, CompileSpecs, !IO),
NumFacts = FactNum,
(
MaybeOutput = yes(_),
% Outputs closing brace for last fact array.
write_closing_brace(OutputStream, !IO),
write_fact_table_pointer_array(OutputStream, FactTableSize,
StructName, NumFacts, HeaderCode2, !IO)
;
MaybeOutput = no,
HeaderCode2 = ""
),
close_sort_files(ProcStreams, ProcFiles, !IO),
OpenCompileSpecs = OpenSpecs ++ CompileSpecs,
(
OpenCompileSpecs = [],
pred_info_get_proc_table(!.PredInfo, ProcTable0),
infer_determinism_pass_2(MaybeProgressStream, GenInfo, ProcFiles,
ProcTable0, ProcTable, !Specs, !IO),
pred_info_set_proc_table(ProcTable, !PredInfo),
io.file.make_temp_file(DataFileNameResult, !IO),
(
DataFileNameResult = ok(DataFileName),
write_fact_table_arrays(MaybeProgressStream, OutputStream,
FactTableSize, ModuleInfo, ProcFiles, DataFileName,
FactTableProcMap, StructName, NumFacts, FactArgInfos,
WriteHashTables, WriteDataAfterSorting,
HeaderCode1, PrimaryProcId, !Specs, !IO),
write_fact_table_numfacts(OutputStream, PredSymName, NumFacts,
HeaderCode3, !IO),
HeaderCode =
HeaderCode0 ++ HeaderCode1 ++ HeaderCode2 ++ HeaderCode3,
MaybeDataFileName = yes(DataFileName)
;
DataFileNameResult = error(Error),
TmpPieces = [words("Could not create temporary file:"),
quote(io.error_message(Error)), nl],
add_error_pieces(TmpPieces, !Specs),
HeaderCode = HeaderCode0,
PrimaryProcId = invalid_proc_id,
MaybeDataFileName = no
)
;
OpenCompileSpecs = [_ | _],
!:Specs = OpenCompileSpecs ++ !.Specs,
pred_info_get_markers(!.PredInfo, PredMarkers0),
add_marker(marker_fact_table_semantic_errors,
PredMarkers0, PredMarkers),
pred_info_set_markers(PredMarkers, !PredInfo),
HeaderCode = HeaderCode0,
PrimaryProcId = invalid_proc_id,
MaybeDataFileName = no
).
%---------------------------------------------------------------------------%
:- type maybe_write_hash_tables
---> do_not_write_hash_tables
; write_hash_tables.
:- type maybe_write_data_table
---> do_not_write_data_table
; write_data_table.
% First pass of determinism inference. (out, out, ..., out) procs are
% multi and (in, in, .., in) procs are semidet. Return a list of procs
% containing both in's and out's. These need further analysis later
% in pass 2.
%
:- pred infer_determinism_pass_1(fact_table_gen_info::in,
maybe_write_hash_tables::out, maybe_write_data_table::out,
pred_info::in, pred_info::out) is det.
infer_determinism_pass_1(GenInfo,
WriteHashTables, WriteDataTable, !PredInfo) :-
pred_info_get_proc_table(!.PredInfo, ProcTable0),
ProcIds = pred_info_all_procids(!.PredInfo),
infer_procs_determinism_pass_1(GenInfo, ProcIds,
ProcTable0, ProcTable,
do_not_write_hash_tables, WriteHashTables,
do_not_write_data_table, WriteDataTable),
pred_info_set_proc_table(ProcTable, !PredInfo).
:- pred infer_procs_determinism_pass_1(fact_table_gen_info::in,
list(proc_id)::in, proc_table::in, proc_table::out,
maybe_write_hash_tables::in, maybe_write_hash_tables::out,
maybe_write_data_table::in, maybe_write_data_table::out) is det.
infer_procs_determinism_pass_1(_, [],
!ProcTable, !WriteHashTables, !WriteDataTable).
infer_procs_determinism_pass_1(GenInfo, [ProcId | ProcIds],
!ProcTable, !WriteHashTables, !WriteDataTable) :-
map.lookup(!.ProcTable, ProcId, ProcInfo0),
GenInfo = fact_table_gen_info(_, FactTableProcMap, _, _),
map.lookup(FactTableProcMap, ProcId, FactTableProcInfo),
FactTableProcInfo = fact_table_proc_info(_, ModeClass, _),
(
ModeClass = all_in,
InferredDetism = inferred(detism_semi),
!:WriteHashTables = write_hash_tables
;
ModeClass = all_out,
proc_info_get_declared_determinism(ProcInfo0, MaybeDetism),
( if
MaybeDetism = yes(Detism),
( Detism = detism_cc_multi
; Detism = detism_cc_non
)
then
InferredDetism = inferred(detism_cc_multi)
else
InferredDetism = inferred(detism_multi)
),
!:WriteDataTable = write_data_table
;
ModeClass = in_out,
% Don't have enough info to infer determinism yet.
% Put it off till the second pass.
InferredDetism = not_yet,
% Add to list and check in pass 2.
!:WriteHashTables = write_hash_tables,
!:WriteDataTable = write_data_table
),
( if InferredDetism = inferred(Determinism) then
proc_info_set_inferred_determinism(Determinism,
ProcInfo0, ProcInfo),
map.det_update(ProcId, ProcInfo, !ProcTable)
else
true
),
infer_procs_determinism_pass_1(GenInfo, ProcIds,
!ProcTable, !WriteHashTables, !WriteDataTable).
%---------------------------------------------------------------------------%
% Read in facts one by one and check and compile them.
%
:- pred read_in_and_compile_facts(io.text_input_stream::in, string::in,
maybe(io.text_output_stream)::in, int::in, pred_info::in,
int::in, list(fact_arg_info)::in, list(proc_stream)::in,
maybe(pair(io.text_output_stream, string))::in, int::in, int::out,
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
read_in_and_compile_facts(FileStream, FileName, MaybeProgressStream,
FactTableSize, PredInfo, NumFactArgInfos, FactArgInfos,
ProcStreams, MaybeOutput, !FactNum, !Specs, !IO) :-
mercury_term_parser.read_term(FileStream, Result0, !IO),
(
Result0 = eof
;
Result0 = error(Message, LineNum),
Context = context(FileName, LineNum),
add_error_context_and_pieces(Context, [words(Message)], !Specs)
;
Result0 = term(VarSet, Term),
( if 0 = !.FactNum mod FactTableSize then
(
MaybeProgressStream = yes(ProgressStream),
io.format(ProgressStream, "%% Read fact %d\n",
[i(!.FactNum)], !IO)
;
MaybeProgressStream = no
)
else
true
),
check_fact_term(FileStream, FileName, MaybeProgressStream,
FactTableSize, PredInfo, NumFactArgInfos, FactArgInfos,
!.FactNum, VarSet, Term, ProcStreams, MaybeOutput,
CheckSpecs, !IO),
(
CheckSpecs = [],
!:FactNum = !.FactNum + 1
;
CheckSpecs = [_ | _],
!:Specs = CheckSpecs ++ !.Specs
),
read_in_and_compile_facts(FileStream, FileName, MaybeProgressStream,
FactTableSize, PredInfo, NumFactArgInfos, FactArgInfos,
ProcStreams, MaybeOutput, !FactNum, !Specs, !IO)
).
% Do syntactic and semantic checks on a fact term.
%
:- pred check_fact_term(io.text_input_stream::in, string::in,
maybe(io.text_output_stream)::in, int::in, pred_info::in,
int::in, list(fact_arg_info)::in, int::in, prog_varset::in, prog_term::in,
list(proc_stream)::in, maybe(pair(io.text_output_stream, string))::in,
list(error_spec)::out, io::di, io::uo) is det.
check_fact_term(FileStream, FileName, MaybeProgressStream, FactTableSize,
PredInfo, NumFactArgInfos, FactArgInfos, FactNum,
VarSet, Term, ProcStreams, MaybeOutput, Specs, !IO) :-
(
Term = term.variable(_, _),
io.get_line_number(FileStream, LineNum, !IO),
Context = context(FileName, LineNum),
Pieces = [words("Error: this term is")] ++
color_as_incorrect([words("not a fact.")]) ++
[nl],
add_error_context_and_pieces(Context, Pieces, [], Specs)
;
Term = term.functor(Functor, ArgTerms0, Context),
( if Functor = term.atom(FunctorAtom) then
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
pred_info_get_name(PredInfo, PredName),
( if
(
PredOrFunc = pf_predicate,
FunctorAtom = PredName,
ArgTerms = ArgTerms0
;
PredOrFunc = pf_function,
FunctorAtom = "=",
ArgTerms0 = [BeforeEqualTerm, ResultTerm],
BeforeEqualTerm =
term.functor(term.atom(PredName), BeforeEqualTerms, _),
ArgTerms = BeforeEqualTerms ++ [ResultTerm]
)
then
check_fact_term_args(MaybeProgressStream, FactTableSize,
PredInfo, NumFactArgInfos, FactArgInfos,
FactNum, VarSet, ArgTerms, Context,
ProcStreams, MaybeOutput, Specs, !IO)
else
PredDotPieces = describe_one_pred_info_name(yes(color_subject),
should_not_module_qualify, [suffix(".")], PredInfo),
Pieces = [words("Error: this clause is")] ++
color_as_incorrect([words("not")]) ++
[words("for")] ++ PredDotPieces ++ [nl],
add_error_context_and_pieces(Context, Pieces, [], Specs)
)
else
Pieces = [words("Error: this term is")] ++
color_as_incorrect([words("not a fact.")]) ++
[nl],
add_error_context_and_pieces(Context, Pieces, [], Specs)
)
).
:- pred check_fact_term_args(maybe(io.text_output_stream)::in, int::in,
pred_info::in, int::in, list(fact_arg_info)::in,
int::in, prog_varset::in, list(prog_term)::in, prog_context::in,
list(proc_stream)::in, maybe(pair(io.text_output_stream, string))::in,
list(error_spec)::out, io::di, io::uo) is det.
check_fact_term_args(MaybeProgressStream, FactTableSize, PredInfo,
NumFactArgInfos, FactArgInfos, FactNum, VarSet, ArgTerms, Context,
ProcStreams, MaybeOutput, Specs, !IO) :-
% Check that arity of the fact is correct.
list.length(ArgTerms, NumArgTerms),
( if NumFactArgInfos = NumArgTerms then
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
check_fact_type_and_mode(PredOrFunc, VarSet,
FactArgInfos, ArgTerms, 1, FactArgs, [], Specs),
% XXX We should probably avoid executing some of the code below
% if Specs is not empty.
string.int_to_string(FactNum, FactNumStr),
write_sort_file_lines(FactNumStr, FactArgs,
is_primary_proc(FactArgInfos), ProcStreams, !IO),
% If there are no in_out modes to the predicate, we need to write out
% the facts at this point. If there are input modes, the facts are
% written out later on after being sorted on the first input mode.
( if
MaybeOutput = yes(OutputStream - StructName),
Specs = []
then
write_fact_data(OutputStream, MaybeProgressStream, FactTableSize,
StructName, FactArgs, FactNum, !IO)
else
% If list.map above fails, don't do anything here. The error will
% have already been reported in check_fact_type_and_mode.
true
)
else
Pieces = [words("Error: fact has wrong number of arguments."),
words("Expected")] ++
color_as_correct([int_name(NumFactArgInfos)]) ++
[words("arguments,"), words("got")] ++
color_as_incorrect([int_name(NumArgTerms), suffix(".")]) ++
[nl],
add_error_context_and_pieces(Context, Pieces, [], Specs)
).
% Check that the mode of the fact is correct. All terms must be ground
% and be a constant of the expected type.
%
:- pred check_fact_type_and_mode(pred_or_func::in, prog_varset::in,
list(fact_arg_info)::in, list(prog_term)::in, int::in, list(fact_arg)::out,
list(error_spec)::in, list(error_spec)::out) is det.
check_fact_type_and_mode(_, _, [], [], _, [], !Specs).
check_fact_type_and_mode(_, _, [_ | _], [], _, _, !Specs) :-
unexpected($pred, "list length mismatch").
check_fact_type_and_mode(_, _, [], [_ | _], _, _, !Specs) :-
unexpected($pred, "list length mismatch").
check_fact_type_and_mode(PredOrFunc, VarSet,
[ArgInfo | ArgInfos], [ArgTerm | ArgTerms], ArgNum,
[FactArg | FactArgs], !Specs) :-
(
ArgTerm = term.variable(_, _),
report_arg_error(PredOrFunc, VarSet, ArgNum, ArgTerm, ArgTerms,
"Mode", "a", "ground term", FactArg, !Specs)
;
ArgTerm = term.functor(Functor, _SubTerms, _Context),
% The term parser should never generate an int, a float or a string
% with a nonempty list of subterms.
ArgInfo = fact_arg_info(ArgType, _, _),
(
ArgType = fact_arg_type_int,
( if Functor = term.integer(Base, Integer, signed, size_word) then
( if source_integer_to_int(Base, Integer, Int) then
FactArg = fact_arg_int(Int)
else
report_arg_error(PredOrFunc, VarSet, ArgNum,
ArgTerm, ArgTerms,
"Type", "an", "int that fits in a word",
FactArg, !Specs)
)
else
report_arg_error(PredOrFunc, VarSet, ArgNum, ArgTerm, ArgTerms,
"Type", "an", "int", FactArg, !Specs)
)
;
ArgType = fact_arg_type_float,
( if Functor = term.float(Float) then
FactArg = fact_arg_float(Float)
else
report_arg_error(PredOrFunc, VarSet, ArgNum, ArgTerm, ArgTerms,
"Type", "a", "float", FactArg, !Specs)
)
;
ArgType = fact_arg_type_string,
( if Functor = term.string(Str) then
FactArg = fact_arg_string(Str)
else
report_arg_error(PredOrFunc, VarSet, ArgNum, ArgTerm, ArgTerms,
"Type", "a", "string", FactArg, !Specs)
)
)
),
check_fact_type_and_mode(PredOrFunc, VarSet,
ArgInfos, ArgTerms, ArgNum + 1, FactArgs, !Specs).
:- pred report_arg_error(pred_or_func::in, prog_varset::in, int::in,
prog_term::in, list(prog_term)::in, string::in, string::in, string::in,
fact_arg::out, list(error_spec)::in, list(error_spec)::out) is det.
report_arg_error(PredOrFunc, VarSet, ArgNum, ArgTerm, RemainingArgTerms,
TypeOrMode, AAn, Expected, DummyFactArg, !Specs) :-
ArgStr = describe_error_term(VarSet, ArgTerm),
ExpectedGotPieces = [words("expected"), words(AAn)] ++
color_as_correct([words(Expected), suffix(",")]) ++
[words("got")] ++
color_as_incorrect([quote(ArgStr), suffix(".")]) ++
[nl],
( if
PredOrFunc = pf_function,
RemainingArgTerms = []
then
Pieces = [words(TypeOrMode), words("error in"),
words("return value of function:") | ExpectedGotPieces]
else
Pieces = [words(TypeOrMode), words("error in"),
words("argument"), int_fixed(ArgNum), suffix(":")
| ExpectedGotPieces]
),
Context = get_term_context(ArgTerm),
add_error_context_and_pieces(Context, Pieces, !Specs),
DummyFactArg = fact_arg_string("dummy").
%---------------------------------------------------------------------------%
:- func fact_table_file_header(string) = string.
fact_table_file_header(FileName) = FileHeader :-
library.version(Version, Fullarch),
string.append_list(
["/*\n",
"** Automatically generated from `", FileName, "'\n",
"** by the Mercury compiler, version ", Version, ",\n",
"** configured for ", Fullarch, ".\n",
"** Do not edit.\n",
"*/\n",
"\n",
"#include ""mercury_imp.h""\n\n"],
FileHeader).
:- pred create_fact_table_header(sym_name::in, list(fact_arg_info)::in,
string::out, string::out) is det.
create_fact_table_header(PredSymName, FactArgInfos, HeaderCode, StructName) :-
make_fact_table_identifier(PredSymName, Identifier),
StructName = "mercury__" ++ Identifier ++ "_fact_table",
% Define a struct for a fact table entry.
create_fact_table_struct(FactArgInfos, 1, StructContents),
( if StructContents = "" then
StructDef = ""
else
StructDef = "struct " ++ StructName ++ "_struct {\n"
++ StructContents ++ "};\n\n"
),
HashDef = hash_def,
HeaderCode = StructDef ++ HashDef.
% Create a struct for the fact table consisting of any arguments
% that are output in some mode. Also ensure that are arguments are
% either string, float or int.
%
:- pred create_fact_table_struct(list(fact_arg_info)::in, int::in, string::out)
is det.
create_fact_table_struct([], _, "").
create_fact_table_struct([Info | Infos], ArgNum, StructContents) :-
create_fact_table_struct(Infos, ArgNum + 1, StructContentsTail),
Info = fact_arg_info(Type, _IsInput, IsOutput),
(
Type = fact_arg_type_int,
TypeStr = "MR_Integer"
;
Type = fact_arg_type_float,
TypeStr = "MR_Float"
;
Type = fact_arg_type_string,
TypeStr = "MR_ConstString"
),
(
IsOutput = is_in_or_output_for_some_mode,
string.format("\t%s V_%d;\n", [s(TypeStr), i(ArgNum)], StructField),
string.append(StructField, StructContentsTail, StructContents)
;
IsOutput = is_not_in_or_output_for_any_mode,
StructContents = StructContentsTail
).
% Define a struct for a hash table entry.
%
:- func hash_def = string.
hash_def = "
#ifndef MERCURY_FACT_TABLE_HASH_TABLES
#define MERCURY_FACT_TABLE_HASH_TABLES
struct MR_fact_table_hash_table_s {
MR_Integer size; // size of the hash table
struct MR_fact_table_hash_entry_s *table; // the actual table
};
struct MR_fact_table_hash_table_f {
MR_Integer size; // size of the hash table
struct MR_fact_table_hash_entry_f *table; // the actual table
};
struct MR_fact_table_hash_table_i {
MR_Integer size; // size of the hash table
struct MR_fact_table_hash_entry_i *table; // the actual table
};
// hash table for string keys
struct MR_fact_table_hash_entry_s {
MR_ConstString key; // lookup key
const MR_Word *index; // index into fact table data array or
// pointer to hash table for next argument
#if TAGBITS < 2
short type; // 0 if entry empty,
// 1 if entry is a pointer to the data table
// 2 if entry is a pointer to another
// hash table
#endif
int next; // location of next entry with the same hash
// value
};
// hash table for float keys
struct MR_fact_table_hash_entry_f {
MR_Float key;
const MR_Word *index;
#if TAGBITS < 2
short type;
#endif
int next;
};
// hash table for int keys
struct MR_fact_table_hash_entry_i {
MR_Integer key;
const MR_Word *index;
#if TAGBITS < 2
short type;
#endif
int next;
};
#if TAGBITS >= 2
#define MR_FACT_TABLE_MAKE_TAGGED_INDEX(i, t) \
MR_mkword(MR_mktag(t), MR_mkbody(i))
#define MR_FACT_TABLE_MAKE_TAGGED_POINTER(p, t) \
MR_mkword(MR_mktag(t), p)
#define MR_FACT_TABLE_HASH_ENTRY_TYPE(p) \
MR_tag((MR_Word)((p).index))
#define MR_FACT_TABLE_HASH_INDEX(w) \
MR_unmkbody(w)
#define MR_FACT_TABLE_HASH_POINTER(w) \
MR_body(w, MR_tag(w))
#else
#define MR_FACT_TABLE_MAKE_TAGGED_INDEX(i, t) \
((const MR_Word *) i), (t)
#define MR_FACT_TABLE_MAKE_TAGGED_POINTER(p, t) \
((const MR_Word *) p), (t)
#define MR_FACT_TABLE_HASH_ENTRY_TYPE(p) ((p).type)
#define MR_FACT_TABLE_HASH_INDEX(w) (w)
#define MR_FACT_TABLE_HASH_POINTER(w) (w)
#endif
#endif // not MERCURY_FACT_TABLE_HASH_TABLES
".
%---------------------------------------------------------------------------%
% open_sort_files(ProcIds, ProcStreams):
%
% Open a temporary sort file for each proc_id in ProcIds.
% Return a list of proc_streams for all the files opened.
%
:- pred open_sort_files(fact_table_proc_map::in,
list(proc_id)::in, list(proc_stream)::out,
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
open_sort_files(_, [], [], !Specs, !IO).
open_sort_files(ProcMap, [HeadProcId | TailProcIds], ProcStreams,
!Specs, !IO) :-
open_temp_output(SortFileNameResult, !IO),
(
SortFileNameResult = ok({SortFileName, Stream}),
map.lookup(ProcMap, HeadProcId, ProcEntry),
ProcEntry = fact_table_proc_info(FactTableVars, _, _),
Modes = list.map((func(fact_table_var(_, M, _, _)) = M),
FactTableVars),
HeadProcStream = proc_stream(HeadProcId, Modes, SortFileName, Stream),
open_sort_files(ProcMap, TailProcIds, TailProcStreams, !Specs, !IO),
ProcStreams = [HeadProcStream | TailProcStreams]
;
SortFileNameResult = error(ErrorMessage),
ProcStreams = [],
add_error_pieces([words(ErrorMessage)], !Specs)
).
% close_sort_files(ProcStreams, ProcFiles, !IO):
%
% Close the sort file of each procedure, and return its name.
%
:- pred close_sort_files(list(proc_stream)::in,
assoc_list(proc_id, string)::out, io::di, io::uo) is det.
close_sort_files([], [], !IO).
close_sort_files([ProcStream | ProcStreams], [ProcId - FileName | ProcFiles],
!IO) :-
ProcStream = proc_stream(ProcId, _Modes, FileName, Stream),
io.close_output(Stream, !IO),
close_sort_files(ProcStreams, ProcFiles, !IO).
%---------------------%
:- type maybe_primary_proc
---> is_not_primary_proc
; is_primary_proc(list(fact_arg_info)).
% write_sort_file_lines(ModuleInfo, ProcStreams, ProcTable, Terms):
%
% Write out a line to each sort file for this fact. The line is made up
% of the input arguments of the procedure (the key) followed by the
% position of the fact in the original input table.
%
% Note lines written out here need to be read back in by
% read_sort_file_line, so if any changes are made here, corresponding
% changes should be made there too.
%
:- pred write_sort_file_lines(string::in, list(fact_arg)::in,
maybe_primary_proc::in, list(proc_stream)::in, io::di, io::uo) is det.
write_sort_file_lines(_, _, _, [], !IO).
write_sort_file_lines(FactNumStr, FactArgs, IsPrimary,
[ProcStream | ProcStreams], !IO) :-
ProcStream = proc_stream(_ProcId, Modes, _SortFileName, Stream),
make_sort_file_key(Modes, FactArgs, Key),
(
IsPrimary = is_primary_proc(FactArgInfos),
make_fact_data_string(FactArgInfos, FactArgs, DataString)
;
IsPrimary = is_not_primary_proc,
DataString = ""
),
io.format(Stream, "%s~%s~%s\n",
[s(Key), s(FactNumStr), s(DataString)], !IO),
write_sort_file_lines(FactNumStr, FactArgs, is_not_primary_proc,
ProcStreams, !IO).
% Create a key for the fact table entry.
% Arguments are separated by ":".
% Colons in string literals are replaced by "\c", tildes are replaced
% by "\t", newlines are replaced by "\n" and backslashes by "\\".
% This ensures that each possible set of arguments maps to a unique key
% and guarantees that duplicate keys will be adjacent after sorting
% with the sort program. The tilde ('~') character is used in the
% sort file to separate the sort key from the data.
%
:- pred make_sort_file_key(list(fact_table_mode)::in, list(fact_arg)::in,
string::out) is det.
make_sort_file_key([], [], "").
make_sort_file_key([], [_ | _], _) :-
unexpected($pred, "list length mismatch").
make_sort_file_key([_ | _], [], _) :-
unexpected($pred, "list length mismatch").
make_sort_file_key([HeadMode | TailModes], [HeadArg | TailArgs], Key) :-
make_sort_file_key(TailModes, TailArgs, TailKey),
(
HeadMode = fully_in,
HeadKey = make_key_part(HeadArg),
Key = HeadKey ++ ":" ++ TailKey
;
HeadMode = fully_out,
Key = TailKey
).
% Like make_sort_file_key but for the output arguments of the fact.
%
:- pred make_fact_data_string(list(fact_arg_info)::in, list(fact_arg)::in,
string::out) is det.
make_fact_data_string([], [], "").
make_fact_data_string([], [_ | _], _) :-
unexpected($pred, "list length mismatch").
make_fact_data_string([_ | _], [], _) :-
unexpected($pred, "list length mismatch").
make_fact_data_string([HeadInfo | TailInfos], [HeadArg | TailArgs], String) :-
make_fact_data_string(TailInfos, TailArgs, TailString),
HeadInfo = fact_arg_info(_, _, HeadIsOutput),
(
HeadIsOutput = is_in_or_output_for_some_mode,
HeadString = make_key_part(HeadArg),
String = HeadString ++ ":" ++ TailString
;
HeadIsOutput = is_not_in_or_output_for_any_mode,
String = TailString
).
:- func make_key_part(fact_arg) = string.
make_key_part(Arg) = Key :-
(
Arg = fact_arg_int(Int),
% Print the integer in base 36 to reduce the amount of I/O that we do.
Key = string.int_to_base_string(Int, 36)
;
Arg = fact_arg_float(F),
Key = string.float_to_string(F)
;
Arg = fact_arg_string(Str),
string.to_char_list(Str, Chars),
key_from_chars(Chars, EscapedChars),
string.from_char_list(EscapedChars, Key)
).
% Escape all backslashes with a backslash, and replace all newlines
% with "\n", colons with "\c" and tildes with "\t".
%
:- pred key_from_chars(list(char)::in, list(char)::out) is det.
key_from_chars(Chars, EscapedChars) :-
key_from_chars_loop(Chars, cord.init, EscapedCharsCord),
EscapedChars = cord.to_list(EscapedCharsCord).
:- pred key_from_chars_loop(list(char)::in, cord(char)::in, cord(char)::out)
is det.
key_from_chars_loop([], !EscapedCharsCord).
key_from_chars_loop([Char | Chars], !EscapedCharsCord) :-
( if Char = ('\\') then
cord.snoc_list(['\\', '\\'], !EscapedCharsCord)
else if Char = ('\n') then
cord.snoc_list(['\\', 'n'], !EscapedCharsCord)
else if Char = (':') then
cord.snoc_list(['\\', 'c'], !EscapedCharsCord)
else if Char = ('~') then
cord.snoc_list(['\\', 't'], !EscapedCharsCord)
else
cord.snoc(Char, !EscapedCharsCord)
),
key_from_chars_loop(Chars, !EscapedCharsCord).
%---------------------------------------------------------------------------%
% infer_determinism_pass_2(ModuleInfo, GenInfo, ProcFiles,
% !ProcTable, !Specs, !IO):
%
% Run `sort' on each sort file to see if the keys are unique.
% If they are, the procedure is semidet, otherwise it is nondet.
% Return the updated proc_table.
%
:- pred infer_determinism_pass_2(maybe(io.text_output_stream)::in,
fact_table_gen_info::in, assoc_list(proc_id, string)::in,
proc_table::in, proc_table::out,
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
infer_determinism_pass_2(_, _, [], !ProcTable, !Specs, !IO).
infer_determinism_pass_2(MaybeProgressStream, GenInfo,
[ProcId - FileName | ProcFiles], !ProcTable, !Specs, !IO) :-
map.lookup(!.ProcTable, ProcId, ProcInfo0),
% XXX This sends the output to the *input* file.
% This works in the usual implementations of sort,
% since you have to finish reading the input before you can generate
% any part of the output, but it is not *guaranteed* to work,
% since sort may *open* the output file before finishing reading.
% XXX Also, this requires "sort" and "cut" to be installed,
% but we don't check that. We should have autoconf tests for their
% presence/absence, and if either is absent, we should generate
% a more specific error message than what results from the failure
% of Command.
string.format(
"LC_ALL=C sort -o %s %s && " ++
"cut -d'~' -f1 %s | LC_ALL=C sort -cu >/dev/null 2>&1",
[s(FileName), s(FileName), s(FileName)], Command0),
make_command_string(Command0, double, Command),
(
MaybeProgressStream = no,
io.call_system.call_system(Command, Result, !IO)
;
MaybeProgressStream = yes(ProgressStream),
io.format(ProgressStream, "%% Invoking system command `%s' ...",
[s(Command)], !IO),
io.call_system.call_system(Command, Result, !IO),
io.write_string(ProgressStream, "done.\n", !IO)
),
(
Result = ok(ExitStatus),
% sort -cu returns 0 if file is sorted and contains no duplicate keys,
% >=1 if duplicate keys exist.
( if
(
ExitStatus = 0
;
GenInfo = fact_table_gen_info(_, _, MaybeAllInProcId, _),
% This is an all_in mode so it is semidet.
% XXX This means that *some* procedure is all_in,
% but what allows that comment to say that *this* procedure
% is all_in?
MaybeAllInProcId = yes(_),
ProcFiles = []
)
then
% No duplicate keys => procedure is semidet.
Determinism = detism_semi
else if
ExitStatus >= 1
then
% Duplicate keys => procedure is nondet.
proc_info_get_declared_determinism(ProcInfo0, MaybeDet),
( if
( MaybeDet = yes(detism_cc_multi)
; MaybeDet = yes(detism_cc_non)
)
then
Determinism = detism_cc_non
else
Determinism = detism_non
)
else
io.progname_base("mercury_compile", ProgName, !IO),
Pieces =
[fixed(ProgName), suffix(":"), words("an error occurred"),
words("in ether the"), quote("sort"),
words("or the"), quote("cut"), words("program"),
words("during fact table determinism inference."), nl],
Spec = no_ctxt_spec($pred, severity_error, phase_fact_table_check,
Pieces),
!:Specs = [Spec | !.Specs],
Determinism = detism_erroneous
)
;
Result = error(ErrorCode),
add_call_system_error("sort", ErrorCode, !Specs, !IO),
Determinism = detism_erroneous
),
proc_info_set_inferred_determinism(Determinism, ProcInfo0, ProcInfo),
map.det_update(ProcId, ProcInfo, !ProcTable),
infer_determinism_pass_2(MaybeProgressStream, GenInfo, ProcFiles,
!ProcTable, !Specs, !IO).
%---------------------------------------------------------------------------%
% Write out the fact table data arrays and hash tables.
%
:- pred write_fact_table_arrays(maybe(io.text_output_stream)::in,
io.text_output_stream::in, int::in,
module_info::in, assoc_list(proc_id, string)::in, string::in,
fact_table_proc_map::in, string::in, int::in, list(fact_arg_info)::in,
maybe_write_hash_tables::in, maybe_write_data_table::in,
string::out, proc_id::out,
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
write_fact_table_arrays(MaybeProgressStream, OutputStream, FactTableSize,
ModuleInfo, ProcFiles, DataFileName, FactTableProcMap,
StructName, NumFacts, FactArgInfos, WriteHashTables, WriteDataTable,
HeaderCode, PrimaryProcId, !Specs, !IO) :-
(
% No sort files => there was only and all_out mode
% => nothing left to be done here.
ProcFiles = [],
HeaderCode = "",
% This won't get used anyway.
PrimaryProcId = hlds_pred.initial_proc_id
;
ProcFiles = [PrimaryProcId - FileName | TailProcFiles],
(
WriteHashTables = write_hash_tables,
(
TailProcFiles = [],
CreateFactMap = do_not_create_fact_map
;
% If there we need to build secondary hash tables (i.e. if
% there is >1 input mode) we need to create a ``FactMap''
% while writing out the primary table.
TailProcFiles = [_ | _],
CreateFactMap = create_fact_map
),
write_primary_hash_table(MaybeProgressStream, OutputStream,
FactTableSize, ModuleInfo, FactTableProcMap, PrimaryProcId,
FileName, DataFileName, StructName, FactArgInfos,
WriteDataTable, NumFacts, CreateFactMap, PrimaryResult,
!Specs, !IO),
(
PrimaryResult = ok(FactMap, PrimaryHeaderCode),
write_secondary_hash_tables(MaybeProgressStream, OutputStream,
FactTableSize, ModuleInfo, FactTableProcMap, StructName,
FactArgInfos, FactMap, TailProcFiles,
"", SecondaryHeadCode, !Specs, !IO),
HeaderCode = PrimaryHeaderCode ++ SecondaryHeadCode
;
PrimaryResult = error,
HeaderCode = ""
)
;
WriteHashTables = do_not_write_hash_tables,
HeaderCode = ""
)
).
% Write out the data for the fact table.
%
:- pred write_fact_table_data(io.text_output_stream::in,
maybe(io.text_output_stream)::in, int::in, string::in,
list(list(fact_arg))::in, int::in, io::di, io::uo) is det.
write_fact_table_data(_, _, _, _, [], _, !IO).
write_fact_table_data(OutputStream, MaybeProgressStream, FactTableSize,
StructName, [Fact | Facts], FactNum, !IO) :-
write_fact_data(OutputStream, MaybeProgressStream, FactTableSize,
StructName, Fact, FactNum, !IO),
write_fact_table_data(OutputStream, MaybeProgressStream, FactTableSize,
StructName, Facts, FactNum + 1, !IO).
% Write out the data for a single fact, starting a new array if necessary.
% Note: this predicate will not write the declaration or opening brace
% for the first array or the closing brace of the last array.
%
:- pred write_fact_data(io.text_output_stream::in,
maybe(io.text_output_stream)::in, int::in, string::in,
list(fact_arg)::in, int::in, io::di, io::uo) is det.
write_fact_data(OutputStream, MaybeProgressStream, FactTableSize,
StructName, Args, FactNum, !IO) :-
( if 0 = FactNum mod FactTableSize then
( if FactNum = 0 then
true
else
write_closing_brace(OutputStream, !IO),
write_new_data_array_opening_brace(OutputStream, StructName,
FactNum, !IO)
),
(
MaybeProgressStream = yes(ProgressStream),
io.format(ProgressStream,
"%% Writing fact %d\n", [i(FactNum)], !IO)
;
MaybeProgressStream = no
)
else
true
),
io.write_string(OutputStream, "\t{", !IO),
write_fact_args(OutputStream, Args, !IO),
io.write_string(OutputStream, " },\n", !IO).
% Write out the declaration of a new data array followed by " = {\n".
%
:- pred write_new_data_array_opening_brace(io.text_output_stream::in,
string::in, int::in, io::di, io::uo) is det.
write_new_data_array_opening_brace(OutputStream, StructName, FactNum, !IO) :-
io.format(OutputStream, "const struct %s_struct %s%d[] = {\n",
[s(StructName), s(StructName), i(FactNum)], !IO).
% Write out the closing brace of an array.
%
:- pred write_closing_brace(io.text_output_stream::in, io::di, io::uo) is det.
write_closing_brace(OutputStream, !IO) :-
io.write_string(OutputStream, "};\n\n", !IO).
:- pred write_fact_args(io.text_output_stream::in, list(fact_arg)::in,
io::di, io::uo) is det.
write_fact_args(_, [], !IO).
write_fact_args(OutputStream, [FactArg | FactArgs], !IO) :-
(
FactArg = fact_arg_string(String),
output_quoted_string_c(OutputStream, String, !IO),
io.write_string(OutputStream, ", ", !IO)
;
FactArg = fact_arg_int(Int),
io.write_int(OutputStream, Int, !IO),
io.write_string(OutputStream, ", ", !IO)
;
FactArg = fact_arg_float(Float),
io.write_float(OutputStream, Float, !IO),
io.write_string(OutputStream, ", ", !IO)
),
write_fact_args(OutputStream, FactArgs, !IO).
% If a data table has been created in a separate file, append it to the
% end of the main output file and then delete it.
%
:- pred append_data_table(maybe(io.text_output_stream)::in,
string::in, string::in, list(error_spec)::in, list(error_spec)::out,
io::di, io::uo) is det.
append_data_table(MaybeProgressStream, OutputFileName, DataFileName,
!Specs, !IO) :-
make_command_string(string.format("cat %s >>%s",
[s(DataFileName), s(OutputFileName)]), forward, Command),
(
MaybeProgressStream = no,
io.call_system.call_system(Command, Result, !IO)
;
MaybeProgressStream = yes(ProgressStream),
io.format(ProgressStream, "%% Invoking system command `%s' ...",
[s(Command)], !IO),
io.call_system.call_system(Command, Result, !IO),
io.write_string(ProgressStream, "done.\n", !IO)
),
(
Result = ok(ExitStatus),
( if ExitStatus = 0 then
true
else
Pieces = [words("An error occurred while concatenating"),
words("fact table output files."), nl],
Spec = no_ctxt_spec($pred, severity_error, phase_fact_table_check,
Pieces),
!:Specs = [Spec | !.Specs]
)
;
Result = error(ErrorCode),
add_call_system_error("cat", ErrorCode, !Specs, !IO)
),
delete_temporary_file(DataFileName, !Specs, !IO).
:- type fact_result
---> ok(map(int, int), string)
; error.
% Write hash tables for the primary key. Create a map from indices in the
% original input table to the table sorted on the primary key.
% Write out the data table if required.
%
:- pred write_primary_hash_table(maybe(io.text_output_stream)::in,
io.text_output_stream::in, int::in,
module_info::in, fact_table_proc_map::in, proc_id::in,
string::in, string::in, string::in, list(fact_arg_info)::in,
maybe_write_data_table::in, int::in, maybe_create_fact_map::in,
fact_result::out,
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
write_primary_hash_table(MaybeProgressStream, OutputStream, FactTableSize,
ModuleInfo, FactTableProcMap, ProcId, FileName, DataFileName,
StructName, FactArgInfos, WriteDataTable, NumFacts,
CreateFactMap, Result, !Specs, !IO) :-
io.open_input(FileName, FileResult, !IO),
(
FileResult = ok(FileStream),
(
WriteDataTable = write_data_table,
io.open_output(DataFileName, OpenResult, !IO),
(
OpenResult = ok(DataStream),
proc_id_to_int(ProcId, ProcIdInt),
string.format("%s_hash_table_%d_",
[s(StructName), i(ProcIdInt)], HashTableName),
% Note: the type declared here is not necessarily correct.
% We declare it just to stop the C compiler emitting warnings.
string.format(
"extern struct MR_fact_table_hash_table_i %s0;\n",
[s(HashTableName)], HeaderCode0),
map.lookup(FactTableProcMap, ProcId, FactTableProcInfo),
FactTableProcInfo = fact_table_proc_info(FactTableVars, _, _),
FactTableModes =
list.map((func(fact_table_var(_, M, _, _)) = M),
FactTableVars),
read_sort_file_line(FileStream, FileName,
FactArgInfos, FactTableModes, MaybeFirstFact, !Specs, !IO),
% Output opening brace for first fact array,
% XXX This design is inelegant.
write_new_data_array_opening_brace(DataStream, StructName,
0, !IO),
(
MaybeFirstFact = yes(FirstFact),
build_hash_table(MaybeProgressStream, FileStream, FileName,
OutputStream, yes(DataStream), FactTableSize,
ModuleInfo, primary_table, StructName, FactArgInfos,
FactTableModes, 0, HashTableName, 0, FirstFact, 0,
CreateFactMap, map.init, FactMap1, !Specs, !IO),
MaybeFactMap = yes(FactMap1)
;
MaybeFirstFact = no,
MaybeFactMap = no
),
% Closing brace for last fact data array.
write_closing_brace(DataStream, !IO),
write_fact_table_pointer_array(DataStream, FactTableSize,
StructName, NumFacts, HeaderCode1, !IO),
io.close_output(DataStream, !IO),
(
MaybeFactMap = no,
Result = error
;
MaybeFactMap = yes(FactMap),
HeaderCode = HeaderCode0 ++ HeaderCode1,
Result = ok(FactMap, HeaderCode)
)
;
OpenResult = error(Error),
add_file_open_error(no, DataFileName, "output", Error,
!Specs, !IO),
Result = error
)
;
WriteDataTable = do_not_write_data_table,
Result = error
),
io.close_input(FileStream, !IO),
delete_temporary_file(FileName, !Specs, !IO)
;
FileResult = error(Error),
add_file_open_error(no, FileName, "input", Error, !Specs, !IO),
Result = error
).
% Build hash tables for non-primary input procs.
%
:- pred write_secondary_hash_tables(maybe(io.text_output_stream)::in,
io.text_output_stream::in, int::in,
module_info::in, fact_table_proc_map::in, string::in,
list(fact_arg_info)::in, map(int, int)::in,
assoc_list(proc_id, string)::in,
string::in, string::out,
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
write_secondary_hash_tables(_, _, _, _, _, _, _, _, [],
!HeaderCode, !Specs, !IO).
write_secondary_hash_tables(MaybeProgressStream, OutputStream, FactTableSize,
ModuleInfo, FactTableProcMap, StructName, FactArgInfos, FactMap,
[ProcId - FileName | ProcFiles], !HeaderCode, !Specs, !IO) :-
io.open_input(FileName, FileResult, !IO),
(
FileResult = ok(FileStream),
proc_id_to_int(ProcId, ProcIdInt),
string.format("%s_hash_table_%d_",
[s(StructName), i(ProcIdInt)], HashTableName),
% Note: the type declared here is not necessarily correct.
% The type is declared just to stop the C compiler emitting warnings.
string.format(
"extern struct MR_fact_table_hash_table_i %s0;\n",
[s(HashTableName)], StructDeclCode),
!:HeaderCode = !.HeaderCode ++ StructDeclCode,
map.lookup(FactTableProcMap, ProcId, FactTableProcInfo),
FactTableProcInfo = fact_table_proc_info(FactTableVars, _, _),
FactTableModes = list.map((func(fact_table_var(_, M, _, _)) = M),
FactTableVars),
read_sort_file_line(FileStream, FileName,
FactArgInfos, FactTableModes, MaybeFirstFact, !Specs, !IO),
(
MaybeFirstFact = yes(FirstFact),
build_hash_table(MaybeProgressStream, FileStream, FileName,
OutputStream, no, FactTableSize, ModuleInfo, not_primary_table,
StructName, FactArgInfos, FactTableModes, 0, HashTableName, 0,
FirstFact, 0, do_not_create_fact_map, FactMap, _, !Specs, !IO),
io.close_input(FileStream, !IO),
delete_temporary_file(FileName, !Specs, !IO),
write_secondary_hash_tables(MaybeProgressStream, OutputStream,
FactTableSize, ModuleInfo, FactTableProcMap, StructName,
FactArgInfos, FactMap, ProcFiles, !HeaderCode, !Specs, !IO)
;
MaybeFirstFact = no,
io.close_input(FileStream, !IO)
)
;
FileResult = error(Error),
add_file_open_error(no, FileName, "input", Error, !Specs, !IO)
).
%---------------------------------------------------------------------------%
:- pred read_sort_file_line(io.text_input_stream::in, string::in,
list(fact_arg_info)::in, list(fact_table_mode)::in,
maybe(sort_file_line)::out,
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
read_sort_file_line(InputStream, InputFileName,
FactArgInfos, Modes, MaybeSortFileLine, !Specs, !IO) :-
io.read_line(InputStream, Result, !IO),
(
Result = ok(LineChars),
string.from_char_list(LineChars, LineString),
split_sort_file_line(FactArgInfos, Modes, LineString, SortFileLine),
MaybeSortFileLine = yes(SortFileLine)
;
Result = eof,
MaybeSortFileLine = no
;
Result = error(ErrorCode),
io.error_message(ErrorCode, ErrorMessage),
Pieces =
[words("Error reading file"), quote(InputFileName),
suffix(":"), nl,
words(ErrorMessage), nl],
Spec = no_ctxt_spec($pred, severity_error, phase_fact_table_check,
Pieces),
!:Specs = [Spec | !.Specs],
MaybeSortFileLine = no
).
% Break up a string into the components of a sort file line.
%
:- pred split_sort_file_line(list(fact_arg_info)::in,
list(fact_table_mode)::in, string::in, sort_file_line::out) is det.
split_sort_file_line(FactArgInfos, Modes, Line0, SortFileLine) :-
( if
string.sub_string_search(Line0, "~", Pos0),
string.split(Line0, Pos0, InputArgsString, Line1),
string.first_char(Line1, _, Line2),
string.sub_string_search(Line2, "~", Pos1),
string.split(Line2, Pos1, IndexString, Line3),
string.first_char(Line3, _, Line4),
string.remove_suffix(Line4, "\n", OutputArgsString),
string.to_int(IndexString, Index0)
then
split_key_to_arg_strings(InputArgsString, InputArgStrings),
get_input_args_list(FactArgInfos, Modes,
InputArgStrings, InputArgs),
split_key_to_arg_strings(OutputArgsString, OutputArgStrings),
(
% Only extract the output arguments if they have actually been
% written to this sort file.
OutputArgStrings = [_ | _],
get_output_args_list(FactArgInfos, OutputArgStrings, OutputArgs)
;
OutputArgStrings = [],
OutputArgs = []
),
SortFileLine = sort_file_line(InputArgs, Index0, OutputArgs)
else
unexpected($pred, "sort file format incorrect")
).
% Split up a string containing a sort file key into a list of strings
% containing the key arguments. Arguments in the key are separated by `:'.
%
:- pred split_key_to_arg_strings(string::in, list(string)::out) is det.
split_key_to_arg_strings(Key0, ArgStrings) :-
( if Key0 = "" then
ArgStrings = []
else
( if
string.sub_string_search(Key0, ":", Pos),
string.split(Key0, Pos, ArgString, Key1),
string.first_char(Key1, _, Key2)
then
split_key_to_arg_strings(Key2, ArgStrings0),
ArgStrings = [ArgString | ArgStrings0]
else
unexpected($pred, "sort file key format is incorrect")
)
).
:- pred get_input_args_list(list(fact_arg_info)::in, list(fact_table_mode)::in,
list(string)::in, list(fact_arg)::out) is det.
get_input_args_list([], [], _, []).
get_input_args_list([_ | _], [], _, _) :-
unexpected($pred, "too many fact_arg_infos").
get_input_args_list([], [_ | _], _, _) :-
unexpected($pred, "too many argmodes").
get_input_args_list([Info | Infos], [Mode | Modes], ArgStrings0, Args) :-
(
Mode = fully_in,
(
ArgStrings0 = [ArgString | ArgStrings],
Info = fact_arg_info(Type, _, _),
convert_key_string_to_arg(ArgString, Type, Arg),
get_input_args_list(Infos, Modes, ArgStrings, ArgsTail),
Args = [Arg | ArgsTail]
;
ArgStrings0 = [],
unexpected($pred, "not enough ArgStrings")
)
;
Mode = fully_out,
% This argument is not input, so skip it and try the next one.
get_input_args_list(Infos, Modes, ArgStrings0, Args)
).
:- pred get_output_args_list(list(fact_arg_info)::in, list(string)::in,
list(fact_arg)::out) is det.
get_output_args_list([], _, []).
get_output_args_list([Info | Infos], ArgStrings0, Args) :-
Info = fact_arg_info(Type, _, IsOutput),
(
IsOutput = is_in_or_output_for_some_mode,
(
ArgStrings0 = [ArgString | ArgStrings],
convert_key_string_to_arg(ArgString, Type, Arg),
get_output_args_list(Infos, ArgStrings, Args0),
Args = [Arg | Args0]
;
ArgStrings0 = [],
unexpected($pred, "not enough ArgStrings")
)
;
IsOutput = is_not_in_or_output_for_any_mode,
get_output_args_list(Infos, ArgStrings0, Args)
).
:- pred convert_key_string_to_arg(string::in, fact_arg_type::in, fact_arg::out)
is det.
convert_key_string_to_arg(ArgString, Type, Arg) :-
(
Type = fact_arg_type_int,
( if string.base_string_to_int(36, ArgString, Int) then
Arg = fact_arg_int(Int)
else
unexpected($pred, "could not convert string to int")
)
;
Type = fact_arg_type_float,
( if string.to_float(ArgString, F) then
Arg = fact_arg_float(F)
else
unexpected($pred, "could not convert string to float")
)
;
Type = fact_arg_type_string,
string.to_char_list(ArgString, Chars0),
remove_sort_file_escapes(Chars0, [], RevChars),
list.reverse(RevChars, Chars),
string.from_char_list(Chars, S),
Arg = fact_arg_string(S)
).
% Remove the escape characters put in the string by make_sort_file_key.
%
:- pred remove_sort_file_escapes(list(char)::in,
list(char)::in, list(char)::out) is det.
remove_sort_file_escapes([], !RevChars).
remove_sort_file_escapes([C0 | Cs0], !RevChars) :-
( if C0 = ('\\') then
(
Cs0 = [C1 | Cs1],
( if C1 = ('\\') then
C = ('\\')
else if C1 = ('c') then
C = (':')
else if C1 = ('t') then
C = ('~')
else if C1 = ('n') then
C = ('\n')
else
unexpected($pred, "something went wrong")
),
!:RevChars = [C | !.RevChars],
remove_sort_file_escapes(Cs1, !RevChars)
;
Cs0 = [],
unexpected($pred, "something went wrong")
)
else
!:RevChars = [C0 | !.RevChars],
remove_sort_file_escapes(Cs0, !RevChars)
).
%---------------------------------------------------------------------------%
:- type maybe_primary_table
---> not_primary_table
; primary_table.
:- type maybe_create_fact_map
---> do_not_create_fact_map
; create_fact_map.
% Build and write out a top level hash table and all the lower level
% tables connected to it.
%
:- pred build_hash_table(maybe(io.text_output_stream)::in,
io.text_input_stream::in, string::in,
io.text_output_stream::in, maybe(io.text_output_stream)::in, int::in,
module_info::in, maybe_primary_table::in, string::in,
list(fact_arg_info)::in, list(fact_table_mode)::in,
int::in, string::in, int::in, sort_file_line::in, int::in,
maybe_create_fact_map::in, map(int, int)::in, map(int, int)::out,
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
build_hash_table(MaybeProgressStream, InputStream, InputFileName, OutputStream,
MaybeDataStream, FactTableSize, ModuleInfo, IsPrimaryTable,
StructName, Infos, Modes, InputArgNum, HashTableName, TableNum,
FirstFact, FactNum, CreateFactMap, !FactMap, !Specs, !IO) :-
build_hash_table_loop(MaybeProgressStream, InputStream, InputFileName,
OutputStream, MaybeDataStream, FactTableSize, ModuleInfo,
IsPrimaryTable, StructName, Infos, Modes, InputArgNum,
HashTableName, TableNum, FirstFact, FactNum, CreateFactMap,
!FactMap, [], HashList, !Specs, !IO),
list.length(HashList, Len),
module_info_get_globals(ModuleInfo, Globals),
calculate_hash_table_size(Globals, Len, HashSize),
hash_table_init(HashSize, HashTable0),
hash_table_from_list(HashList, HashSize, HashTable0, HashTable),
write_hash_table(OutputStream, HashTableName, TableNum, HashTable, !IO).
:- pred build_hash_table_loop(maybe(io.text_output_stream)::in,
io.text_input_stream::in, string::in,
io.text_output_stream::in, maybe(io.text_output_stream)::in, int::in,
module_info::in, maybe_primary_table::in, string::in,
list(fact_arg_info)::in, list(fact_table_mode)::in,
int::in, string::in, int::in, sort_file_line::in, int::in,
maybe_create_fact_map::in, map(int, int)::in, map(int, int)::out,
list(hash_entry)::in, list(hash_entry)::out,
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
build_hash_table_loop(MaybeProgressStream, InputStream, InputFileName,
OutputStream, MaybeDataStream, FactTableSize, ModuleInfo,
IsPrimaryTable, StructName, Infos, Modes, InputArgNum,
HashTableName, !.TableNum, FirstFact, FactNum, CreateFactMap,
!FactMap, !HashList, !Specs, !IO) :-
top_level_collect_matching_facts(InputStream, InputFileName,
Infos, Modes, FirstFact, MatchingFacts, MaybeNextFact, !Specs, !IO),
(
CreateFactMap = create_fact_map,
update_fact_map(FactNum, MatchingFacts, !FactMap)
;
CreateFactMap = do_not_create_fact_map
),
(
MaybeDataStream = yes(DataStream),
OutputData = list.map(
(func(sort_file_line(_, _, OutArgs)) = OutArgs),
MatchingFacts),
write_fact_table_data(DataStream, MaybeProgressStream, FactTableSize,
StructName, OutputData, FactNum, !IO)
;
MaybeDataStream = no
),
module_info_get_globals(ModuleInfo, Globals),
do_build_hash_table(OutputStream, Globals, IsPrimaryTable,
!.FactMap, FactNum, InputArgNum, HashTableName,
MatchingFacts, !TableNum, !HashList, !IO),
(
MaybeNextFact = no
;
MaybeNextFact = yes(NextFact),
list.length(MatchingFacts, Len),
NextFactNum = FactNum + Len,
build_hash_table_loop(MaybeProgressStream, InputStream, InputFileName,
OutputStream, MaybeDataStream, FactTableSize, ModuleInfo,
IsPrimaryTable, StructName, Infos, Modes, InputArgNum,
HashTableName, !.TableNum, NextFact, NextFactNum, CreateFactMap,
!FactMap, !HashList, !Specs, !IO)
).
% Build a lower level hash table. The main difference to build_hash_table
% (above) is that ``sort file lines'' are read from a list rather than
% from the actual sort file.
%
:- pred build_hash_table_lower_levels(io.text_output_stream::in, globals::in,
maybe_primary_table::in, map(int, int)::in, int::in, string::in,
list(sort_file_line)::in, int::in, int::in, int::out,
io::di, io::uo) is det.
build_hash_table_lower_levels(OutputStream, Globals, IsPrimaryTable, FactMap,
InputArgNum, HashTableName, Facts, FactNum,
TableNum0, TableNum, !IO) :-
build_hash_table_lower_levels_loop(OutputStream, Globals, IsPrimaryTable,
FactMap, InputArgNum, HashTableName, Facts, FactNum,
TableNum0, TableNum, [], HashList, !IO),
list.length(HashList, Len),
calculate_hash_table_size(Globals, Len, HashSize),
hash_table_init(HashSize, HashTable0),
hash_table_from_list(HashList, HashSize, HashTable0, HashTable),
write_hash_table(OutputStream, HashTableName, TableNum0, HashTable, !IO).
:- pred build_hash_table_lower_levels_loop(io.text_output_stream::in,
globals::in, maybe_primary_table::in, map(int, int)::in, int::in,
string::in, list(sort_file_line)::in, int::in, int::in, int::out,
list(hash_entry)::in, list(hash_entry)::out, io::di, io::uo) is det.
build_hash_table_lower_levels_loop(_, _, _, _, _, _,
[], _, !TableNum, !HashList, !IO).
build_hash_table_lower_levels_loop(OutputStream, Globals, IsPrimaryTable,
FactMap, InputArgNum, HashTableName,
[Fact | Facts0], FactNum, !TableNum, !HashList, !IO) :-
lower_level_collect_matching_facts(InputArgNum, Fact, Facts0,
MatchingFacts, RemainingFacts),
do_build_hash_table(OutputStream, Globals, IsPrimaryTable,
FactMap, FactNum, InputArgNum, HashTableName,
MatchingFacts, !TableNum, !HashList, !IO),
list.length(MatchingFacts, Len),
NextFactNum = FactNum + Len,
build_hash_table_lower_levels_loop(OutputStream, Globals, IsPrimaryTable,
FactMap, InputArgNum, HashTableName,
RemainingFacts, NextFactNum, !TableNum, !HashList, !IO).
% This is where most of the actual work is done in building up the
% hash table.
%
:- pred do_build_hash_table(io.text_output_stream::in, globals::in,
maybe_primary_table::in, map(int, int)::in, int::in, int::in, string::in,
list(sort_file_line)::in, int::in, int::out,
list(hash_entry)::in, list(hash_entry)::out, io::di, io::uo) is det.
do_build_hash_table(OutputStream, Globals, IsPrimaryTable, FactMap,
FactNum, InputArgNum, HashTableName, Facts,
!TableNum, !HashList, !IO) :-
(
Facts = [],
unexpected($pred, "no facts")
;
Facts = [Fact | TailFacts],
fact_get_arg_and_index(Fact, InputArgNum, Arg, Index),
(
IsPrimaryTable = primary_table,
HashIndex = FactNum
;
IsPrimaryTable = not_primary_table,
map.lookup(FactMap, Index, HashIndex)
),
(
TailFacts = [],
% If only one matching index, insert a pointer to the fact table
% entry into the current hash table.
!:HashList = [hash_entry(Arg, fact(HashIndex), -1) | !.HashList]
;
TailFacts = [_ | _],
( if
% See if there are any more input arguments.
NextInputArgNum = InputArgNum + 1,
Fact = sort_file_line(InputArgs, _, _),
N = NextInputArgNum + 1,
list.drop(N, InputArgs, _)
then
!:TableNum = !.TableNum + 1,
ThisTableNum = !.TableNum,
build_hash_table_lower_levels(OutputStream, Globals,
IsPrimaryTable, FactMap, NextInputArgNum,
HashTableName, Facts, FactNum, !TableNum, !IO),
EntryIndex = hash_table(ThisTableNum, HashTableName),
!:HashList = [hash_entry(Arg, EntryIndex, -1) | !.HashList]
else
(
IsPrimaryTable = primary_table,
% Insert only the first matching index into the hash table.
Entry = hash_entry(Arg, fact(HashIndex), -1),
!:HashList = [Entry | !.HashList]
;
IsPrimaryTable = not_primary_table,
% Insert all matching indexes into the hash table.
hash_list_insert_many(IsPrimaryTable, FactMap, FactNum,
InputArgNum, Facts, !HashList)
)
)
)
).
%---------------------%
% Read lines from the sort file that have the same first input
% argument as Fact. Places these lines into MatchingFacts. The first fact
% in MatchingFacts is always Fact. If an extra fact is read in following
% the matching facts, it is placed in MaybeNextFact.
%
:- pred top_level_collect_matching_facts(io.text_input_stream::in, string::in,
list(fact_arg_info)::in, list(fact_table_mode)::in,
sort_file_line::in, list(sort_file_line)::out, maybe(sort_file_line)::out,
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
top_level_collect_matching_facts(InputStream, InputFileName,
Infos, Modes, Fact, MatchingFacts, MaybeNextFact, !Specs, !IO) :-
top_level_collect_matching_facts_loop(InputStream, InputFileName,
Infos, Modes, Fact, [], RevMatchingFacts, MaybeNextFact, !Specs, !IO),
list.reverse(RevMatchingFacts, MatchingFactsTail),
MatchingFacts = [Fact | MatchingFactsTail].
:- pred top_level_collect_matching_facts_loop(io.text_input_stream::in,
string::in, list(fact_arg_info)::in, list(fact_table_mode)::in,
sort_file_line::in, list(sort_file_line)::in, list(sort_file_line)::out,
maybe(sort_file_line)::out,
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
top_level_collect_matching_facts_loop(InputStream, InputFileName,
Infos, Modes, Fact, !RevMatchingFacts, MaybeNextFact, !Specs, !IO) :-
read_sort_file_line(InputStream, InputFileName,
Infos, Modes, MaybeSortFileLine, !Specs, !IO),
(
MaybeSortFileLine = yes(Fact1),
( if
Fact1 = sort_file_line([Arg1 | _], _, _),
Fact = sort_file_line([Arg | _], _, _)
then
( if Arg = Arg1 then
!:RevMatchingFacts = [Fact1 | !.RevMatchingFacts],
top_level_collect_matching_facts_loop(InputStream,
InputFileName, Infos, Modes, Fact,
!RevMatchingFacts, MaybeNextFact, !Specs, !IO)
else
MaybeNextFact = yes(Fact1)
)
else
unexpected($pred, "no input args")
)
;
MaybeSortFileLine = no,
MaybeNextFact = no
).
% Same as above, but reads facts from a list instead of from the sort file.
%
:- pred lower_level_collect_matching_facts(int::in, sort_file_line::in,
list(sort_file_line)::in, list(sort_file_line)::out,
list(sort_file_line)::out) is det.
lower_level_collect_matching_facts(InputArgNum, Fact, Facts,
MatchingFacts, RemainingFacts) :-
Fact = sort_file_line(InputArgs, _, _),
list.det_index0(InputArgs, InputArgNum, MatchArg),
lower_level_collect_matching_facts_loop(InputArgNum, MatchArg, Facts,
[], RevMatchingFacts, RemainingFacts),
list.reverse(RevMatchingFacts, TailMatchingFacts),
MatchingFacts = [Fact | TailMatchingFacts].
:- pred lower_level_collect_matching_facts_loop(int::in, fact_arg::in,
list(sort_file_line)::in, list(sort_file_line)::in,
list(sort_file_line)::out, list(sort_file_line)::out) is det.
lower_level_collect_matching_facts_loop(_, _, [], !RevMatchingFacts, []).
lower_level_collect_matching_facts_loop(InputArgNum, MatchArg,
[Fact | Facts], !RevMatchingFacts, RemainingFacts) :-
Fact = sort_file_line(InputArgs, _, _),
list.det_index0(InputArgs, InputArgNum, Arg),
( if MatchArg = Arg then
!:RevMatchingFacts = [Fact | !.RevMatchingFacts],
lower_level_collect_matching_facts_loop(InputArgNum, MatchArg,
Facts, !RevMatchingFacts, RemainingFacts)
else
RemainingFacts = [Fact | Facts]
).
:- pred update_fact_map(int::in, list(sort_file_line)::in,
map(int, int)::in, map(int, int)::out) is det.
update_fact_map(_, [], !FactMap).
update_fact_map(FactNum, [Fact | Facts], !FactMap) :-
Fact = sort_file_line(_, Index, _),
map.set(Index, FactNum, !FactMap),
update_fact_map(FactNum + 1, Facts, !FactMap).
%---------------------------------------------------------------------------%
% Select a prime number > NumEntries * 100 / PercentFull.
% The prime number is selected from a list of primes each of which is
% close to a power of 2 between 2^1 and 2^31.
%
:- pred calculate_hash_table_size(globals::in, int::in, int::out) is det.
calculate_hash_table_size(Globals, NumEntries, HashTableSize) :-
globals.lookup_int_option(Globals, fact_table_hash_percent_full,
PercentFull),
Primes = [2, 3, 5, 11, 17, 37, 67, 131, 257, 521, 1031, 2053, 4099, 8209,
16411, 32771, 65537, 131101, 262147, 524309, 1048627, 2097257, 4194493,
8388949, 16777903, 33555799, 67108879, 134217757, 268435459, 536870923,
1073741827, 2147483647],
N = (NumEntries * 100) // PercentFull,
find_first_big_enough_prime(N, Primes, HashTableSize).
:- pred find_first_big_enough_prime(int::in, list(int)::in, int::out) is det.
find_first_big_enough_prime(_, [], _) :-
unexpected($pred, "hash table too large (max size 2147483647)").
find_first_big_enough_prime(NumSlotsNeeded, [Prime | Primes], Size) :-
( if Prime > NumSlotsNeeded then
Size = Prime
else
find_first_big_enough_prime(NumSlotsNeeded, Primes, Size)
).
% Insert an entry in a hash table. If a collision occurrs, find an empty
% hash slot to place the data in and put a pointer to the new slot in the
% Next field of the old one. This technique is called ``open-addressing''.
%
:- pred hash_table_insert(hash_entry::in, int::in,
hash_table::in, hash_table::out) is det.
hash_table_insert(Entry, HashSize, !HashTable) :-
Entry = hash_entry(Key, Index, _),
fact_table_hash(HashSize, Key, HashVal),
( if hash_table_search(!.HashTable, HashVal, _) then
hash_table_insert_open_address_loop(HashVal, Key, Index, !HashTable)
else
hash_table_set(HashVal, hash_entry(Key, Index, -1), !HashTable)
).
:- pred hash_table_insert_open_address_loop(int::in,
fact_arg::in, hash_index::in, hash_table::in, hash_table::out) is det.
hash_table_insert_open_address_loop(HashVal, Key0, Index0,
!HashTable) :-
( if hash_table_search(!.HashTable, HashVal, OldEntry1) then
OldEntry1 = hash_entry(Key1, Index1, Next),
( if Next = -1 then
get_free_hash_slot(!.HashTable, HashVal, FreeVal),
NewEntry = hash_entry(Key0, Index0, -1),
hash_table_set(FreeVal, NewEntry, !HashTable),
OldEntry = hash_entry(Key1, Index1, FreeVal),
hash_table_set(HashVal, OldEntry, !HashTable)
else
hash_table_insert_open_address_loop(Next, Key0, Index0, !HashTable)
)
else
unexpected($pred, "hash table entry empty")
).
% Probe through the hash table to find a free slot. This will eventually
% terminate because the hash table size is selected to be larger than
% the number of entries that need to go in it.
%
% XXX "This will eventually terminate" is not something one enjoys reading
% in the documentation the implementation of a language feature
% whose only purpose is to improve compiler performance :-(
%
:- pred get_free_hash_slot(hash_table::in, int::in, int::out) is det.
get_free_hash_slot(HashTable, Start, Free) :-
HashTable = hash_table(Size, _),
Max = Size - 1,
get_free_hash_slot_loop(HashTable, Start, Max, Free).
:- pred get_free_hash_slot_loop(hash_table::in, int::in, int::in, int::out)
is det.
get_free_hash_slot_loop(HashTable, Start, Max, Free) :-
Next = (Start + 1) mod Max,
( if hash_table_search(HashTable, Next, _) then
get_free_hash_slot_loop(HashTable, Next, Max, Free)
else
Free = Next
).
% Hash computation predicate.
% Note: if you change this predicate, you will also need to change
% the C code that is output to compute the hash value at runtime.
% This C code is generated in `generate_hash_code'.
%
:- pred fact_table_hash(int::in, fact_arg::in, int::out) is det.
fact_table_hash(HashSize, Key, HashVal) :-
(
Key = fact_arg_string(String),
% XXX This method of hashing strings may not work if cross-compiling
% between systems that have different character representations.
string.to_char_list(String, Cs),
list.map((pred(C::in, I::out) is det :- char.to_int(C, I)), Cs, Ns)
;
Key = fact_arg_int(Int),
int.abs(Int, N),
Ns = [N]
;
Key = fact_arg_float(Float),
% XXX This method of hashing floats may not work cross-compiling
% between architectures that have different floating-point
% representations.
int.abs(float.hash(Float), N),
Ns = [N]
),
fact_table_hash_2(HashSize, Ns, 0, HashVal).
:- pred fact_table_hash_2(int::in, list(int)::in, int::in, int::out) is det.
fact_table_hash_2(_, [], !HashVal).
fact_table_hash_2(HashSize, [N | Ns], !HashVal) :-
!:HashVal = (N + 31 * !.HashVal) mod HashSize,
fact_table_hash_2(HashSize, Ns, !HashVal).
:- pred hash_list_insert_many(maybe_primary_table::in,
map(int, int)::in, int::in, int::in ,list(sort_file_line)::in,
list(hash_entry)::in, list(hash_entry)::out) is det.
hash_list_insert_many(_, _, _, _, [], !HashList).
hash_list_insert_many(IsPrimaryTable, FactMap, FactNum, InputArgNum,
[Fact | Facts], !HashList) :-
fact_get_arg_and_index(Fact, InputArgNum, Arg, Index),
(
IsPrimaryTable = primary_table,
HashIndex = FactNum
;
IsPrimaryTable = not_primary_table,
map.lookup(FactMap, Index, HashIndex)
),
!:HashList = [hash_entry(Arg, fact(HashIndex), -1) | !.HashList],
hash_list_insert_many(IsPrimaryTable, FactMap, FactNum, InputArgNum,
Facts, !HashList).
:- pred hash_table_init(int::in, hash_table::out) is det.
hash_table_init(Size, HashTable) :-
map.init(Map),
HashTable = hash_table(Size, Map).
:- pred hash_table_from_list(list(hash_entry)::in, int::in, hash_table::in,
hash_table::out) is det.
hash_table_from_list([], _, !HashTable).
hash_table_from_list([Entry | Entrys], HashSize, !HashTable) :-
hash_table_insert(Entry, HashSize, !HashTable),
hash_table_from_list(Entrys, HashSize, !HashTable).
:- pred hash_table_search(hash_table::in, int::in, hash_entry::out) is semidet.
hash_table_search(HashTable, Index, Value) :-
HashTable = hash_table(_, Map),
map.search(Map, Index, Value).
:- pred hash_table_set(int::in, hash_entry::in,
hash_table::in, hash_table::out) is det.
hash_table_set(Index, Value, HashTable0, HashTable) :-
HashTable0 = hash_table(Size, Map0),
map.set(Index, Value, Map0, Map),
HashTable = hash_table(Size, Map).
%---------------------%
:- pred fact_get_arg_and_index(sort_file_line::in, int::in, fact_arg::out,
int::out) is det.
fact_get_arg_and_index(Fact, InputArgNum, Arg, Index) :-
Fact = sort_file_line(InputArgs, Index, _),
list.det_index0(InputArgs, InputArgNum, Arg).
%---------------------------------------------------------------------------%
% Write out the C code for a hash table.
%
:- pred write_hash_table(io.text_output_stream::in, string::in, int::in,
hash_table::in, io::di, io::uo) is det.
write_hash_table(OutputStream, BaseName, TableNum, HashTable, !IO) :-
get_hash_table_type(HashTable, TableType),
string.format("struct MR_fact_table_hash_entry_%c %s%d_data[]",
[c(TableType), s(BaseName), i(TableNum)], HashTableDataName),
io.write_strings(OutputStream, [HashTableDataName, " = {\n"], !IO),
HashTable = hash_table(Size, _),
MaxIndex = Size - 1,
write_hash_table_loop(OutputStream, HashTable, 0, MaxIndex, !IO),
io.write_string(OutputStream, "};\n\n", !IO),
StructDefnTemplate = "
struct MR_fact_table_hash_table_%c %s%d = {
%d,
%s%d_data
};
",
io.format(OutputStream, StructDefnTemplate,
[c(TableType), s(BaseName), i(TableNum), i(Size),
s(BaseName), i(TableNum)], !IO).
:- pred write_hash_table_loop(io.text_output_stream::in, hash_table::in,
int::in, int::in, io::di, io::uo) is det.
write_hash_table_loop(Stream, HashTable, CurIndex, MaxIndex, !IO) :-
( if CurIndex > MaxIndex then
true
else
io.write_string(Stream, "\t{ ", !IO),
( if hash_table_search(HashTable, CurIndex, HashEntry) then
HashEntry = hash_entry(Key, Index, Next),
(
Key = fact_arg_string(String),
output_quoted_string_c(Stream, String, !IO)
;
Key = fact_arg_int(Int),
io.write_int(Stream, Int, !IO)
;
Key = fact_arg_float(Float),
io.write_float(Stream, Float, !IO)
),
(
Index = fact(I),
io.format(Stream,
", MR_FACT_TABLE_MAKE_TAGGED_INDEX(%d, 1), ",
[i(I)], !IO)
;
Index = hash_table(I, H),
io.format(Stream,
", MR_FACT_TABLE_MAKE_TAGGED_POINTER(&%s%d, 2), ",
[s(H), i(I)], !IO)
),
io.write_int(Stream, Next, !IO)
else
io.write_string(Stream,
"0, MR_FACT_TABLE_MAKE_TAGGED_POINTER(NULL, 0), -1 ", !IO)
),
io.write_string(Stream, "},\n", !IO),
write_hash_table_loop(Stream, HashTable, CurIndex + 1, MaxIndex, !IO)
).
%---------------------%
% Return 's' for string, 'i' for int, 'f' for float.
% Don't call this with an empty hash table.
%
:- pred get_hash_table_type(hash_table::in, char::out(key_char)) is det.
get_hash_table_type(HashTable, TableType) :-
HashTable = hash_table(_Size, Map),
( if map.is_empty(Map) then
unexpected($pred, "empty hash table")
else
get_hash_table_type_loop(Map, 0, TableType)
).
:- pred get_hash_table_type_loop(map(int, hash_entry)::in, int::in,
char::out(key_char)) is det.
get_hash_table_type_loop(Map, Index, TableType) :-
( if map.search(Map, Index, Entry) then
Entry = hash_entry(Key, _, _),
(
Key = fact_arg_string(_),
TableType = 's'
;
Key = fact_arg_int(_),
TableType = 'i'
;
Key = fact_arg_float(_),
TableType = 'f'
)
else
get_hash_table_type_loop(Map, Index + 1, TableType)
).
%---------------------%
% Write out the array of pointers to the fact table arrays.
%
:- pred write_fact_table_pointer_array(io.text_output_stream::in, int::in,
string::in, int::in, string::out, io::di, io::uo) is det.
write_fact_table_pointer_array(OutputStream, FactTableSize,
StructName, NumFacts, HeaderCode, !IO) :-
string.format("const struct %s_struct *%s[]",
[s(StructName), s(StructName)], PointerArrayName),
HeaderCode = "extern " ++ PointerArrayName ++ ";\n",
io.format(OutputStream, "%s = {\n", [s(PointerArrayName)], !IO),
write_fact_table_pointer_array_loop(OutputStream, FactTableSize,
StructName, 0, NumFacts, !IO),
io.write_string(OutputStream, "};\n", !IO).
:- pred write_fact_table_pointer_array_loop(io.text_output_stream::in, int::in,
string::in, int::in, int::in, io::di, io::uo) is det.
write_fact_table_pointer_array_loop(OutputStream, FactTableSize,
StructName, CurFact, NumFacts, !IO) :-
( if CurFact >= NumFacts then
true
else
io.format(OutputStream, "\t%s%d,\n", [s(StructName), i(CurFact)], !IO),
NextFact = CurFact + FactTableSize,
write_fact_table_pointer_array_loop(OutputStream, FactTableSize,
StructName, NextFact, NumFacts, !IO)
).
%---------------------%
:- pred write_fact_table_numfacts(io.text_output_stream::in,
sym_name::in, int::in, string::out, io::di, io::uo) is det.
write_fact_table_numfacts(OutputStream, PredName, NumFacts, HeaderCode, !IO) :-
% Write out the size of the fact table.
make_fact_table_identifier(PredName, Identifier),
io.format(OutputStream,
"const MR_Integer mercury__%s_fact_table_num_facts = %d;\n\n",
[s(Identifier), i(NumFacts)], !IO),
string.format(
"extern const MR_Integer mercury__%s_fact_table_num_facts;\n",
[s(Identifier)], HeaderCode).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
fact_table_generate_c_code_for_proc(ModuleInfo, PredName,
ProcId, PrimaryProcId, ProcInfo, GenInfo, VarSet, PragmaVars,
ProcCode, ExtraCode) :-
module_info_get_globals(ModuleInfo, Globals),
fact_table_size(Globals, FactTableSize),
proc_info_interface_determinism(ProcInfo, Determinism),
make_fact_table_identifier(PredName, PredNameIdent),
GenInfo = fact_table_gen_info(FactArgInfos, FactTableProcMap, _, _),
Types = list.map((func(fact_arg_info(Type, _, _)) = Type), FactArgInfos),
map.lookup(FactTableProcMap, ProcId, FactTableProcInfo),
FactTableProcInfo = fact_table_proc_info(FactTableVars, ModeClass, VarSet),
PragmaVars =
list.map((func(fact_table_var(_, _, _, PV)) = PV), FactTableVars),
(
ModeClass = all_out,
(
Determinism = detism_multi,
generate_multi_code(ModuleInfo, FactTableSize, PredNameIdent,
ProcId, Types, FactTableVars, ProcCode, ExtraCode)
;
Determinism = detism_cc_multi,
generate_cc_multi_code(PredNameIdent, FactTableVars, ProcCode),
ExtraCode = ""
;
( Determinism = detism_det
; Determinism = detism_semi
; Determinism = detism_non
; Determinism = detism_cc_non
; Determinism = detism_failure
; Determinism = detism_erroneous
),
generate_dummy_code(FactTableVars, ProcCode, ExtraCode)
)
;
ModeClass = all_in,
(
Determinism = detism_semi,
generate_semidet_all_in_code(FactTableSize, PredNameIdent, ProcId,
Types, FactTableVars, ProcCode),
ExtraCode = ""
;
( Determinism = detism_det
; Determinism = detism_multi
; Determinism = detism_non
; Determinism = detism_cc_multi
; Determinism = detism_cc_non
; Determinism = detism_failure
; Determinism = detism_erroneous
),
generate_dummy_code(FactTableVars, ProcCode, ExtraCode)
)
;
ModeClass = in_out,
(
( Determinism = detism_semi
; Determinism = detism_cc_non
),
generate_semidet_in_out_code(FactTableSize, PredNameIdent, ProcId,
Types, FactTableVars, ProcCode),
ExtraCode = ""
;
Determinism = detism_non,
( if ProcId = PrimaryProcId then
generate_primary_nondet_code(ModuleInfo, FactTableSize,
PredNameIdent, ProcId, Types, FactTableVars,
ProcCode, ExtraCode)
else
generate_secondary_nondet_code(ModuleInfo, FactTableSize,
PredNameIdent, ProcId, Types, FactTableVars,
ProcCode, ExtraCode)
)
;
( Determinism = detism_det
; Determinism = detism_multi
; Determinism = detism_cc_multi
; Determinism = detism_failure
; Determinism = detism_erroneous
),
generate_dummy_code(FactTableVars, ProcCode, ExtraCode)
)
).
% Generate contents for a dummy implementation of a fact table.
% Used when there is a determinism error in a procedure, which
% should be reported during determinism analysis when the inferred
% determinism we recorded above is compared to the declared determinism.
% So all we need to do here is return some C code that does nothing.
%
:- pred generate_dummy_code(list(fact_table_var)::in,
string::out, string::out) is det.
generate_dummy_code(FactTableVars, ProcCode, ExtraCode) :-
% List the variables in the C code to stop the compiler giving
% a warning about them not being there.
fact_table_vars_to_names_string(FactTableVars, NamesString),
string.format("/* %s */", [s(NamesString)], ProcCode),
ExtraCode = "".
%---------------------------------------------------------------------------%
%
% Implement detism_multi procedures.
%
:- pred generate_multi_code(module_info::in, int::in, string::in, proc_id::in,
list(fact_arg_type)::in, list(fact_table_var)::in,
string::out, string::out) is det.
generate_multi_code(ModuleInfo, FactTableSize, PredName, ProcId,
Types, FactTableVars, ProcCode, ExtraCode) :-
generate_nondet_proc_code(PredName, ProcId, FactTableVars,
ExtraCodeLabel, ProcCode),
ExtraCodeTemplate = "
MR_define_extern_entry(%s);
MR_declare_label(%s_i1);
MR_BEGIN_MODULE(%s_module)
MR_init_entry(%s);
MR_init_label(%s_i1);
MR_BEGIN_CODE
MR_define_entry(%s);
MR_mkframe(""%s/%d"", 1, MR_LABEL(%s_i1));
MR_framevar(1) = (MR_Integer) 0;
MR_GOTO(MR_LABEL(%s_i1));
MR_define_label(%s_i1);
if (MR_framevar(1) >= %s) MR_fail();
{
// declare argument vars
%s
MR_Word ind = MR_framevar(1), tmp;
// lookup fact table
%s
// save output args to registers
%s
}
MR_framevar(1)++;
MR_succeed();
MR_END_MODULE
extern MR_ModuleFunc %s_module;
/*
INIT mercury_sys_init_%s_module
*/
void mercury_sys_init_%s_module(void);
void mercury_sys_init_%s_module(void) {
%s_module();
}
",
string.format("mercury__%s_fact_table_num_facts",
[s(PredName)], NumFactsVar),
list.length(FactTableVars, Arity),
generate_argument_vars_code(ModuleInfo, Types, FactTableVars,
ArgDeclCode, _InputCode, OutputCode, _, _, _),
generate_fact_lookup_code(FactTableSize, PredName,
Types, FactTableVars, 1, FactLookupCode),
string.format(ExtraCodeTemplate, [
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(PredName),
i(Arity),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(NumFactsVar),
s(ArgDeclCode),
s(FactLookupCode),
s(OutputCode),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel)],
ExtraCode).
:- pred generate_nondet_proc_code(string::in, proc_id::in,
list(fact_table_var)::in, string::out, string::out) is det.
generate_nondet_proc_code(PredName, ProcId, FactTableVars,
ExtraCodeLabel, ProcCode) :-
ProcCodeTemplate = "
// Mention arguments %s to stop the compiler giving a warning.
//
// Pop off the nondet stack frame that the pragma c_code generates
// then jump to the code where the work is actually done.
MR_maxfr_word = MR_prevfr_slot_word(MR_curfr);
MR_curfr_word = MR_succfr_slot_word(MR_curfr);
{
MR_declare_entry(%s);
MR_GOTO(MR_ENTRY(%s));
}
",
list.length(FactTableVars, Arity),
proc_id_to_int(ProcId, ProcIdInt),
string.format("mercury__%s_%d_%d_xx",
[s(PredName), i(Arity), i(ProcIdInt)], ExtraCodeLabel),
fact_table_vars_to_names_string(FactTableVars, NamesString),
string.format(ProcCodeTemplate, [s(NamesString), s(ExtraCodeLabel),
s(ExtraCodeLabel)], ProcCode).
%---------------------------------------------------------------------------%
%
% Implement detism_cc_multi procedures.
%
% For cc_multi output mode, just return the first fact in the table.
%
:- pred generate_cc_multi_code(string::in, list(fact_table_var)::in,
string::out) is det.
generate_cc_multi_code(PredName, FactTableVars, ProcCode) :-
string.format("mercury__%s_fact_table", [s(PredName)], StructName),
generate_cc_multi_code_loop(StructName, FactTableVars, 1, "", ProcCode).
:- pred generate_cc_multi_code_loop(string::in,
list(fact_table_var)::in, int::in, string::in, string::out) is det.
generate_cc_multi_code_loop(_, [], _, !ProcCode).
generate_cc_multi_code_loop(StructName, [FactTableVar | FactTableVars], ArgNum,
!ProcCode) :-
FactTableVar = fact_table_var(VarName, _, _, _),
string.format("\t\t%s = %s[0][0].V_%d;\n", [s(VarName), s(StructName),
i(ArgNum)], ArgAssignCode),
!:ProcCode = !.ProcCode ++ ArgAssignCode,
generate_cc_multi_code_loop(StructName, FactTableVars, ArgNum + 1,
!ProcCode).
%---------------------------------------------------------------------------%
%
% Implement detism_non procedures.
%
% Generate code for the nondet mode with the primary key.
%
:- pred generate_primary_nondet_code(module_info::in, int::in,
string::in, proc_id::in, list(fact_arg_type)::in, list(fact_table_var)::in,
string::out, string::out) is det.
generate_primary_nondet_code(ModuleInfo, FactTableSize, PredName, ProcId,
Types, FactTableVars, ProcCode, ExtraCode) :-
generate_nondet_proc_code(PredName, ProcId, FactTableVars,
ExtraCodeLabel, ProcCode),
ExtraCodeTemplate = "
MR_define_extern_entry(%s);
MR_declare_label(%s_i1);
MR_BEGIN_MODULE(%s_module)
MR_init_entry(%s);
MR_init_label(%s_i1);
MR_BEGIN_CODE
MR_define_entry(%s);
MR_mkframe(""%s/%d"", %d, MR_LABEL(%s_i1));
{
// create argument vars
%s
// declare local variables
%s
// copy registers to input arg vars
%s
// copy registers to framevars
%s
// lookup hash table
%s
success_code_%s:
// lookup fact table
%s
// save output args to registers
%s
MR_framevar(1) = ind + 1;
MR_succeed();
failure_code_%s:
MR_fail();
}
MR_define_label(%s_i1);
if (MR_framevar(1) >= %s)
MR_fail();
{
// create argument vars
%s
int ind = MR_framevar(1);
// copy framevars to registers
%s
// copy registers to input arg vars
%s
// test fact table entry
%s
// lookup fact table
%s
// save output args to registers
%s
}
MR_framevar(1)++;
MR_succeed();
MR_END_MODULE
extern MR_ModuleFunc %s_module;
/*
INIT mercury_sys_init_%s_module
*/
void mercury_sys_init_%s_module(void);
void mercury_sys_init_%s_module(void) {
%s_module();
}
",
generate_argument_vars_code(ModuleInfo, Types, FactTableVars,
ArgDeclCode, InputCode, OutputCode, SaveRegsCode, GetRegsCode,
NumFrameVars),
generate_decl_code(PredName, ProcId, DeclCode),
proc_id_to_int(ProcId, ProcIdInt),
string.format("%s_%d", [s(PredName), i(ProcIdInt)], LabelName),
generate_hash_code(FactTableSize, PredName, LabelName, 0,
Types, FactTableVars, 1, HashCode),
generate_fact_lookup_code(FactTableSize, PredName,
Types, FactTableVars, 1, FactLookupCode),
generate_fact_test_code(FactTableSize, PredName,
Types, FactTableVars, FactTestCode),
string.format("mercury__%s_fact_table_num_facts",
[s(PredName)], NumFactsVar),
list.length(FactTableVars, Arity),
string.format(ExtraCodeTemplate, [
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(PredName),
i(Arity),
i(NumFrameVars),
s(ExtraCodeLabel),
s(ArgDeclCode),
s(DeclCode),
s(InputCode),
s(SaveRegsCode),
s(HashCode),
s(LabelName),
s(FactLookupCode),
s(OutputCode),
s(LabelName),
s(ExtraCodeLabel),
s(NumFactsVar),
s(ArgDeclCode),
s(GetRegsCode),
s(InputCode),
s(FactTestCode),
s(FactLookupCode),
s(OutputCode),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel)
],
ExtraCode).
% Generate code for a nondet mode using a secondary key.
%
:- pred generate_secondary_nondet_code(module_info::in, int::in, string::in,
proc_id::in, list(fact_arg_type)::in, list(fact_table_var)::in,
string::out, string::out) is det.
generate_secondary_nondet_code(ModuleInfo, FactTableSize, PredName, ProcId,
Types, FactTableVars, ProcCode, ExtraCode) :-
generate_nondet_proc_code(PredName, ProcId, FactTableVars,
ExtraCodeLabel, ProcCode),
ExtraCodeTemplate = "
MR_define_extern_entry(%s);
MR_declare_label(%s_i1);
MR_BEGIN_MODULE(%s_module)
MR_init_entry(%s);
MR_init_label(%s_i1);
MR_BEGIN_CODE
MR_define_entry(%s);
MR_mkframe(""%s/%d"", 4, MR_LABEL(%s_i1));
{
// create argument vars
%s
// declare local variables
%s
// copy registers to input arg vars
%s
// lookup hash table
%s
success_code_%s:
// lookup fact table
%s
// save output args to registers
%s
if (hashval == -1) MR_succeed_discard();
MR_framevar(1) = hashval;
MR_framevar(2) = (MR_Word) current_table;
MR_framevar(3) = (MR_Word) keytype;
MR_framevar(4) = current_key;
MR_succeed();
failure_code_%s:
MR_fail();
}
MR_define_label(%s_i1);
{
// create argument vars
%s
MR_Integer hashval = MR_framevar(1);
MR_Word ind;
void *current_table = (void *) MR_framevar(2);
char keytype = (char) MR_framevar(3);
// lookup hash table
switch(keytype)
{
case 's':
%s
break;
case 'i':
%s
break;
case 'f':
%s
break;
default:
MR_fatal_error(
""fact table hash lookup: nondet stack corrupted?"");
}
success_code_%s:
// lookup fact table
%s
// save output args to registers
%s
if (hashval == -1) MR_succeed_discard();
MR_framevar(1) = hashval;
MR_succeed();
failure_code_%s:
MR_fail();
}
MR_END_MODULE
extern MR_ModuleFunc %s_module;
/*
INIT mercury_sys_init_%s_module
*/
void mercury_sys_init_%s_module(void);
void mercury_sys_init_%s_module(void) {
%s_module();
}
",
generate_argument_vars_code(ModuleInfo, Types, FactTableVars,
ArgDeclCode, InputCode, OutputCode, _SaveRegsCode, _GetRegsCode,
_NumFrameVars),
generate_decl_code(PredName, ProcId, DeclCode),
proc_id_to_int(ProcId, ProcIdInt),
string.format("%s_%d", [s(PredName), i(ProcIdInt)], LabelName),
string.append(LabelName, "_2", LabelName2),
generate_hash_code(FactTableSize, PredName, LabelName, 0,
Types, FactTableVars, 1, HashCode),
StringVarName = "(char *) MR_framevar(4)",
IntVarName = "MR_framevar(4)",
FloatVarName = "MR_word_to_float(MR_framevar(4))",
generate_hash_lookup_code(StringVarName, LabelName2, 0,
string_equals, 's', do_not_test_keys, StringHashLookupCode),
generate_hash_lookup_code(IntVarName, LabelName2, 1,
plain_equals, 'i', do_not_test_keys, IntHashLookupCode),
generate_hash_lookup_code(FloatVarName, LabelName2, 2,
plain_equals, 'f', do_not_test_keys, FloatHashLookupCode),
generate_fact_lookup_code(FactTableSize, PredName,
Types, FactTableVars, 1, FactLookupCode),
list.length(FactTableVars, Arity),
string.format(ExtraCodeTemplate, [
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(PredName),
i(Arity),
s(ExtraCodeLabel),
s(ArgDeclCode),
s(DeclCode),
s(InputCode),
s(HashCode),
s(LabelName),
s(FactLookupCode),
s(OutputCode),
s(LabelName),
s(ExtraCodeLabel),
s(ArgDeclCode),
s(StringHashLookupCode),
s(IntHashLookupCode),
s(FloatHashLookupCode),
s(LabelName2),
s(FactLookupCode),
s(OutputCode),
s(LabelName2),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel)
],
ExtraCode).
%---------------------------------------------------------------------------%
%
% Implement detism_semi procedures.
%
% Generate semidet code for all_in mode.
%
:- pred generate_semidet_all_in_code(int::in, string::in, proc_id::in,
list(fact_arg_type)::in, list(fact_table_var)::in, string::out) is det.
generate_semidet_all_in_code(FactTableSize, PredName, ProcId,
Types, FactTableVars, ProcCode) :-
generate_decl_code(PredName, ProcId, DeclCode),
proc_id_to_int(ProcId, ProcIdInt),
string.format("%s_%d", [s(PredName), i(ProcIdInt)], LabelName),
generate_hash_code(FactTableSize, PredName, LabelName, 0,
Types, FactTableVars, 1, HashCode),
SuccessCodeTemplate = "
success_code_%s:
SUCCESS_INDICATOR = MR_TRUE;
goto skip_%s;
failure_code_%s:
SUCCESS_INDICATOR = MR_FALSE;
skip_%s:
;
",
string.format(SuccessCodeTemplate, [s(LabelName), s(LabelName),
s(LabelName), s(LabelName)], SuccessCode),
ProcCode = "\t{\n" ++ DeclCode ++ HashCode ++ SuccessCode ++ "\t}\n".
%---------------------%
% Generate code for semidet and cc_nondet in_out modes. Lookup key in
% hash table and if found return first match. If not found, fail.
%
:- pred generate_semidet_in_out_code(int::in, string::in, proc_id::in,
list(fact_arg_type)::in, list(fact_table_var)::in, string::out) is det.
generate_semidet_in_out_code(FactTableSize, PredName, ProcId,
Types, FactTableVars, ProcCode):-
generate_decl_code(PredName, ProcId, DeclCode),
proc_id_to_int(ProcId, ProcIdInt),
string.format("%s_%d", [s(PredName), i(ProcIdInt)], LabelName),
generate_hash_code(FactTableSize, PredName, LabelName, 0,
Types, FactTableVars, 1, HashCode),
SuccessCodeTemplate = "
success_code_%s:
SUCCESS_INDICATOR = MR_TRUE;
",
string.format(SuccessCodeTemplate, [s(LabelName)], SuccessCode),
generate_fact_lookup_code(FactTableSize, PredName,
Types, FactTableVars, 1, FactLookupCode),
FailCodeTemplate = "
goto skip_%s;
failure_code_%s:
SUCCESS_INDICATOR = MR_FALSE;
skip_%s:
;
",
string.format(FailCodeTemplate, [s(LabelName), s(LabelName),
s(LabelName)], FailCode),
ProcCode = "\t{\n" ++ DeclCode ++ HashCode ++ SuccessCode
++ FactLookupCode ++ FailCode ++ "\t}\n".
%---------------------------------------------------------------------------%
%
% Some service procedures used by the generate_*_code predicates above.
%
:- pred generate_decl_code(string::in, proc_id::in, string::out) is det.
generate_decl_code(Name, ProcId, DeclCode) :-
DeclCodeTemplate = "
MR_Integer hashval, hashsize;
MR_Word ind;
void *current_table;
char keytype = '\\0';
MR_Word current_key, tmp;
// Initialise current_table to the top level hash table
// for this ProcId.
current_table =
&mercury__%s_fact_table_hash_table_%d_0;
",
proc_id_to_int(ProcId, ProcIdInt),
string.format(DeclCodeTemplate, [s(Name), i(ProcIdInt)], DeclCode).
% Generate code to calculate hash values and lookup the hash tables.
%
:- pred generate_hash_code(int::in, string::in, string::in, int::in,
list(fact_arg_type)::in, list(fact_table_var)::in, int::in,
string::out) is det.
generate_hash_code(_, _, _, _, [], [], _, "").
generate_hash_code(_, _, _, _, [], [_ | _], _, _) :-
unexpected($pred, "length mismatch").
generate_hash_code(_, _, _, _, [_ | _], [], _, _) :-
unexpected($pred, "length mismatch").
generate_hash_code(FactTableSize, PredName, LabelName, LabelNum,
[Type | Types], [FactTableVar | FactTableVars], ArgNum, Code) :-
FactTableVar = fact_table_var(VarName, Mode, _, _),
NextArgNum = ArgNum + 1,
(
Mode = fully_in,
(
Type = fact_arg_type_int,
generate_hash_int_code(FactTableSize, PredName, VarName,
LabelName, LabelNum, Types, FactTableVars, NextArgNum, ArgCode)
;
Type = fact_arg_type_float,
generate_hash_float_code(FactTableSize, PredName, VarName,
LabelName, LabelNum, Types, FactTableVars, NextArgNum, ArgCode)
;
Type = fact_arg_type_string,
generate_hash_string_code(FactTableSize, PredName, VarName,
LabelName, LabelNum, Types, FactTableVars, NextArgNum, ArgCode)
),
generate_hash_code(FactTableSize, PredName, LabelName, LabelNum + 1,
Types, FactTableVars, NextArgNum, ArgsCode),
Code = ArgCode ++ ArgsCode
;
Mode = fully_out,
% Skip non-input arguments.
generate_hash_code(FactTableSize, PredName, LabelName, LabelNum,
Types, FactTableVars, NextArgNum, Code)
).
:- pred generate_hash_int_code(int::in, string::in, string::in,
string::in, int::in,
list(fact_arg_type)::in, list(fact_table_var)::in, int::in,
string::out) is det.
generate_hash_int_code(FactTableSize, PredName, VarName, LabelName, LabelNum,
Types, FactTableVars, ArgNum, Code) :-
TestKeys =
test_keys(FactTableSize, PredName, Types, FactTableVars, ArgNum),
generate_hash_lookup_code(VarName, LabelName, LabelNum,
plain_equals, 'i', TestKeys, HashLookupCode),
CodeTemplate = "
// calculate hash value for an integer
hashsize = ((struct MR_fact_table_hash_table_i *) current_table)
->size;
hashval = (%s >= 0 ? %s : -%s) %% hashsize;
current_key = %s;
// lookup the hash table
%s
",
string.format(CodeTemplate,
[s(VarName), s(VarName), s(VarName), s(VarName), s(HashLookupCode)],
Code).
:- pred generate_hash_float_code(int::in, string::in, string::in,
string::in, int::in,
list(fact_arg_type)::in, list(fact_table_var)::in, int::in,
string::out) is det.
generate_hash_float_code(FactTableSize, PredName, VarName, LabelName, LabelNum,
Types, FactTableVars, ArgNum, Code) :-
TestKeys =
test_keys(FactTableSize, PredName, Types, FactTableVars, ArgNum),
generate_hash_lookup_code(VarName, LabelName, LabelNum,
plain_equals, 'f', TestKeys, HashLookupCode),
CodeTemplate = "
// calculate hash value for a float
hashsize = ((struct MR_fact_table_hash_table_f *) current_table)
->size;
hashval = MR_hash_float(%s);
hashval = (hashval >= 0 ? hashval : -hashval) %% hashsize;
current_key = MR_float_to_word(%s);
// lookup the hash table
%s
",
string.format(CodeTemplate,
[s(VarName), s(VarName), s(HashLookupCode)], Code).
:- pred generate_hash_string_code(int::in, string::in, string::in,
string::in, int::in,
list(fact_arg_type)::in, list(fact_table_var)::in, int::in,
string::out) is det.
generate_hash_string_code(FactTableSize, PredName, VarName,
LabelName, LabelNum, Types, FactTableVars, ArgNum, Code) :-
TestKeys =
test_keys(FactTableSize, PredName, Types, FactTableVars, ArgNum),
generate_hash_lookup_code(VarName, LabelName, LabelNum,
string_equals, 's', TestKeys, HashLookupCode),
CodeTemplate = "
hashsize = ((struct MR_fact_table_hash_table_s *) current_table)->size;
// calculate hash value for a string
{
char *p;
hashval = 0;
for (p = %s ; *p != '\\0' ; p++) {
hashval = (*p + 31 * hashval) %% hashsize;
}
}
current_key = (MR_Word) %s;
// lookup the hash table
%s
",
string.format(CodeTemplate,
[s(VarName), s(VarName), s(HashLookupCode)], Code).
%---------------------%
:- type comparison_kind
---> plain_equals
; string_equals.
:- inst key_char for char/0
---> ('s')
; ('i')
; ('f').
:- type maybe_test_keys
---> do_not_test_keys
; test_keys(
int, % The fact_table_size parameter.
string, % predicate name
list(fact_arg_type),
list(fact_table_var),
int % The argument number.
).
% Generate code to lookup the key in the hash table.
% KeyType should be 's', 'i' or 'f' for string, int or float,
% respectively. CompareTemplate should be a template for testing for
% equality for the type given, e.g. "%s == %s" for ints,
% "strcmp(%s, %s) == 0" for strings.
%
:- pred generate_hash_lookup_code(string::in, string::in, int::in,
comparison_kind::in, char::in(key_char), maybe_test_keys::in,
string::out) is det.
generate_hash_lookup_code(VarName, LabelName, LabelNum,
ComparisonKind, KeyType, TestKeys, HashLookupCode) :-
string.format("((struct MR_fact_table_hash_table_%c *) current_table)"
++ "->table[hashval]", [c(KeyType)], HashTableEntry),
HashTableKey = HashTableEntry ++ ".key",
(
ComparisonKind = plain_equals,
string.format("%s == %s", [s(HashTableKey), s(VarName)],
CompareString)
;
ComparisonKind = string_equals,
string.format("strcmp(%s, %s) == 0", [s(HashTableKey), s(VarName)],
CompareString)
),
HashLookupCodeTemplate = "
do {
if (MR_FACT_TABLE_HASH_ENTRY_TYPE(%s) != 0 && %s) {
ind = (MR_Word) %s.index;
goto found_%s_%d;
}
} while ((hashval = %s.next) != -1);
// key not found
goto failure_code_%s;
found_%s_%d:
if (MR_FACT_TABLE_HASH_ENTRY_TYPE(%s) == 1) {
ind = MR_FACT_TABLE_HASH_INDEX(ind);
// check that any remaining input arguments match
%s
keytype = '%c';
hashval = %s.next;
goto success_code_%s;
}
current_table = (void *) MR_FACT_TABLE_HASH_POINTER(ind);
",
(
TestKeys =
test_keys(FactTableSize, PredName, Types, FactTableVars, ArgNum),
FactTableName = "mercury__" ++ PredName ++ "_fact_table",
generate_test_condition_code(FactTableSize, FactTableName,
Types, FactTableVars, ArgNum, have_not_seen_input_arg, CondCode),
( if CondCode = "" then
TestCode = ""
else
TestCodeTemplate = "if (%s\t\t\t) goto failure_code_%s;\n",
string.format(TestCodeTemplate, [s(CondCode), s(LabelName)],
TestCode)
)
;
TestKeys = do_not_test_keys,
TestCode = ""
),
string.format(HashLookupCodeTemplate,
[s(HashTableEntry), s(CompareString),
s(HashTableEntry), s(LabelName), i(LabelNum),
s(HashTableEntry), s(LabelName), s(LabelName), i(LabelNum),
s(HashTableEntry), s(TestCode), c(KeyType),
s(HashTableEntry), s(LabelName)],
HashLookupCode).
%---------------------%
% Generate code to lookup the fact table with a given index
%
:- pred generate_fact_lookup_code(int::in, string::in,
list(fact_arg_type)::in, list(fact_table_var)::in, int::in,
string::out) is det.
generate_fact_lookup_code(_, _, [], [], _, "").
generate_fact_lookup_code(_, _, [_ | _], [], _, _) :-
unexpected($pred, "too many pragma vars").
generate_fact_lookup_code(_, _, [], [_ | _], _, _) :-
unexpected($pred, "too many types").
generate_fact_lookup_code(FactTableSize, PredName,
[Type | Types], [FactTableVar | FactTableVars], ArgNum, Code) :-
FactTableVar = fact_table_var(VarName, Mode, MakeUnique, _),
(
Mode = fully_out,
TableEntryTemplate = "mercury__%s_fact_table[ind/%d][ind%%%d].V_%d",
string.format(TableEntryTemplate,
[s(PredName), i(FactTableSize), i(FactTableSize), i(ArgNum)],
TableEntry),
(
Type = fact_arg_type_string,
(
MakeUnique = do_not_make_unique,
% Cast MR_ConstString -> MR_Word -> MR_String to avoid gcc
% warning "assignment discards `const'".
Template = "\t\tMR_make_aligned_string(%s, " ++
"(MR_String) (MR_Word) %s);\n",
string.format(Template, [s(VarName), s(TableEntry)], ArgCode)
;
MakeUnique = make_unique,
% Unique modes need to allow destructive update,
% so we need to make a copy of the string on the heap.
Template =
" MR_incr_hp_atomic(tmp,
(strlen(%s) + sizeof(MR_Word))
/ sizeof(MR_Word));
%s = (MR_String) tmp;
strcpy(%s, %s);
",
string.format(Template,
[s(TableEntry), s(VarName), s(VarName), s(TableEntry)],
ArgCode)
)
;
( Type = fact_arg_type_int
; Type = fact_arg_type_float
),
Template = "\t\t%s = %s;\n",
string.format(Template, [s(VarName), s(TableEntry)], ArgCode)
),
generate_fact_lookup_code(FactTableSize, PredName,
Types, FactTableVars, ArgNum + 1, ArgsCode),
Code = ArgCode ++ ArgsCode
;
Mode = fully_in,
% Skip non-output arguments.
generate_fact_lookup_code(FactTableSize, PredName,
Types, FactTableVars, ArgNum + 1, Code)
).
% Generate code to create argument variables and assign them to registers.
%
:- pred generate_argument_vars_code(module_info::in,
list(fact_arg_type)::in, list(fact_table_var)::in,
string::out, string::out, string::out,
string::out, string::out, int::out) is det.
generate_argument_vars_code(ModuleInfo, FactArgTypes, FactTableVars,
DeclCode, InputCode, OutputCode, SaveRegsCode, GetRegsCode,
NumInputArgs) :-
Types = list.map(
( func(FactArgType) = Type :-
( FactArgType = fact_arg_type_int, Type = int_type
; FactArgType = fact_arg_type_float, Type = float_type
; FactArgType = fact_arg_type_string, Type = string_type
)
), FactArgTypes),
Modes = list.map(
( func(fact_table_var(_, FactTableMode, _, _)) = Mode :-
( FactTableMode = fully_in, Mode = in_mode
; FactTableMode = fully_out, Mode = out_mode
)
), FactTableVars),
make_standard_arg_infos(ModuleInfo, model_non, Types, Modes, ArgInfos),
% XXX Starting counting NumInputArgs at 1 looks strange, since
% we have not seen any input args yet. However, while the code of
% generate_argument_vars_code_loop also refers to this arg pair
% as !NumInputArgs, generate_arg_input_code refers to it as FrameVarNum,
% and uses it accordingly.
generate_argument_vars_code_loop(FactArgTypes, FactTableVars, ArgInfos,
DeclCode, InputCode, OutputCode, SaveRegsCode, GetRegsCode,
1, NumInputArgs).
:- pred generate_argument_vars_code_loop(
list(fact_arg_type)::in, list(fact_table_var)::in, list(arg_info)::in,
string::out, string::out, string::out,
string::out, string::out, int::in, int::out) is det.
generate_argument_vars_code_loop(Types, FactTableVars, ArgInfos,
DeclCode, InputCode, OutputCode, SaveRegsCode, GetRegsCode,
!NumInputArgs) :-
( if
Types = [],
FactTableVars = [],
ArgInfos = []
then
DeclCode = "",
InputCode = "",
OutputCode = "",
SaveRegsCode = "",
GetRegsCode = ""
else if
Types = [Type | TailTypes],
FactTableVars = [FactTableVar | TailFactTableVars],
ArgInfos = [ArgInfo | TailArgInfos]
then
FactTableVar = fact_table_var(VarName, Mode, _, _),
ArgInfo = arg_info(Loc, _),
generate_arg_decl_code(VarName, Type, ArgDeclCode),
(
Mode = fully_in,
!:NumInputArgs = !.NumInputArgs + 1,
generate_arg_input_code(VarName, Type, Loc, !.NumInputArgs,
ArgInputCode, ArgSaveRegsCode, ArgGetRegsCode),
ArgOutputCode = ""
;
Mode = fully_out,
generate_arg_output_code(VarName, Type, Loc, ArgOutputCode),
ArgInputCode = "",
ArgSaveRegsCode = "",
ArgGetRegsCode = ""
),
generate_argument_vars_code_loop(
TailTypes, TailFactTableVars, TailArgInfos,
ArgsDeclCode, ArgsInputCode, ArgsOutputCode, ArgsSaveRegsCode,
ArgsGetRegsCode, !NumInputArgs),
DeclCode = ArgDeclCode ++ ArgsDeclCode,
InputCode = ArgInputCode ++ ArgsInputCode,
OutputCode = ArgOutputCode ++ ArgsOutputCode,
SaveRegsCode = ArgSaveRegsCode ++ ArgsSaveRegsCode,
GetRegsCode = ArgGetRegsCode ++ ArgsGetRegsCode
else
unexpected($pred, "list length mismatch")
).
:- pred generate_arg_decl_code(string::in, fact_arg_type::in, string::out)
is det.
generate_arg_decl_code(Name, Type, DeclCode) :-
( Type = fact_arg_type_int, CType = "MR_Integer"
; Type = fact_arg_type_float, CType = "MR_Float"
; Type = fact_arg_type_string, CType = "MR_String"
),
string.format("\t\t%s %s;\n", [s(CType), s(Name)], DeclCode).
:- pred generate_arg_input_code(string::in, fact_arg_type::in, arg_loc::in,
int::in, string::out, string::out, string::out) is det.
generate_arg_input_code(Name, Type, ArgLoc, FrameVarNum,
InputCode, SaveRegCode, GetRegCode) :-
ArgLoc = reg(RegType, RegNum),
(
RegType = reg_r,
ConvertToFrameVar = "",
ConvertFromFrameVar = ""
;
RegType = reg_f,
ConvertToFrameVar = "MR_float_to_word",
ConvertFromFrameVar = "MR_word_to_float"
),
RegNameStr = reg_to_string(RegType, RegNum),
convert_arg_type_from_mercury(ArgLoc, RegNameStr, Type,
ConvertedRegNameStr),
string.format("\t\t%s = %s;\n",
[s(Name), s(ConvertedRegNameStr)], InputCode),
string.format("\t\tMR_framevar(%d) = %s(%s);\n",
[i(FrameVarNum), s(ConvertToFrameVar), s(RegNameStr)], SaveRegCode),
string.format("\t\t%s = %s(MR_framevar(%d));\n",
[s(RegNameStr), s(ConvertFromFrameVar), i(FrameVarNum)], GetRegCode).
:- pred generate_arg_output_code(string::in, fact_arg_type::in, arg_loc::in,
string::out) is det.
generate_arg_output_code(Name, Type, ArgLoc, OutputCode) :-
ArgLoc = reg(RegType, RegNum),
RegName = reg_to_string(RegType, RegNum),
convert_arg_type_to_mercury(Name, Type, ArgLoc, ConvertedName),
Template = "\t\t%s = %s;\n",
string.format(Template, [s(RegName), s(ConvertedName)], OutputCode).
%---------------------%
:- pred convert_arg_type_to_mercury(string::in, fact_arg_type::in, arg_loc::in,
string::out) is det.
convert_arg_type_to_mercury(RvalStr, Type, TargetArgLoc, ConvertedRvalStr) :-
% This code is a version of convert_type_to_mercury that has been cut down
% to handle only fact_arg_types.
(
Type = fact_arg_type_int,
ConvertedRvalStr = RvalStr
;
Type = fact_arg_type_float,
(
TargetArgLoc = reg(reg_r, _),
ConvertedRvalStr = "MR_float_to_word(" ++ RvalStr ++ ")"
;
TargetArgLoc = reg(reg_f, _),
ConvertedRvalStr = RvalStr
)
;
Type = fact_arg_type_string,
ConvertedRvalStr = "(MR_Word) " ++ RvalStr
).
:- pred convert_arg_type_from_mercury(arg_loc::in, string::in,
fact_arg_type::in, string::out) is det.
convert_arg_type_from_mercury(SourceArgLoc, RvalStr, Type, ConvertedRvalStr) :-
% This code is a version of convert_type_from_mercury
% cut down to handle only fact_arg_types.
(
Type = fact_arg_type_int,
ConvertedRvalStr = RvalStr
;
Type = fact_arg_type_float,
(
SourceArgLoc = reg(reg_r, _),
ConvertedRvalStr = "MR_word_to_float(" ++ RvalStr ++ ")"
;
SourceArgLoc = reg(reg_f, _),
ConvertedRvalStr = RvalStr
)
;
Type = fact_arg_type_string,
ConvertedRvalStr = "(MR_String) " ++ RvalStr
).
%---------------------%
% Generate code to test that the fact found matches the input arguments.
% This is only required for generate_primary_nondet_code. Other procedures
% can test the key in the hash table against the input arguments.
%
:- pred generate_fact_test_code(int::in, string::in,
list(fact_arg_type)::in, list(fact_table_var)::in, string::out) is det.
generate_fact_test_code(FactTableSize, PredName,
Types, FactTableVars, FactTestCode) :-
FactTableName = "mercury__" ++ PredName ++ "_fact_table",
generate_test_condition_code(FactTableSize, FactTableName,
Types, FactTableVars, 1, have_not_seen_input_arg, CondCode),
FactTestCode = "\t\tif(" ++ CondCode ++ "\t\t) MR_fail();\n".
:- type maybe_seen_input_arg
---> have_seen_input_arg
; have_not_seen_input_arg.
:- pred generate_test_condition_code(int::in, string::in,
list(fact_arg_type)::in, list(fact_table_var)::in, int::in,
maybe_seen_input_arg::in, string::out) is det.
generate_test_condition_code(_, _, [], [], _, _, "").
generate_test_condition_code(_, _, [_ | _], [], _, _, "") :-
unexpected($pred, "too many PragmaVars").
generate_test_condition_code(_, _, [], [_ | _], _, _, "") :-
unexpected($pred, "too many ArgTypes").
generate_test_condition_code(FactTableSize, FactTableName,
[Type | Types], [FactTableVar | FactTableVars], ArgNum,
!.IsFirstInputArg, CondCode) :-
FactTableVar = fact_table_var(Name, Mode, _, _),
(
Mode = fully_in,
(
Type = fact_arg_type_string,
Template = "strcmp(%s[ind/%d][ind%%%d].V_%d, %s) != 0\n",
string.format(Template, [s(FactTableName), i(FactTableSize),
i(FactTableSize), i(ArgNum), s(Name)], ArgCondCode0)
;
( Type = fact_arg_type_int
; Type = fact_arg_type_float
),
Template = "%s[ind/%d][ind%%%d].V_%d != %s\n",
string.format(Template, [s(FactTableName), i(FactTableSize),
i(FactTableSize), i(ArgNum), s(Name)], ArgCondCode0)
),
(
!.IsFirstInputArg = have_seen_input_arg,
ArgCondCode = "\t\t|| " ++ ArgCondCode0
;
!.IsFirstInputArg = have_not_seen_input_arg,
ArgCondCode = ArgCondCode0
),
!:IsFirstInputArg = have_seen_input_arg
;
Mode = fully_out,
ArgCondCode = ""
),
generate_test_condition_code(FactTableSize, FactTableName,
Types, FactTableVars, ArgNum + 1, !.IsFirstInputArg, ArgsCondCode),
CondCode = ArgCondCode ++ ArgsCondCode.
%---------------------------------------------------------------------------%
:- pred make_fact_table_identifier(sym_name::in, string::out) is det.
make_fact_table_identifier(SymName, Identifier) :-
Identifier = sym_name_mangle(SymName).
%---------------------------------------------------------------------------%
% fact_table_vars_to_names_string(PragmaVars, NamesString):
%
% Create a string containing the names of the vars separated by commas.
%
:- pred fact_table_vars_to_names_string(list(fact_table_var)::in,
string::out) is det.
fact_table_vars_to_names_string([], "").
fact_table_vars_to_names_string([FactTableVar | FactTableVars],
NamesString) :-
fact_table_vars_to_names_string(FactTableVars, NamesStringTail),
FactTableVar = fact_table_var(Name, _, _, _),
NamesString = Name ++ ", " ++ NamesStringTail.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% fact_table_size(Globals, FactTableSize):
%
% FactTableSize is the maximum size of each array in the fact data table.
% GCC doesn't cope very well with huge arrays, so we break the fact data
% table into a number of smaller arrays, each with a maximum size given
% by FactTableSize, and create an array of pointers to these arrays
% to access the data. The size should be a power of 2 to make the
% generated code more efficient.
%
:- pred fact_table_size(globals::in, int::out) is det.
fact_table_size(Globals, FactTableSize) :-
globals.lookup_int_option(Globals, fact_table_max_array_size,
FactTableSize).
%---------------------------------------------------------------------------%
% Delete a file. Report an error message if something goes wrong.
%
:- pred delete_temporary_file(string::in,
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
delete_temporary_file(FileName, !Specs, !IO) :-
io.file.remove_file(FileName, Result, !IO),
(
Result = ok
;
Result = error(ErrorCode),
io.error_message(ErrorCode, ErrorMsg),
io.progname_base("mercury_compile", ProgName, !IO),
Pieces = [fixed(ProgName), suffix(":"), words("error deleting file"),
quote(FileName), suffix(":"), nl,
words(ErrorMsg), suffix("."), nl],
Spec = error_spec($pred, severity_error, phase_fact_table_check,
[error_msg(no, treat_based_on_posn, 0u, [always(Pieces)])]),
!:Specs = [Spec | !.Specs]
).
%---------------------------------------------------------------------------%
:- pred add_call_system_error(string::in, io.error::in,
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
add_call_system_error(Cmd, ErrorCode, !Specs, !IO) :-
io.progname_base("mercury_compile", ProgName, !IO),
io.error_message(ErrorCode, ErrorMsg),
Pieces = [fixed(ProgName), suffix(":"),
words("error executing system command"), quote(Cmd), suffix(":"), nl,
words(ErrorMsg), suffix("."), nl],
Spec = error_spec($pred, severity_error, phase_fact_table_check,
[error_msg(no, treat_based_on_posn, 0u, [always(Pieces)])]),
!:Specs = [Spec | !.Specs].
%---------------------------------------------------------------------------%
:- pred add_file_open_error(maybe(prog_context)::in, string::in, string::in,
io.error::in, list(error_spec)::in, list(error_spec)::out,
io::di, io::uo) is det.
add_file_open_error(MaybeContext, FileName, InOrOut, Error, !Specs, !IO) :-
io.progname_base("mercury_compile", ProgName, !IO),
io.error_message(Error, ErrorMsg),
Pieces = [fixed(ProgName), suffix(":"),
words("error opening file"), quote(FileName),
words("for"), words(InOrOut), suffix(":"), nl,
words(ErrorMsg), nl],
Spec = error_spec($pred, severity_error, phase_fact_table_check,
[error_msg(MaybeContext, treat_based_on_posn, 0u, [always(Pieces)])]),
!:Specs = [Spec | !.Specs].
%---------------------------------------------------------------------------%
:- pred add_error_context_and_pieces(prog_context::in,
list(format_piece)::in,
list(error_spec)::in, list(error_spec)::out) is det.
add_error_context_and_pieces(Context, Pieces, !Specs) :-
Spec = spec($pred, severity_error, phase_fact_table_check,
Context, Pieces),
!:Specs = [Spec | !.Specs].
:- pred add_error_pieces(list(format_piece)::in,
list(error_spec)::in, list(error_spec)::out) is det.
add_error_pieces(Pieces, !Specs) :-
Spec = no_ctxt_spec($pred, severity_error,
phase_fact_table_check, Pieces),
!:Specs = [Spec | !.Specs].
%---------------------------------------------------------------------------%
:- pred get_maybe_progress_output_stream(module_info::in,
io.text_output_stream::in, maybe(io.text_output_stream)::out) is det.
get_maybe_progress_output_stream(ModuleInfo, ProgressStream,
MaybeProgressStream) :-
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, very_verbose, VeryVerbose),
(
VeryVerbose = no,
MaybeProgressStream = no
;
VeryVerbose = yes,
MaybeProgressStream = yes(ProgressStream)
).
%---------------------------------------------------------------------------%
:- end_module ll_backend.fact_table_gen.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink