[m-dev.] Re: pragma fact_table
David Matthew OVERTON
dmo at students.cs.mu.oz.au
Fri Feb 21 17:39:09 AEDT 1997
Hi Fergus,
Could you please review the following changes. The diff of
fact_table.m is relative to the version you saw last week. Other
diffs are relative to the latest version in the CVS repository.
David
Estimated hours taken: 230
Implemented `:- pragma fact_table' for string, int and float
argument types. Facts can have any combination of input and output modes.
Hash tables are used to lookup facts in modes that have input
arguments.
compiler/fact_table.m:
Added code for outputting `pragma c_code' to access facts in all
mode/determinism combinations in `pragma fact_table's.
Added code to build and output hash tables (as C arrays) for
input modes of fact tables.
Many other changes and rearrangements in the module to support the
above.
compiler/llds_out.m:
Moved declarations of `llds_out__reg_to_string/3' and
`output_c_quoted_string/3' to the interface section so they
can be used by `fact_table.m'. Changed
`llds_out__reg_to_string/3' to be compatible with
`output_reg/4'. Changed `output_reg/4' to call
`llds_out__reg_to_string/3' to format the register name to be
output.
compiler/make_hlds.m:
Added arguments to the calls to predicates in fact_table.m
where necessary.
Add `c_header_code' returned by `fact_table_compile_facts' to
the module_info.
compiler/modules.m:
Added a dependency to `.d' files to ensure that fact table C
files are recompiled whenever they are recreated.
compiler/options.m
Added new options:
`--fact-table-max-array-size <n>' where n is the
maximum size array to use for `pragma fact_table' data.
(default 1024)
`--fact-table-hash-percent-full <n>' where n is how
full the `pragma fact_table' hash tables should be
allowed to get, given as an integer percentage
(between 1 and 99). (default 90).
--- ../../bak/fact_table.m Mon Feb 17 10:53:37 1997
+++ fact_table.m Fri Feb 21 17:05:37 1997
@@ -9,16 +9,42 @@
% 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, type and mode
-% checked, and then output as an element in an array of C structures.
-% Hash tables are created to access the data in each mode of the predicate.
-% Determinism for each procedure in the predicate is inferred and 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_report.m.
+%
+% 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_report.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 Because of the way nondet and multidet code is currently generated, it
+% will not work if the procedure is inlined. Until this problem is fixed,
+% modules containing `pragma fact_table' declarations should be compiled
+% with the `--no-inlining' option.
:- module fact_table.
@@ -26,50 +52,70 @@
:- interface.
:- import_module io, string, list.
-:- import_module prog_data, hlds_pred.
+:- import_module prog_data, hlds_pred, hlds_module.
% compile the fact table into a separate .o file.
% fact_table_compile_facts(PredName, Arity, FileName, PredInfo0,
- % PredInfo, Context, C_HeaderCode, PrimaryProcID)
+ % PredInfo, Context, ModuleInfo, C_HeaderCode, PrimaryProcID)
:- pred fact_table_compile_facts(sym_name, arity, string, pred_info, pred_info,
- term__context, string, proc_id, io__state, io__state).
-:- mode fact_table_compile_facts(in, in, in, in, out, in, out, out,
+ term__context, module_info, string, proc_id,
+ io__state, io__state).
+:- mode fact_table_compile_facts(in, in, in, in, out, in, in, out, out,
di, uo) is det.
% generate c code to lookup a fact table in a given mode
% fact_table_generate_c_code(PredName, PragmaVars, ProcID,
- % PrimaryProcID, ProcInfo, ArgTypes, C_ProcCode,
- % C_ExtraCode).
+ % PrimaryProcID, ProcInfo, ArgTypes, C_ProcCode, C_ExtraCode).
% C_ProcCode is the C code for the procedure,
% C_ExtraCode is extra C code that should be included in the module
- % XXX C_ExtraCode is to get around current problems with producing
- % nondet and multidet pragma c.
-:- pred fact_table_generate_c_code(sym_name, list(pragma_var), proc_id, proc_id,
- proc_info, list(type), args_method, string, string).
-:- mode fact_table_generate_c_code(in, in, in, in, in, in, in,
- out, out) is det.
+ %
+ % XXX model_non pragma c is not completely supported by the compiler
+ % at the moment -- the programmer has no control over how the nondet
+ % stack frames are set up (e.g. how many framevars are used) or how
+ % many labels are declared. 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 C_ExtraCode. C_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 lookup the fact table.
+ % Note: this code will not work if the predicate is inlined so
+ % fact tables should always be compiled with `--no-inlining'. This
+ % problem should be fixed when model_non pragma C is implemented
+ % correctly.
+:- pred fact_table_generate_c_code(sym_name, list(pragma_var), proc_id,
+ proc_id, proc_info, list(type), args_method, module_info,
+ string, string, io__state, io__state).
+:- mode fact_table_generate_c_code(in, in, in, in, in, in, in, in, out, out,
+ di, uo) is det.
+%------------------------------------------------------------------------------%
:- implementation.
:- import_module int, map, std_util, assoc_list, char, require, library, bool.
-:- import_module parser, prog_out, term_io, hlds_out, hlds_data.
-:- import_module globals, options, passes_aux, float, math.
+:- import_module float, math, getopt.
+:- import_module parser, prog_out, term_io, llds_out, hlds_out, hlds_data.
+:- import_module globals, options, passes_aux, arg_info, llds, mode_util.
+:- import_module code_util.
:- type fact_result
---> ok ; error.
+ % proc_stream contains information about an open sort file for
+ % a particular procedure.
:- type proc_stream
---> proc_stream(
proc_id, % ID of procedure
- io__output_stream % Sort file
+ io__output_stream % Sort file stream
).
:- type hash_entry
---> hash_entry(
fact_arg, % lookup key
- hash_index, % index
- int % pos of next entry with same hash val
+ 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
@@ -116,15 +162,26 @@
bool % is an output argument for some mode
).
- % maximum size of each array in the fact table
-:- pred fact_table_size(int::out) is det.
-
-fact_table_size(1024).
+ % 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 this
+ % predicate, 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(int::out, io__state::di, io__state::uo) is det.
+
+fact_table_size(FactTableSize) -->
+ globals__io_lookup_option(fact_table_max_array_size, OptionData),
+ { OptionData = int(FactTableSize0) ->
+ FactTableSize = FactTableSize0
+ ;
+ error("fact_table_size: invalid option data")
+ }.
%------------------------------------------------------------------------------%
fact_table_compile_facts(PredName, Arity, FileName, PredInfo0, PredInfo,
- Context, C_HeaderCode, PrimaryProcID) -->
+ Context, ModuleInfo, C_HeaderCode, PrimaryProcID) -->
io__see(FileName, Result0),
(
{ Result0 = ok },
@@ -134,35 +191,35 @@
{ Result1 = ok(OutputStream) },
{ pred_info_arg_types(PredInfo0, _, Types) },
{ init_fact_arg_infos(Types, FactArgInfos0) },
- infer_determinism_pass_1(PredInfo0, PredInfo1, CheckProcs,
- ExistsAllInMode, WriteHashTables, WriteDataTable, FactArgInfos0,
- FactArgInfos),
+ infer_determinism_pass_1(PredInfo0, PredInfo1, ModuleInfo,
+ CheckProcs, ExistsAllInMode, WriteHashTables, WriteDataTable,
+ FactArgInfos0, FactArgInfos),
write_fact_table_header(PredInfo0, FileName, FactArgInfos,
OutputStream, C_HeaderCode0, StructName, Result2),
- { string__append_list(["/tmp/", FileName, ".data.tmp"],
- DataFileName) },
(
{ Result2 = ok },
- open_sort_files(CheckProcs, FileName, ProcStreams),
- { WriteDataTable = yes ->
- ( CheckProcs = [] ->
- MaybeOutput = yes(OutputStream - StructName),
- WriteDataAfterSorting = no
+ open_sort_files(CheckProcs, ProcStreams),
+ ( { WriteDataTable = yes } ->
+ ( { CheckProcs = [] } ->
+ { MaybeOutput = yes(OutputStream - StructName) },
+ % opening brace for first fact data array
+ write_new_data_array(OutputStream, StructName, 0),
+ { WriteDataAfterSorting = no }
;
- MaybeOutput = no,
- WriteDataAfterSorting = yes
+ { MaybeOutput = no },
+ { WriteDataAfterSorting = yes }
)
;
- MaybeOutput = no,
- WriteDataAfterSorting = no
- },
- compile_facts(PredName, Arity, PredInfo1, FactArgInfos,
- ProcStreams, MaybeOutput, 0, NumFacts),
+ { MaybeOutput = no },
+ { WriteDataAfterSorting = no }
+ ),
+ compile_facts(PredName, Arity, PredInfo1, ModuleInfo,
+ FactArgInfos, ProcStreams, MaybeOutput, 0, NumFacts),
io__seen,
(
{ MaybeOutput = yes(_) },
- % closing brace for the final fact table
- io__write_string(OutputStream, "};\n\n"),
+ % closing brace for last fact data array
+ write_closing_brace(OutputStream),
write_fact_table_pointer_array(NumFacts, StructName,
OutputStream, C_HeaderCode2)
;
@@ -174,10 +231,11 @@
infer_determinism_pass_2(ProcStreams, ProcFiles,
ExistsAllInMode, ProcTable0, ProcTable),
{ pred_info_set_procedures(PredInfo1, ProcTable, PredInfo) },
+ io__tmpnam(DataFileName),
write_fact_table_arrays(ProcFiles, DataFileName, StructName,
- ProcTable, NumFacts, FactArgInfos, WriteHashTables,
- WriteDataAfterSorting, OutputStream, C_HeaderCode1,
- PrimaryProcID),
+ ProcTable, ModuleInfo, NumFacts, FactArgInfos,
+ WriteHashTables, WriteDataAfterSorting, OutputStream,
+ C_HeaderCode1, PrimaryProcID),
write_fact_table_numfacts(PredInfo, NumFacts, OutputStream,
C_HeaderCode3),
{ string__append_list([C_HeaderCode0, C_HeaderCode1,
@@ -190,7 +248,8 @@
{ PredInfo = PredInfo0 },
{ C_HeaderCode = C_HeaderCode0 },
{ PrimaryProcID = -1 },
- { WriteDataAfterSorting = no }
+ { WriteDataAfterSorting = no },
+ { DataFileName = "" }
),
io__close_output(OutputStream),
maybe_append_data_table(WriteDataAfterSorting, OutputFileName,
@@ -231,12 +290,13 @@
%------------------------------------------------------------------------------%
% read in facts one by one and check and compile them
-:- pred compile_facts(sym_name, arity, pred_info, list(fact_arg_info),
- list(proc_stream), maybe(pair(io__output_stream, string)),
- int, int, io__state, io__state).
-:- mode compile_facts(in, in, in, in, in, in, in, out, di, uo) is det.
+:- pred compile_facts(sym_name, arity, pred_info, module_info,
+ list(fact_arg_info), list(proc_stream),
+ maybe(pair(io__output_stream, string)), int, int,
+ io__state, io__state).
+:- mode compile_facts(in, in, in, in, in, in, in, in, out, di, uo) is det.
-compile_facts(PredName, Arity, PredInfo, FactArgInfos, ProcStreams,
+compile_facts(PredName, Arity, PredInfo, ModuleInfo, FactArgInfos, ProcStreams,
MaybeOutput, NumFacts0, NumFacts) -->
parser__read_term(Result0),
(
@@ -251,11 +311,11 @@
{ NumFacts = NumFacts0 }
;
{ Result0 = term(_VarSet, Term) },
- { fact_table_size(FactTableSize) },
+ fact_table_size(FactTableSize),
( { 0 is NumFacts0 mod FactTableSize } ->
- globals__io_lookup_bool_option(verbose, Verbose),
+ globals__io_lookup_bool_option(very_verbose, Verbose),
( { Verbose = yes } ->
- io__format("% Read fact %d\n", [i(NumFacts0)])
+ io__format("%% Read fact %d\n", [i(NumFacts0)])
;
[]
)
@@ -263,8 +323,9 @@
[]
),
- check_fact_term(PredName, Arity, PredInfo, Term, FactArgInfos,
- ProcStreams, MaybeOutput, NumFacts0, Result1),
+ check_fact_term(PredName, Arity, PredInfo, ModuleInfo, Term,
+ FactArgInfos, ProcStreams, MaybeOutput, NumFacts0,
+ Result1),
{
Result1 = ok,
NumFacts1 is NumFacts0 + 1
@@ -272,18 +333,20 @@
Result1 = error,
NumFacts1 = NumFacts0
},
- compile_facts(PredName, Arity, PredInfo, FactArgInfos,
- ProcStreams, MaybeOutput, NumFacts1, NumFacts)
+ compile_facts(PredName, Arity, PredInfo, ModuleInfo,
+ FactArgInfos, ProcStreams, MaybeOutput, NumFacts1,
+ NumFacts)
).
% do syntactic and semantic checks on a fact term
-:- pred check_fact_term(sym_name, arity, pred_info, term, list(fact_arg_info),
- list(proc_stream), maybe(pair(io__output_stream, string)),
- int, fact_result, io__state, io__state).
-:- mode check_fact_term(in, in, in, in, in, in, in, in, out, di, uo)
+:- pred check_fact_term(sym_name, arity, pred_info, module_info, term,
+ list(fact_arg_info), list(proc_stream),
+ maybe(pair(io__output_stream, string)), int, fact_result,
+ io__state, io__state).
+:- mode check_fact_term(in, in, in, in, in, in, in, in, in, out, di, uo)
is det.
-check_fact_term(_, _, _, term__variable(_V), _, _, _, _, error) -->
+check_fact_term(_, _, _, _, term__variable(_V), _, _, _, _, error) -->
io__get_line_number(LineNum),
io__input_stream_name(FileName),
prog_out__write_context(term__context(FileName, LineNum)),
@@ -291,7 +354,7 @@
io__set_exit_status(1).
-check_fact_term(PredName, Arity0, PredInfo,
+check_fact_term(PredName, Arity0, PredInfo, ModuleInfo,
term__functor(Const, Terms0, Context), FactArgInfos, ProcStreams,
MaybeOutput, FactNum, Result) -->
{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
@@ -330,7 +393,7 @@
{ pred_info_procedures(PredInfo, ProcTable) },
{ string__int_to_string(FactNum, FactNumStr) },
write_sort_file_lines(ProcStreams, ProcTable, Terms,
- FactNumStr, FactArgInfos, yes),
+ ModuleInfo, FactNumStr, FactArgInfos, yes),
% If there are no in_out modes to the predicate, we need
% to write out the facts at this point. If there are
@@ -483,8 +546,7 @@
:- mode write_fact_table_header(in, in, in, in, out, out, out, di, uo) is det.
write_fact_table_header(PredInfo, FileName, FactArgInfos, OutputStream,
- C_HeaderCode, StructName, Result)
- -->
+ C_HeaderCode, StructName, Result) -->
{ library__version(Version) },
io__write_strings(OutputStream,
["/*\n** Automatically generated from `", FileName,
@@ -493,7 +555,8 @@
io__write_string(OutputStream, "#include ""imp.h""\n\n"),
{ pred_info_name(PredInfo, Name) },
- { string__append_list(["mercury__", Name, "_fact_table"],
+ { llds_out__name_mangle(Name, MangledName) },
+ { string__append_list(["mercury__", MangledName, "_fact_table"],
StructName) },
% Define a struct for a fact table entry.
@@ -531,12 +594,14 @@
/* hash table for string keys */
struct fact_table_hash_entry_s {
- const char *key; /* lookup key */
+ ConstString key; /* lookup key */
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 */
};
@@ -544,7 +609,9 @@
struct fact_table_hash_entry_f {
Float key;
Word index;
+#if TAGBITS < 2
short type;
+#endif
int next;
};
@@ -552,21 +619,36 @@
struct fact_table_hash_entry_i {
Integer key;
Word index;
+#if TAGBITS < 2
short type;
+#endif
int next;
};
+
+#if TAGBITS >= 2
+ #define FACT_TABLE_MAKE_TAGGED_INDEX(i,t) (mkbody(i) | mktag(t))
+ #define FACT_TABLE_MAKE_TAGGED_POINTER(p,t) (((Word) p) + mktag(t))
+ #define FACT_TABLE_HASH_ENTRY_TYPE(p) (tag((p).index))
+ #define FACT_TABLE_HASH_INDEX(w) (unmkbody(w))
+ #define FACT_TABLE_HASH_POINTER(w) ((w) & ((~(Word)0) << TAGBITS))
+#else
+ #define FACT_TABLE_MAKE_TAGGED_INDEX(i,t) ((Word) i), (t)
+ #define FACT_TABLE_MAKE_TAGGED_POINTER(p,t) ((Word) p), (t)
+ #define FACT_TABLE_HASH_ENTRY_TYPE(p) ((p).type)
+ #define FACT_TABLE_HASH_INDEX(w) (w)
+ #define FACT_TABLE_HASH_POINTER(w) (w)
#endif
-" },
+#endif /* not MERCURY_FACT_TABLE_HASH_TABLES */
+" },
+
io__write_string(OutputStream, HashDef),
{ string__append_list([
"#include <math.h>\n\n", % math.h needed for hashing floats
- StructDef, HashDef
- ], C_HeaderCode) }.
-
+ StructDef, HashDef ], C_HeaderCode) }.
- % Create a struct for the fact tabe consisting of any arguments
+ % 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 write_fact_table_struct(list(fact_arg_info), int, term__context,
@@ -579,14 +661,12 @@
(
{ Type = term__functor(term__atom("string"), [], _) }
->
- % XXX using "const String" causes some unwanted warning messages
- % from mgnuc so I'm using "const char *" for now.
{ I1 is I + 1 },
write_fact_table_struct(Infos, I1, Context,
StructContents1, Result),
{
IsOutput = yes,
- string__format("\tconst char * V_%d;\n", [i(I)],
+ string__format("\tConstString V_%d;\n", [i(I)],
StructContents0),
string__append(StructContents0, StructContents1,
StructContents)
@@ -652,21 +732,19 @@
Info = fact_arg_info(Type, no, no),
init_fact_arg_infos(Types, Infos).
-:- pred fill_in_fact_arg_infos(list(mode), list(fact_arg_info),
+:- pred fill_in_fact_arg_infos(list(mode), module_info, list(fact_arg_info),
list(fact_arg_info)).
-:- mode fill_in_fact_arg_infos(in, in, out) is det.
+:- mode fill_in_fact_arg_infos(in, in, in, out) is det.
-fill_in_fact_arg_infos([], [], []).
-fill_in_fact_arg_infos([_|_], [], _) :-
+fill_in_fact_arg_infos([], _, [], []).
+fill_in_fact_arg_infos([_|_], _, [], _) :-
error("fill_in_fact_arg_infos: too many argmodes").
-fill_in_fact_arg_infos([], [_|_], _) :-
+fill_in_fact_arg_infos([], _, [_|_], _) :-
error("fill_in_fact_arg_infos: too many fact_arg_infos").
-fill_in_fact_arg_infos([Mode | Modes], [Info0 | Infos0], [Info | Infos]) :-
+fill_in_fact_arg_infos([Mode | Modes], ModuleInfo, [Info0 | Infos0],
+ [Info | Infos]) :-
Info0 = fact_arg_info(Type, IsInput, _IsOutput),
- (
- Mode = user_defined_mode(qualified("mercury_builtin", "in"),
- [])
- ->
+ ( mode_is_input(ModuleInfo, Mode) ->
% XXX Info = fact_arg_info(Type, yes, IsOutput)
% XXX currently the first input mode requires _all_ arguments to
@@ -674,10 +752,8 @@
% 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, yes, yes)
- ;
- Mode = user_defined_mode(qualified("mercury_builtin", "out"),
- [])
- ->
+
+ ; mode_is_output(ModuleInfo, Mode) ->
Info = fact_arg_info(Type, IsInput, yes)
;
% this is a mode error that will be reported by
@@ -684,7 +760,7 @@
% infer_proc_determinism_pass_1
Info = Info0
),
- fill_in_fact_arg_infos(Modes, Infos0, Infos).
+ fill_in_fact_arg_infos(Modes, ModuleInfo, Infos0, Infos).
%------------------------------------------------------------------------------%
@@ -693,19 +769,19 @@
% (out, out, ..., out) procs are multidet 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(pred_info, pred_info, list(proc_id), bool,
- bool, bool, list(fact_arg_info), list(fact_arg_info),
- io__state, io__state).
-:- mode infer_determinism_pass_1(in, out, out, out, out, out, in, out, di, uo)
- is det.
+:- pred infer_determinism_pass_1(pred_info, pred_info, module_info,
+ list(proc_id), bool, bool, bool, list(fact_arg_info),
+ list(fact_arg_info), io__state, io__state).
+:- mode infer_determinism_pass_1(in, out, in, out, out, out, out, in, out,
+ di, uo) is det.
-infer_determinism_pass_1(PredInfo0, PredInfo, CheckProcs, ExistsAllInMode,
- WriteHashTables, WriteDataTable, FactArgInfos0, FactArgInfos)
- -->
+infer_determinism_pass_1(PredInfo0, PredInfo, ModuleInfo, CheckProcs,
+ ExistsAllInMode, WriteHashTables, WriteDataTable,
+ FactArgInfos0, FactArgInfos) -->
{ pred_info_procedures(PredInfo0, ProcTable0) },
{ pred_info_procids(PredInfo0, ProcIDs) },
- infer_proc_determinism_pass_1(ProcIDs, ProcTable0, ProcTable,
- [], CheckProcs0, MaybeAllInProc, WriteHashTables,
+ infer_proc_determinism_pass_1(ProcIDs, ProcTable0, ProcTable,
+ ModuleInfo, [], CheckProcs0, MaybeAllInProc, WriteHashTables,
WriteDataTable, FactArgInfos0, FactArgInfos),
% If there is an all_in procedure, it needs to be put on the
@@ -728,21 +804,23 @@
{ pred_info_set_procedures(PredInfo0, ProcTable, PredInfo) }.
:- pred infer_proc_determinism_pass_1(list(proc_id), proc_table, proc_table,
- list(proc_id), list(proc_id), maybe(proc_id), bool, bool,
- list(fact_arg_info), list(fact_arg_info), io__state, io__state).
-:- mode infer_proc_determinism_pass_1(in, in, out, in, out, out, out, out, in,
- out, di, uo) is det.
+ module_info, list(proc_id), list(proc_id), maybe(proc_id),
+ bool, bool, list(fact_arg_info), list(fact_arg_info),
+ io__state, io__state).
+:- mode infer_proc_determinism_pass_1(in, in, out, in, in, out, out, out, out,
+ in, out, di, uo) is det.
-infer_proc_determinism_pass_1([], ProcTable, ProcTable, CheckProcs, CheckProcs,
- no, no, no, FactArgInfos, FactArgInfos) --> [].
+infer_proc_determinism_pass_1([], ProcTable, ProcTable, _, CheckProcs,
+ CheckProcs, no, no, no, FactArgInfos, FactArgInfos) --> [].
infer_proc_determinism_pass_1([ProcID | ProcIDs], ProcTable0, ProcTable,
- CheckProcs0, CheckProcs, MaybeAllInProc,
+ ModuleInfo, CheckProcs0, CheckProcs, MaybeAllInProc,
WriteHashTables, WriteDataTable, FactArgInfos0,
FactArgInfos) -->
{ map__lookup(ProcTable0, ProcID, ProcInfo0) },
{ proc_info_argmodes(ProcInfo0, ArgModes) },
- { fill_in_fact_arg_infos(ArgModes, FactArgInfos0, FactArgInfos1) },
- { fact_table_mode_type(ArgModes, ModeType) },
+ { fill_in_fact_arg_infos(ArgModes, ModuleInfo, FactArgInfos0,
+ FactArgInfos1) },
+ { fact_table_mode_type(ArgModes, ModuleInfo, ModeType) },
(
{ ModeType = all_in },
{ InferredDetism = inferred(semidet) },
@@ -784,7 +862,8 @@
{ InferredDetism = error },
{ proc_info_context(ProcInfo0, Context) },
prog_out__write_context(Context),
- io__write_string("Error: only in and out modes are currently "),
+ io__write_string(
+ "Error: only `in' and `out' modes are currently "),
io__write_string("supported in fact tables.\n"),
io__set_exit_status(1),
{ CheckProcs1 = CheckProcs0 },
@@ -813,8 +892,8 @@
ProcTable1 = ProcTable0
},
infer_proc_determinism_pass_1(ProcIDs, ProcTable1, ProcTable,
- CheckProcs1, CheckProcs, MaybeAllInProc1, WriteHashTables1,
- WriteDataTable1, FactArgInfos1, FactArgInfos),
+ ModuleInfo, CheckProcs1, CheckProcs, MaybeAllInProc1,
+ WriteHashTables1, WriteDataTable1, FactArgInfos1, FactArgInfos),
{
MaybeAllInProc0 = yes(_),
MaybeAllInProc = MaybeAllInProc0
@@ -822,75 +901,31 @@
MaybeAllInProc0 = no,
MaybeAllInProc = MaybeAllInProc1
},
- {
- WriteHashTables0 = yes
- ->
- WriteHashTables = yes
- ;
- WriteHashTables = WriteHashTables1
- },
- {
- WriteDataTable0 = yes
- ->
- WriteDataTable = yes
- ;
- WriteDataTable = WriteDataTable1
- }.
+ { bool__or(WriteHashTables0, WriteHashTables1, WriteHashTables) },
+ { bool__or(WriteDataTable0, WriteDataTable1, WriteDataTable) }.
-% Return the fact_table_mode_type for a procedure. At the moment the only
-% recognised modes are mercury_builtin:in and mercury_builtin:out.
-:- pred fact_table_mode_type(list(mode), fact_table_mode_type).
-:- mode fact_table_mode_type(in, out) is det.
-
-fact_table_mode_type([], unknown).
-fact_table_mode_type([Mode | Modes], ModeType) :-
- (
- Mode = ((_) -> (_)),
- ModeType0 = other
+% Return the fact_table_mode_type for a procedure.
+:- pred fact_table_mode_type(list(mode), module_info, fact_table_mode_type).
+:- mode fact_table_mode_type(in, in, out) is det.
+
+fact_table_mode_type([], _, unknown).
+fact_table_mode_type([Mode | Modes], ModuleInfo, ModeType) :-
+ ( mode_is_input(ModuleInfo, Mode) ->
+ ModeType0 = all_in
+ ; mode_is_output(ModuleInfo, Mode) ->
+ ModeType0 = all_out
;
- Mode = user_defined_mode(SymName, Insts),
- (
- SymName = unqualified(_Name),
- ModeType0 = other
- ;
- SymName = qualified(ModSpec, Name),
- (
- Insts = [],
- ModSpec = "mercury_builtin"
- ->
- (
- Name = "in"
- ->
- ModeType0 = all_in
- ;
- Name = "out"
- ->
- ModeType0 = all_out
- ;
- ModeType0 = other
- )
- ;
- ModeType0 = other
- )
- )
- ),
- (
ModeType0 = other
- ->
+ ),
+ ( ModeType0 = other ->
ModeType = other
;
- fact_table_mode_type(Modes, ModeType1),
- (
- ModeType1 = unknown
- ->
+ fact_table_mode_type(Modes, ModuleInfo, ModeType1),
+ ( ModeType1 = unknown ->
ModeType = ModeType0
- ;
- ModeType1 = other
- ->
+ ; ModeType1 = other ->
ModeType = other
- ;
- ModeType1 = ModeType0
- ->
+ ; ModeType1 = ModeType0 ->
ModeType = ModeType0
;
ModeType = in_out
@@ -899,22 +934,20 @@
%------------------------------------------------------------------------------%
- % open_sort_files(ProcIDs, BaseName, ProcStreams)
+ % 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.
- % File names are derived from BaseName.tmp.ProcID.
-:- pred open_sort_files(list(proc_id), string, list(proc_stream),
+:- pred open_sort_files(list(proc_id), list(proc_stream),
io__state, io__state).
-:- mode open_sort_files(in, in, out, di, uo) is det.
+:- mode open_sort_files(in, out, di, uo) is det.
-open_sort_files([], _, []) --> [].
-open_sort_files([ProcID | ProcIDs], BaseName, ProcStreams) -->
- { string__format("/tmp/%s.tmp.%d", [s(BaseName), i(ProcID)],
- SortFileName) },
+open_sort_files([], []) --> [].
+open_sort_files([ProcID | ProcIDs], ProcStreams) -->
+ io__tmpnam(SortFileName),
io__open_output(SortFileName, Result),
(
{ Result = ok(Stream) },
- open_sort_files(ProcIDs, BaseName, ProcStreams0),
+ open_sort_files(ProcIDs, ProcStreams0),
{ ProcStreams = [proc_stream(ProcID, Stream) | ProcStreams0] }
;
{ Result = error(ErrorCode) },
@@ -938,16 +971,17 @@
% read_sort_file_line so if any changes are made here, corresponding
% changes should be made there too.
:- pred write_sort_file_lines(list(proc_stream), proc_table, list(term),
- string, list(fact_arg_info), bool, io__state, io__state).
-:- mode write_sort_file_lines(in, in, in, in, in, in, di, uo) is det.
+ module_info, string, list(fact_arg_info), bool,
+ io__state, io__state).
+:- mode write_sort_file_lines(in, in, in, in, in, in, in, di, uo) is det.
-write_sort_file_lines([], _, _, _, _, _) --> [].
+write_sort_file_lines([], _, _, _, _, _, _) --> [].
write_sort_file_lines([proc_stream(ProcID, Stream) | ProcStreams], ProcTable,
- Terms, FactNumStr, FactArgInfos, IsPrimary) -->
+ Terms, ModuleInfo, FactNumStr, FactArgInfos, IsPrimary) -->
{ map__lookup(ProcTable, ProcID, ProcInfo) },
{ proc_info_argmodes(ProcInfo, ArgModes) },
{ assoc_list__from_corresponding_lists(ArgModes, Terms, ModeTerms) },
- { make_sort_file_key(ModeTerms, Key) },
+ { make_sort_file_key(ModeTerms, ModuleInfo, Key) },
{
IsPrimary = yes,
assoc_list__from_corresponding_lists(FactArgInfos, Terms,
@@ -958,7 +992,8 @@
DataString = ""
},
io__write_strings(Stream, [Key, "~", FactNumStr, "~", DataString,"\n"]),
- write_sort_file_lines(ProcStreams, ProcTable, Terms, FactNumStr, [],no).
+ write_sort_file_lines(ProcStreams, ProcTable, Terms, ModuleInfo,
+ FactNumStr, [],no).
%------------------------------------------------------------------------------%
@@ -971,22 +1006,21 @@
% 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(assoc_list(mode, term), string).
-:- mode make_sort_file_key(in, out) is det.
+:- pred make_sort_file_key(assoc_list(mode, term), module_info, string).
+:- mode make_sort_file_key(in, in, out) is det.
-make_sort_file_key([], "").
-make_sort_file_key([(Mode - Term) | ModeTerms], Key) :-
+make_sort_file_key([], _, "").
+make_sort_file_key([(Mode - Term) | ModeTerms], ModuleInfo, Key) :-
(
- Mode = user_defined_mode(SymName, []),
- SymName = qualified("mercury_builtin", "in"),
+ mode_is_input(ModuleInfo, Mode),
Term = term__functor(Const, [], _Context)
->
make_key_part(Const, KeyPart),
- make_sort_file_key(ModeTerms, Key0),
+ make_sort_file_key(ModeTerms, ModuleInfo, Key0),
string__append(":", Key0, Key1), % field separator
string__append(KeyPart, Key1, Key)
;
- make_sort_file_key(ModeTerms, Key)
+ make_sort_file_key(ModeTerms, ModuleInfo, Key)
).
% like make_sort_file_key but for the output arguments of the fact
@@ -1013,6 +1047,7 @@
make_key_part(term__atom(_), _):-
error("make_key_part: enumerated types are not supported yet.").
make_key_part(term__integer(I), K) :-
+ % convert int to base 36 to reduce the size of the I/O.
string__int_to_base_string(I, 36, K).
make_key_part(term__float(F), K) :-
string__float_to_string(F, K).
@@ -1076,7 +1111,7 @@
io__output_stream_name(Stream, FileName),
io__close_output(Stream),
{ string__format(
- "sort -o %s %s; cut -d'~' -f1 %s | sort -cu >/dev/null 2>&1",
+ "sort -o %s %s && cut -d'~' -f1 %s | sort -cu >/dev/null 2>&1",
[s(FileName), s(FileName), s(FileName)], Command) },
globals__io_lookup_bool_option(verbose, Verbose),
maybe_write_string(Verbose, "% Invoking system command `"),
@@ -1144,14 +1179,14 @@
% write out the fact table data arrays and hash tables
:- pred write_fact_table_arrays(assoc_list(proc_id, string), string, string,
- proc_table, int, list(fact_arg_info), bool, bool,
+ proc_table, module_info, int, list(fact_arg_info), bool, bool,
io__output_stream, string, proc_id, io__state, io__state).
-:- mode write_fact_table_arrays(in, in, in, in, in, in, in, in, in, out,
+:- mode write_fact_table_arrays(in, in, in, in, in, in, in, in, in, in, out,
out, di, uo) is det.
write_fact_table_arrays(ProcFiles0, DataFileName, StructName, ProcTable,
- NumFacts, FactArgInfos, WriteHashTables, WriteDataTable,
- OutputStream, C_HeaderCode, PrimaryProcID) -->
+ ModuleInfo, NumFacts, FactArgInfos, WriteHashTables,
+ WriteDataTable, OutputStream, C_HeaderCode, PrimaryProcID) -->
(
% no sort files => there was only and all_out mode
% => nothing left to be done here
@@ -1173,14 +1208,14 @@
CreateFactMap = no
},
write_primary_hash_table(PrimaryProcID, FileName, DataFileName,
- StructName, ProcTable, OutputStream, FactArgInfos,
- WriteDataTable, NumFacts, CreateFactMap, Result0,
- FactMap, C_HeaderCode0),
+ StructName, ProcTable, ModuleInfo, OutputStream,
+ FactArgInfos, WriteDataTable, NumFacts, CreateFactMap,
+ Result0, FactMap, C_HeaderCode0),
(
{ Result0 = ok },
write_secondary_hash_tables(ProcFiles1, StructName,
- ProcTable, OutputStream, FactMap, FactArgInfos,
- "", C_HeaderCode1),
+ ProcTable, ModuleInfo, OutputStream, FactMap,
+ FactArgInfos, "", C_HeaderCode1),
{ string__append(C_HeaderCode0, C_HeaderCode1,
C_HeaderCode) }
;
@@ -1205,28 +1240,30 @@
write_fact_table_data(NextFactNum, ArgsList, StructName, OutputStream).
+ % 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(int, list(fact_arg), string, io__output_stream,
io__state, io__state).
:- mode write_fact_data(in, in, in, in, di, uo) is det.
write_fact_data(FactNum, Args, StructName, OutputStream) -->
- { fact_table_size(FactTableSize) },
+ fact_table_size(FactTableSize),
( { 0 is FactNum mod FactTableSize } ->
( { FactNum = 0 } ->
[]
;
- io__write_string(OutputStream, "};\n\n")
+ write_closing_brace(OutputStream),
+ write_new_data_array(OutputStream,
+ StructName, FactNum)
),
- globals__io_lookup_bool_option(verbose, Verbose),
+ globals__io_lookup_bool_option(very_verbose, Verbose),
( { Verbose = yes } ->
- io__format("% Writing fact %d\n", [i(FactNum)])
+ io__format("%% Writing fact %d\n", [i(FactNum)])
;
[]
- ),
- { string__format("struct %s_struct %s%d[] = {\n",
- [s(StructName), s(StructName), i(FactNum)],
- TmpString) },
- io__write_string(OutputStream, TmpString)
+ )
;
[]
),
@@ -1234,6 +1271,23 @@
write_fact_args(Args, OutputStream),
io__write_string(OutputStream, " },\n").
+ % Write out the closing brace of an array.
+:- pred write_closing_brace(io__output_stream, io__state, io__state).
+:- mode write_closing_brace(in, di, uo) is det.
+
+write_closing_brace(OutputStream) -->
+ io__write_string(OutputStream, "};\n\n").
+
+ % Write out the declaration of a new data array followed by " = {\n"
+:- pred write_new_data_array(io__output_stream, string, int,
+ io__state, io__state).
+:- mode write_new_data_array(in, in, in, di, uo) is det.
+
+write_new_data_array(OutputStream, StructName, FactNum) -->
+ io__format(OutputStream, "struct %s_struct %s%d[] = {\n",
+ [s(StructName), s(StructName), i(FactNum)]).
+
+
:- pred write_fact_args(list(fact_arg), io__output_stream,
io__state, io__state).
:- mode write_fact_args(in, in, di, uo) is det.
@@ -1244,7 +1298,7 @@
{ Arg = term__string(String) },
io__set_output_stream(OutputStream, OldStream),
io__write_string(""""),
- term_io__quote_string(String),
+ output_c_quoted_string(String),
io__write_string(""", "),
io__set_output_stream(OldStream, _)
;
@@ -1262,7 +1316,7 @@
write_fact_args(Args, OutputStream).
% If a data table has been created in a separate file, append it to the
- % end of the main output file.
+ % end of the main output file and then delete it.
:- pred maybe_append_data_table(bool, string, string, io__state, io__state).
:- mode maybe_append_data_table(in, in, in, di, uo) is det.
@@ -1294,7 +1348,8 @@
ErrorMessage,
".\n" ]),
io__set_exit_status(1)
- ).
+ ),
+ delete_temporary_file(DataFileName).
% Write hash tables for the primary key.
% Create a map from indices in the original input table to the table
@@ -1301,14 +1356,15 @@
% sorted on the primary key.
% Write out the data table if required.
:- pred write_primary_hash_table(proc_id, string, string, string, proc_table,
- io__output_stream, list(fact_arg_info), bool, int, bool,
- fact_result, map(int, int), string, io__state, io__state).
-:- mode write_primary_hash_table(in, in, in, in, in, in, in, in, in, in, out,
- out, out, di, uo) is det.
+ module_info, io__output_stream, list(fact_arg_info), bool,
+ int, bool, fact_result, map(int, int), string,
+ io__state, io__state).
+:- mode write_primary_hash_table(in, in, in, in, in, in, in, in, in, in, in,
+ out, out, out, di, uo) is det.
write_primary_hash_table(ProcID, FileName, DataFileName, StructName, ProcTable,
- OutputStream, FactArgInfos, WriteDataTable, NumFacts,
- CreateFactMap, Result, FactMap, C_HeaderCode) -->
+ ModuleInfo, OutputStream, FactArgInfos, WriteDataTable,
+ NumFacts, CreateFactMap, Result, FactMap, C_HeaderCode) -->
{ map__init(FactMap0) },
io__see(FileName, Result0),
(
@@ -1319,6 +1375,8 @@
(
{ Result1 = ok(DataStream) },
{ MaybeDataStream = yes(DataStream) },
+ % opening brace for first fact data array
+ write_new_data_array(DataStream, StructName, 0),
{ Result2 = ok }
;
{ Result1 = error(ErrorCode1) },
@@ -1346,15 +1404,15 @@
C_HeaderCode0) },
{ map__lookup(ProcTable, ProcID, ProcInfo) },
{ proc_info_argmodes(ProcInfo, ArgModes) },
- read_sort_file_line(FactArgInfos, ArgModes,
+ read_sort_file_line(FactArgInfos, ArgModes, ModuleInfo,
MaybeFirstFact),
(
{ MaybeFirstFact = yes(FirstFact) },
build_hash_table(0, 0, HashTableName,
- StructName, 0, ArgModes, FactArgInfos,
- yes, OutputStream, FirstFact,
- MaybeDataStream, CreateFactMap,
- FactMap0, FactMap),
+ StructName, 0, ArgModes, ModuleInfo,
+ FactArgInfos, yes, OutputStream,
+ FirstFact, MaybeDataStream,
+ CreateFactMap, FactMap0, FactMap),
{ Result = ok }
;
{ MaybeFirstFact = no },
@@ -1369,9 +1427,8 @@
),
(
{ MaybeDataStream = yes(DataStream1) },
-
- % closing brace for fact data table
- io__write_string(DataStream1, "};\n\n"),
+ % closing brace for last fact data array
+ write_closing_brace(DataStream1),
write_fact_table_pointer_array(NumFacts, StructName,
DataStream1, C_HeaderCode1),
io__close_output(DataStream1),
@@ -1381,7 +1438,8 @@
{ MaybeDataStream = no },
{ C_HeaderCode = C_HeaderCode0 }
),
- io__seen
+ io__seen,
+ delete_temporary_file(FileName)
;
{ Result0 = error(ErrorCode0) },
{ io__error_message(ErrorCode0, ErrorMessage0) },
@@ -1399,15 +1457,15 @@
% Build hash tables for non-primary input procs.
:- pred write_secondary_hash_tables(assoc_list(proc_id, string), string,
- proc_table, io__output_stream, map(int, int),
+ proc_table, module_info, io__output_stream, map(int, int),
list(fact_arg_info), string, string, io__state, io__state).
-:- mode write_secondary_hash_tables(in, in, in, in, in, in, in, out, di, uo)
+:- mode write_secondary_hash_tables(in, in, in, in, in, in, in, in, out, di, uo)
is det.
-write_secondary_hash_tables([], _, _, _, _, _, C_HeaderCode, C_HeaderCode)
+write_secondary_hash_tables([], _, _, _, _, _, _, C_HeaderCode, C_HeaderCode)
--> [].
write_secondary_hash_tables([ProcID - FileName | ProcFiles], StructName,
- ProcTable, OutputStream, FactMap, FactArgInfos,
+ ProcTable, ModuleInfo, OutputStream, FactMap, FactArgInfos,
C_HeaderCode0, C_HeaderCode) -->
io__see(FileName, Result0),
(
@@ -1420,16 +1478,18 @@
C_HeaderCode2) },
{ map__lookup(ProcTable, ProcID, ProcInfo) },
{ proc_info_argmodes(ProcInfo, ArgModes) },
- read_sort_file_line(FactArgInfos, ArgModes, MaybeFirstFact),
+ read_sort_file_line(FactArgInfos, ArgModes, ModuleInfo,
+ MaybeFirstFact),
(
{ MaybeFirstFact = yes(FirstFact) },
build_hash_table(0, 0, HashTableName, StructName, 0,
- ArgModes, FactArgInfos, no, OutputStream,
- FirstFact, no, no, FactMap, _),
+ ArgModes, ModuleInfo, FactArgInfos, no,
+ OutputStream, FirstFact, no, no, FactMap, _),
io__seen,
+ delete_temporary_file(FileName),
write_secondary_hash_tables(ProcFiles, StructName,
- ProcTable, OutputStream, FactMap, FactArgInfos,
- C_HeaderCode2, C_HeaderCode)
+ ProcTable, ModuleInfo, OutputStream, FactMap,
+ FactArgInfos, C_HeaderCode2, C_HeaderCode)
;
{ MaybeFirstFact = no },
io__seen,
@@ -1448,17 +1508,17 @@
{ C_HeaderCode = C_HeaderCode0 }
).
-:- pred read_sort_file_line(list(fact_arg_info), list(mode),
+:- pred read_sort_file_line(list(fact_arg_info), list(mode), module_info,
maybe(sort_file_line), io__state, io__state).
-:- mode read_sort_file_line(in, in, out, di, uo) is det.
+:- mode read_sort_file_line(in, in, in, out, di, uo) is det.
-read_sort_file_line(FactArgInfos, ArgModes, MaybeSortFileLine) -->
+read_sort_file_line(FactArgInfos, ArgModes, ModuleInfo, MaybeSortFileLine) -->
io__read_line(Result),
(
{ Result = ok(LineChars) },
{ string__from_char_list(LineChars, LineString) },
- { split_sort_file_line(FactArgInfos, ArgModes, LineString,
- SortFileLine) },
+ { split_sort_file_line(FactArgInfos, ArgModes, ModuleInfo,
+ LineString, SortFileLine) },
{ MaybeSortFileLine = yes(SortFileLine) }
;
{ Result = eof },
@@ -1480,42 +1540,43 @@
% Build and write out a top level hash table and all the lower level
% tables connected to it.
-:- pred build_hash_table(int, int, string, string, int, list(mode),
+:- pred build_hash_table(int, int, string, string, int, list(mode), module_info,
list(fact_arg_info), bool, io__output_stream, sort_file_line,
maybe(io__output_stream), bool, map(int, int), map(int, int),
io__state, io__state).
-:- mode build_hash_table(in, in, in, in, in, in, in, in, in, in, in, in, in,
+:- mode build_hash_table(in, in, in, in, in, in, in, in, in, in, in, in, in, in,
out, di, uo) is det.
build_hash_table(FactNum, InputArgNum, HashTableName, StructName, TableNum,
- ArgModes, Infos, IsPrimaryTable, OutputStream, FirstFact,
- MaybeDataStream, CreateFactMap, FactMap0, FactMap) -->
+ ArgModes, ModuleInfo, Infos, IsPrimaryTable, OutputStream,
+ FirstFact, MaybeDataStream, CreateFactMap, FactMap0, FactMap)
+ -->
build_hash_table_2(FactNum, InputArgNum, HashTableName, StructName,
- TableNum, ArgModes, Infos, IsPrimaryTable, OutputStream,
- yes(FirstFact), MaybeDataStream, CreateFactMap, FactMap0,
- FactMap, [], HashList),
+ TableNum, ArgModes, ModuleInfo, Infos, IsPrimaryTable,
+ OutputStream, yes(FirstFact), MaybeDataStream, CreateFactMap,
+ FactMap0, FactMap, [], HashList),
{ list__length(HashList, Len) },
- { calculate_hash_table_size(Len, HashSize) },
+ calculate_hash_table_size(Len, HashSize),
{ hash_table_init(HashSize, HashTable0) },
{ hash_table_from_list(HashList, HashSize, HashTable0, HashTable) },
write_hash_table(HashTableName, TableNum, HashTable, OutputStream).
-:- pred build_hash_table_2(int, int, string, string, int, list(mode),
- list(fact_arg_info), bool, io__output_stream,
+:- pred build_hash_table_2(int, int, string, string, int, list(mode),
+ module_info, list(fact_arg_info), bool, io__output_stream,
maybe(sort_file_line), maybe(io__output_stream), bool,
map(int, int), map(int, int), list(hash_entry),
list(hash_entry), io__state, io__state).
:- mode build_hash_table_2(in, in, in, in, in, in, in, in, in, in, in, in, in,
- out, in, out, di, uo) is det.
+ in, out, in, out, di, uo) is det.
-build_hash_table_2(_, _, _, _, _, _, _, _, _, no, _, _, FactMap, FactMap,
+build_hash_table_2(_, _, _, _, _, _, _, _, _, _, no, _, _, FactMap, FactMap,
HashList, HashList) --> [].
build_hash_table_2(FactNum, InputArgNum, HashTableName, StructName, TableNum0,
- ArgModes, Infos, IsPrimaryTable, OutputStream, yes(FirstFact),
- MaybeDataStream, CreateFactMap, FactMap0, FactMap, HashList0,
- HashList) -->
+ ArgModes, ModuleInfo, Infos, IsPrimaryTable, OutputStream,
+ yes(FirstFact), MaybeDataStream, CreateFactMap,
+ FactMap0, FactMap, HashList0, HashList) -->
top_level_collect_matching_facts(FirstFact, MatchingFacts,
- MaybeNextFact, Infos, ArgModes),
+ MaybeNextFact, Infos, ArgModes, ModuleInfo),
{
CreateFactMap = yes,
update_fact_map(FactNum, MatchingFacts, FactMap0, FactMap1)
@@ -1534,33 +1595,32 @@
{ MaybeDataStream = no }
),
do_build_hash_table(FactNum, InputArgNum, HashTableName,
- TableNum0, TableNum1, ArgModes, IsPrimaryTable,
- OutputStream, MatchingFacts, FactMap1, HashList0,
- HashList1),
+ TableNum0, TableNum1, IsPrimaryTable, OutputStream,
+ MatchingFacts, FactMap1, HashList0, HashList1),
{ list__length(MatchingFacts, Len) },
{ NextFactNum is FactNum + Len },
build_hash_table_2(NextFactNum, InputArgNum, HashTableName, StructName,
- TableNum1, ArgModes, Infos, IsPrimaryTable, OutputStream,
- MaybeNextFact, MaybeDataStream, CreateFactMap, FactMap1,
- FactMap, HashList1, HashList).
+ TableNum1, ArgModes, ModuleInfo, Infos, IsPrimaryTable,
+ OutputStream, MaybeNextFact, MaybeDataStream, CreateFactMap,
+ FactMap1, FactMap, HashList1, HashList).
% 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(int, int, string, int, int,
- list(mode), bool, io__output_stream, list(sort_file_line),
+ bool, io__output_stream, list(sort_file_line),
map(int, int), io__state, io__state).
-:- mode build_hash_table_lower_levels(in, in, in, in, out, in, in, in, in,
+:- mode build_hash_table_lower_levels(in, in, in, in, out, in, in, in,
in, di, uo) is det.
build_hash_table_lower_levels(FactNum, InputArgNum, HashTableName,
- TableNum0, TableNum, ArgModes, IsPrimaryTable, OutputStream,
+ TableNum0, TableNum, IsPrimaryTable, OutputStream,
Facts, FactMap) -->
build_hash_table_lower_levels_2(FactNum, InputArgNum,
- HashTableName, TableNum0, TableNum, ArgModes, IsPrimaryTable,
+ HashTableName, TableNum0, TableNum, IsPrimaryTable,
OutputStream, Facts, FactMap, [], HashList),
{ list__length(HashList, Len) },
- { calculate_hash_table_size(Len, HashSize) },
+ calculate_hash_table_size(Len, HashSize),
{ hash_table_init(HashSize, HashTable0) },
{ hash_table_from_list(HashList, HashSize, HashTable0, HashTable) },
write_hash_table(HashTableName, TableNum0, HashTable, OutputStream).
@@ -1567,40 +1627,40 @@
:- pred build_hash_table_lower_levels_2(int, int, string, int, int,
- list(mode), bool, io__output_stream, list(sort_file_line),
+ bool, io__output_stream, list(sort_file_line),
map(int, int), list(hash_entry), list(hash_entry),
io__state, io__state).
-:- mode build_hash_table_lower_levels_2(in, in, in, in, out, in, in, in, in,
+:- mode build_hash_table_lower_levels_2(in, in, in, in, out, in, in, in,
in, in, out, di, uo) is det.
-build_hash_table_lower_levels_2(_, _, _, TableNum, TableNum, _, _, _, [],
+build_hash_table_lower_levels_2(_, _, _, TableNum, TableNum, _, _, [],
_, HashList, HashList) --> [].
build_hash_table_lower_levels_2(FactNum, InputArgNum, HashTableName,
- TableNum0, TableNum, ArgModes, IsPrimaryTable, OutputStream,
+ TableNum0, TableNum, IsPrimaryTable, OutputStream,
[Fact | Facts0], FactMap, HashList0, HashList) -->
{ lower_level_collect_matching_facts(Fact, Facts0, MatchingFacts,
Facts1, InputArgNum) },
do_build_hash_table(FactNum, InputArgNum, HashTableName,
- TableNum0, TableNum1, ArgModes, IsPrimaryTable, OutputStream,
+ TableNum0, TableNum1, IsPrimaryTable, OutputStream,
MatchingFacts, FactMap, HashList0, HashList1),
{ list__length(MatchingFacts, Len) },
{ NextFactNum is FactNum + Len },
build_hash_table_lower_levels_2(NextFactNum, InputArgNum,
- HashTableName, TableNum1, TableNum, ArgModes, IsPrimaryTable,
+ HashTableName, TableNum1, TableNum, IsPrimaryTable,
OutputStream, Facts1, FactMap, HashList1, HashList).
% This is where most of the actual work is done in building up the
% hash table.
-:- pred do_build_hash_table(int, int, string, int, int, list(mode),
- bool, io__output_stream, list(sort_file_line), map(int, int),
+:- pred do_build_hash_table(int, int, string, int, int, bool,
+ io__output_stream, list(sort_file_line), map(int, int),
list(hash_entry), list(hash_entry), io__state, io__state).
-:- mode do_build_hash_table(in, in, in, in, out, in, in, in, in, in, in,
+:- mode do_build_hash_table(in, in, in, in, out, in, in, in, in, in,
out, di, uo) is det.
do_build_hash_table(FactNum, InputArgNum, HashTableName, TableNum0,
- TableNum, ArgModes, IsPrimaryTable, OutputStream, Facts,
- FactMap, HashList0, HashList) -->
+ TableNum, IsPrimaryTable, OutputStream, Facts, FactMap,
+ HashList0, HashList) -->
(
{ Facts = [] },
{ error("do_build_hash_table: no facts") }
@@ -1626,11 +1686,12 @@
% see if there are any more input arguments
{ NextInputArgNum is InputArgNum + 1 },
{ Fact = sort_file_line(InputArgs, _, _) },
- { list__drop(NextInputArgNum, InputArgs, [_|_]) }
+ { N is NextInputArgNum + 1 },
+ { list__drop(N, InputArgs, _) }
->
{ TableNum1 is TableNum0 + 1 },
build_hash_table_lower_levels(FactNum, NextInputArgNum,
- HashTableName, TableNum1, TableNum, ArgModes,
+ HashTableName, TableNum1, TableNum,
IsPrimaryTable, OutputStream, Facts, FactMap),
{ HashList = [hash_entry(Arg,
hash_table(TableNum1, HashTableName), -1) |
@@ -1659,14 +1720,14 @@
% read in following the matching facts, it is placed in MaybeNextFact.
:- pred top_level_collect_matching_facts(sort_file_line, list(sort_file_line),
maybe(sort_file_line), list(fact_arg_info), list(mode),
- io__state, io__state).
-:- mode top_level_collect_matching_facts(in, out, out, in, in, di, uo)
+ module_info, io__state, io__state).
+:- mode top_level_collect_matching_facts(in, out, out, in, in, in, di, uo)
is det.
top_level_collect_matching_facts(Fact, MatchingFacts, MaybeNextFact, Infos,
- ArgModes) -->
+ ArgModes, ModuleInfo) -->
top_level_collect_matching_facts_2(Fact, [], MatchingFacts0,
- MaybeNextFact, Infos, ArgModes),
+ MaybeNextFact, Infos, ArgModes, ModuleInfo),
{ list__reverse(MatchingFacts0, MatchingFacts1) },
{ MatchingFacts = [Fact | MatchingFacts1] }.
@@ -1673,13 +1734,14 @@
:- pred top_level_collect_matching_facts_2(sort_file_line, list(sort_file_line),
list(sort_file_line), maybe(sort_file_line),
- list(fact_arg_info), list(mode), io__state, io__state).
-:- mode top_level_collect_matching_facts_2(in, in, out, out, in, in, di, uo)
- is det.
+ list(fact_arg_info), list(mode), module_info,
+ io__state, io__state).
+:- mode top_level_collect_matching_facts_2(in, in, out, out, in, in, in,
+ di, uo) is det.
top_level_collect_matching_facts_2(Fact, MatchingFacts0, MatchingFacts,
- MaybeNextFact, Infos, ArgModes) -->
- read_sort_file_line(Infos, ArgModes, MaybeSortFileLine),
+ MaybeNextFact, Infos, ArgModes, ModuleInfo) -->
+ read_sort_file_line(Infos, ArgModes, ModuleInfo, MaybeSortFileLine),
(
{ MaybeSortFileLine = yes(Fact1) },
(
@@ -1690,7 +1752,7 @@
top_level_collect_matching_facts_2(Fact,
[Fact1 | MatchingFacts0],
MatchingFacts, MaybeNextFact, Infos,
- ArgModes)
+ ArgModes, ModuleInfo)
;
{ MatchingFacts = MatchingFacts0 },
{ MaybeNextFact = yes(Fact1) }
@@ -1746,24 +1808,6 @@
"lower_level_collect_matching_facts: not enough input args")
).
- % Get the number of the next input argument for this procedure that is
- % greater than OldArgNum.
- % Fail if there are no more input arguments.
-:- pred get_next_input_arg(int, list(mode), int).
-:- mode get_next_input_arg(in, in, out) is semidet.
-
-get_next_input_arg(OldArgNum, ArgModes, NewArgNum) :-
- ThisArgNum is OldArgNum + 1,
- list__drop(ThisArgNum, ArgModes, [Mode | ArgModes1]),
- (
- Mode = user_defined_mode(qualified("mercury_builtin", "in"), [])
- ->
- NewArgNum = ThisArgNum
- ;
- get_next_input_arg(-1, ArgModes1, NewArgNum1),
- NewArgNum is NewArgNum1 + ThisArgNum
- ).
-
:- pred update_fact_map(int, list(sort_file_line), map(int, int),
map(int, int)).
:- mode update_fact_map(in, in, in, out) is det.
@@ -1778,11 +1822,12 @@
%------------------------------------------------------------------------------%
% Break up a string into the components of a sort file line
-:- pred split_sort_file_line(list(fact_arg_info), list(mode), string,
- sort_file_line) is det.
-:- mode split_sort_file_line(in, in, in, out) is det.
+:- pred split_sort_file_line(list(fact_arg_info), list(mode), module_info,
+ string, sort_file_line) is det.
+:- mode split_sort_file_line(in, in, in, in, out) is det.
-split_sort_file_line(FactArgInfos, ArgModes, Line0, SortFileLine) :-
+split_sort_file_line(FactArgInfos, ArgModes, ModuleInfo, Line0, SortFileLine)
+ :-
(
string__sub_string_search(Line0, "~", Pos0),
string__split(Line0, Pos0, InputArgsString, Line1),
@@ -1794,8 +1839,8 @@
string__to_int(IndexString, Index0)
->
split_key_to_arg_strings(InputArgsString, InputArgStrings),
- get_input_args_list(FactArgInfos, ArgModes, InputArgStrings,
- InputArgs),
+ get_input_args_list(FactArgInfos, ArgModes, ModuleInfo,
+ InputArgStrings, InputArgs),
split_key_to_arg_strings(OutputArgsString, OutputArgStrings),
(
% Only extract the output arguments if they have
@@ -1835,24 +1880,24 @@
)
).
-:- pred get_input_args_list(list(fact_arg_info), list(mode), list(string),
- list(fact_arg)).
-:- mode get_input_args_list(in, in, in, out) is det.
+:- pred get_input_args_list(list(fact_arg_info), list(mode), module_info,
+ list(string), list(fact_arg)).
+:- mode get_input_args_list(in, in, in, in, out) is det.
-get_input_args_list([], [], _, []).
-get_input_args_list([_|_], [], _, _) :-
+get_input_args_list([], [], _, _, []).
+get_input_args_list([_|_], [], _, _, _) :-
error("get_input_args_list: too many fact_arg_infos").
-get_input_args_list([], [_|_], _, _) :-
+get_input_args_list([], [_|_], _, _, _) :-
error("get_input_args_list: too many argmodes").
-get_input_args_list([Info | Infos], [Mode | Modes], ArgStrings0, Args) :-
- (
- Mode = user_defined_mode(qualified("mercury_builtin", "in"), [])
- ->
+get_input_args_list([Info | Infos], [Mode | Modes], ModuleInfo, ArgStrings0,
+ Args) :-
+ ( mode_is_input(ModuleInfo, Mode) ->
(
ArgStrings0 = [ArgString | ArgStrings],
Info = fact_arg_info(Type, _, _),
convert_key_string_to_arg(ArgString, Type, Arg),
- get_input_args_list(Infos, Modes, ArgStrings, Args0),
+ get_input_args_list(Infos, Modes, ModuleInfo,
+ ArgStrings, Args0),
Args = [Arg | Args0]
;
ArgStrings0 = [],
@@ -1860,7 +1905,7 @@
)
;
% This argument is not input so skip it and try the next one.
- get_input_args_list(Infos, Modes, ArgStrings0, Args)
+ get_input_args_list(Infos, Modes, ModuleInfo, ArgStrings0, Args)
).
:- pred get_output_args_list(list(fact_arg_info), list(string), list(fact_arg)).
@@ -1894,18 +1939,20 @@
(
Type = term__functor(term__atom("int"), [], _)
->
- string__to_char_list(ArgString, Chars0),
- ( Chars0 = ['-' | Chars1] ->
- chars_base_36_to_int(Chars1, 0, I0),
- I is -I0
+ (
+ string__base_string_to_int(36, ArgString, I)
+ ->
+ Arg = term__integer(I)
;
- chars_base_36_to_int(Chars0, 0, I)
- ),
- Arg = term__integer(I)
+ error("convert_key_string_to_arg: could not convert string to int")
+ )
;
Type = term__functor(term__atom("string"), [], _)
->
- convert_key_to_string(ArgString, S),
+ string__to_char_list(ArgString, Cs0),
+ remove_sort_file_escapes(Cs0, [], Cs1),
+ list__reverse(Cs1, Cs),
+ string__from_char_list(Cs, S),
Arg = term__string(S)
;
Type = term__functor(term__atom("float"), [], _)
@@ -1921,59 +1968,36 @@
error("convert_key_string_to_arg: unsupported type")
).
- % convert a list of chars representing a base 36 number to an int
-:- pred chars_base_36_to_int(list(char)::in, int::in, int::out) is det.
-
-chars_base_36_to_int([],Int, Int).
-chars_base_36_to_int([C | Cs], Int0, Int) :-
- (
- char__is_digit(C)
- ->
- char__to_int(C, IC),
- char__to_int('0', I0),
- Int1 is (IC - I0) + 36*Int0
- ;
- char__is_upper(C)
- ->
- char__to_int(C, IC),
- char__to_int('A', IA),
- Int1 is (IC - IA + 10) + 36*Int0
- ;
- string__format("chars_base_36_to_int: invalid character: %c",
- [c(C)], ErrorString),
- error(ErrorString)
- ),
- chars_base_36_to_int(Cs, Int1, Int).
-
% remove the escape characters put in the string by make_sort_file_key
-:- pred convert_key_to_string(string::in, string::out) is det.
+:- pred remove_sort_file_escapes(list(char), list(char), list(char)).
+:- mode remove_sort_file_escapes(in, in, out) is det.
-convert_key_to_string(Key0, String) :-
- ( Key0 = "" ->
- String = ""
- ;
- ( string__append("\\\\", Key1, Key0) ->
- Key = Key1,
- C = ('\\')
- ; string__append("\\c", Key1, Key0) ->
- Key = Key1,
- C = (':')
- ; string__append("\\t", Key1, Key0) ->
- Key = Key1,
- C = ('~')
- ; string__append("\\n", Key1, Key0) ->
- Key = Key1,
- C = ('\n')
- ; string__first_char(Key0, C0, Key1) ->
- Key = Key1,
- C = C0
+remove_sort_file_escapes([], Cs, Cs).
+remove_sort_file_escapes([C0 | Cs0], In, Out) :-
+ ( C0 = ('\\') ->
+ (
+ Cs0 = [C1 | Cs1],
+ ( C1 = ('\\') ->
+ C = ('\\')
+ ; C1 = ('c') ->
+ C = (':')
+ ; C1 = ('t') ->
+ C = ('~')
+ ; C1 = ('n') ->
+ C = ('\n')
+ ;
+ error("remove_sort_file_escapes: something went wrong")
+ ),
+ remove_sort_file_escapes(Cs1, [C | In], Out)
;
- error("convert_key_to_string: something went wrong")
- ),
- convert_key_to_string(Key, String1),
- string__first_char(String, C, String1)
+ Cs0 = [],
+ error("remove_sort_file_escapes: something went wrong")
+ )
+ ;
+ remove_sort_file_escapes(Cs0, [C0 | In], Out)
).
-
+
+
:- pred fact_get_arg_and_index(sort_file_line, int, fact_arg, int).
:- mode fact_get_arg_and_index(in, in, out, out) is det.
@@ -1990,35 +2014,48 @@
%------------------------------------------------------------------------------%
- % select a prime number > fact table size * 1.1
-:- pred calculate_hash_table_size(int, int).
-:- mode calculate_hash_table_size(in, out) is det.
-
-calculate_hash_table_size(FactTableSize, HashTableSize) :-
- Primes = [ 2, 5, 11, 17, 37, 67, 131, 257, 521, 1021, 2053, 4099,
- 8209, 16411, 32771, 65537, 131101, 262147, 524309,
- 534077,
- 1048627, 2097257, 4194493, 8388949, 16777903, 33555799 ],
- F is (FactTableSize * 11) // 10,
- calculate_hash_table_size_2(F, Primes, HashTableSize).
+ % 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(int, int, io__state, io__state).
+:- mode calculate_hash_table_size(in, out, di, uo) is det.
+
+calculate_hash_table_size(NumEntries, HashTableSize) -->
+ globals__io_lookup_option(fact_table_hash_percent_full, OptionData),
+ {
+ OptionData = int(PercentFull),
+ 0 < PercentFull,
+ PercentFull =< 100
+ ->
+ 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 is (NumEntries * 100) // PercentFull,
+ calculate_hash_table_size_2(N, Primes, HashTableSize)
+ ;
+ error("calculate_hash_table_size: invalid option data")
+ }.
:- pred calculate_hash_table_size_2(int, list(int), int).
:- mode calculate_hash_table_size_2(in, in, out) is det.
calculate_hash_table_size_2(_, [], _) :-
- error("fact table too large (max size 30505271)").
-calculate_hash_table_size_2(F, [P | Ps], H) :-
+ error("hash table too large (max size 2147483647)").
+calculate_hash_table_size_2(N, [P | Ps], H) :-
(
- P > F
+ P > N
->
H = P
;
- calculate_hash_table_size_2(F, Ps, H)
+ calculate_hash_table_size_2(N, Ps, H)
).
% 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_table, hash_entry, int, hash_table).
:- mode hash_table_insert(in, in, in, out) is det.
@@ -2069,7 +2106,7 @@
get_free_hash_slot(HashTable, Start, Free) :-
HashTable = hash_table(Size, _),
- Max is Size -1,
+ Max is Size - 1,
get_free_hash_slot_2(HashTable, Start, Max, Free).
:- pred get_free_hash_slot_2(hash_table, int, int, int).
@@ -2105,17 +2142,23 @@
;
Key = term__float(Float)
->
+ % XXX This method of hashing floats may not work cross-compiling
+ % between architectures that have different floating-point
+ % representations. Also, problems may arise if the
+ % implementation of predicates in the `float' and `math'
+ % modules changes because the generated C code needs to call
+ % the same C math functions that these library predicates use.
float__abs(Float, Abs),
( Abs = 0.0 -> Abs2 = 1e-15 ; Abs2 = Abs ),
math__ln(Abs2, Log),
math__ceiling(Log, TruncLog),
math__exp(TruncLog, Pow),
- Float2 is Abs2 / Pow * 1e15,
+ Float2 is Abs2 / Pow * 2147483647.0, % 2147483647 = (2^31)-1
float__truncate_to_int(Float2, N1),
float__abs(TruncLog, Log2),
float__truncate_to_int(Log2, N2),
- % N1 is an int between 1e15*exp(-1) and 1e15
+ % N1 is an int between ((2^31)-1)*exp(-1) and (2^31)-1
Ns = [N1, N2]
;
error("fact_table_hash: unsupported type in key")
@@ -2223,7 +2266,7 @@
{ Key = term__string(String) }
->
io__write_string(""""),
- term_io__quote_string(String),
+ output_c_quoted_string(String),
io__write_string("""")
;
{ Key = term__integer(Int) }
@@ -2236,21 +2279,21 @@
;
{ error("write_hash_table: unsupported type") }
),
- io__write_string(", (Word) "),
(
{ Index = fact(I) },
- io__write_int(I),
- io__write_string(", 1, ")
+ io__format(
+ ", FACT_TABLE_MAKE_TAGGED_INDEX(%d,1), ",
+ [i(I)])
;
{ Index = hash_table(I, H) },
- io__write_string("&"),
- io__write_string(H),
- io__write_int(I),
- io__write_string(", 2, ")
+ io__format(
+ ", FACT_TABLE_MAKE_TAGGED_POINTER(&%s%d,2), ",
+ [s(H), i(I)])
),
io__write_int(Next)
;
- io__write_string("0, 0, 0, -1 ")
+ io__write_string(
+ "0, FACT_TABLE_MAKE_TAGGED_POINTER(0,0), -1 ")
),
io__write_string("},\n"),
{ NextIndex is CurrIndex + 1 },
@@ -2258,7 +2301,7 @@
).
% Return 's' for string, 'i' for int, 'f' for float, 'a' for atom.
- % Don't call this with an emtpy hash table.
+ % Don't call this with an empty hash table.
:- pred get_hash_table_type(hash_table::in, char::out) is det.
get_hash_table_type(HashTable, TableType) :-
@@ -2332,10 +2375,9 @@
->
[]
;
- { string__format("\t%s%d,\n", [s(StructName), i(CurrFact)],
- TmpString) },
- io__write_string(OutputStream, TmpString),
- { fact_table_size(FactTableSize) },
+ io__format(OutputStream, "\t%s%d,\n",
+ [s(StructName), i(CurrFact)]),
+ fact_table_size(FactTableSize),
{ NextFact is CurrFact + FactTableSize },
write_fact_table_pointer_array_2(NextFact, NumFacts, StructName,
OutputStream)
@@ -2351,9 +2393,10 @@
% Write out the size of the fact table.
{ pred_info_name(PredInfo, Name) },
+ { llds_out__name_mangle(Name, MangledName) },
io__write_strings([
"const Integer mercury__",
- Name,
+ MangledName,
"_fact_table_num_facts = "]),
io__write_int(NumFacts),
io__write_string(";\n\n"),
@@ -2361,7 +2404,7 @@
{ string__append_list(
[
"extern const Integer mercury__",
- Name,
+ MangledName,
"_fact_table_num_facts;\n"
],
C_HeaderCode) },
@@ -2369,39 +2412,68 @@
io__set_output_stream(OldOutputStream, _).
%------------------------------------------------------------------------------%
+
+ % Delete a file. Report an error message if something goes wrong.
+:- pred delete_temporary_file(string::in, io__state::di, io__state::uo) is det.
+
+delete_temporary_file(FileName) -->
+ io__remove_file(FileName, Result),
+ (
+ { Result = ok }
+ ;
+ { Result = error(ErrorCode) },
+ { io__error_message(ErrorCode, ErrorMessage) },
+ io__write_strings([
+ "Error deleting file `",
+ FileName,
+ "':\n ",
+ ErrorMessage,
+ ".\n"]),
+ io__set_exit_status(1)
+ ).
+
+%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
fact_table_generate_c_code(PredName, PragmaVars, ProcID, PrimaryProcID,
- ProcInfo, ArgTypes, ArgsMethod, ProcCode, ExtraCode)
- :-
- proc_info_argmodes(ProcInfo, ArgModes),
- proc_info_inferred_determinism(ProcInfo, Determinism),
- fact_table_mode_type(ArgModes, ModeType),
- (
+ ProcInfo, ArgTypes, ArgsMethod, ModuleInfo, ProcCode,
+ ExtraCode) -->
+ fact_table_size(FactTableSize),
+ { proc_info_argmodes(ProcInfo, ArgModes) },
+ { proc_info_inferred_determinism(ProcInfo, Determinism) },
+ { fact_table_mode_type(ArgModes, ModuleInfo, ModeType) },
+ {
+ PredName = unqualified(PredNameString)
+ ;
+ PredName = qualified(_, PredNameString)
+ },
+ { llds_out__name_mangle(PredNameString, MangledName) },
+ {
ModeType = all_out,
Determinism = multidet
->
- generate_multidet_code(PredName, PragmaVars, ProcID, ProcInfo,
- ArgTypes, ProcCode, ExtraCode)
+ generate_multidet_code(MangledName, PragmaVars, ProcID,
+ ArgTypes, ArgsMethod, ModuleInfo, FactTableSize,
+ ProcCode, ExtraCode)
;
ModeType = all_out,
Determinism = cc_multidet
->
- generate_cc_multi_code(PredName, PragmaVars, ProcCode),
+ generate_cc_multi_code(MangledName, PragmaVars, ProcCode),
ExtraCode = ""
;
ModeType = all_in,
Determinism = semidet
->
- generate_all_in_code(PredName, PragmaVars, ProcID, ArgTypes,
- ProcCode),
+ generate_all_in_code(MangledName, PragmaVars, ProcID,
+ ArgTypes, ModuleInfo, ProcCode),
ExtraCode = ""
;
ModeType = in_out,
( Determinism = semidet ; Determinism = cc_nondet )
->
- generate_semidet_in_out_code(PredName, PragmaVars, ProcID,
- ArgTypes, ProcCode),
+ generate_semidet_in_out_code(MangledName, PragmaVars, ProcID,
+ ArgTypes, ModuleInfo, FactTableSize, ProcCode),
ExtraCode = ""
;
ModeType = in_out,
@@ -2408,18 +2480,20 @@
Determinism = nondet,
ProcID = PrimaryProcID
->
- generate_primary_nondet_code(PredName, PragmaVars, ProcID,
- ArgTypes, ArgsMethod, ProcCode, ExtraCode)
+ generate_primary_nondet_code(MangledName, PragmaVars,
+ ProcID, ArgTypes, ArgsMethod, ModuleInfo,
+ FactTableSize, ProcCode, ExtraCode)
;
ModeType = in_out,
Determinism = nondet,
ProcID \= PrimaryProcID
->
- generate_secondary_nondet_code(PredName, PragmaVars, ProcID,
- ArgTypes, ArgsMethod, ProcCode, ExtraCode)
+ generate_secondary_nondet_code(MangledName, PragmaVars,
+ ProcID, ArgTypes, ArgsMethod, ModuleInfo, FactTableSize,
+ ProcCode, ExtraCode)
;
error("fact_table_generate_c_code: mode/determinism error")
- ).
+ }.
%------------------------------------------------------------------------------%
@@ -2426,41 +2500,15 @@
% XXX this should change to use the new model_non pragma c_code when
% it has been implemented.
-:- pred generate_multidet_code(sym_name, list(pragma_var), proc_id,
- proc_info, list(type), string, string).
-:- mode generate_multidet_code(in, in, in, in, in, out, out) is det.
-
-generate_multidet_code(PredName, PragmaVars, ProcID, _ProcInfo, ArgTypes,
- ProcCode, ExtraCode) :-
-
- ProcCodeTemplate = "
+:- pred generate_multidet_code(string, list(pragma_var), proc_id,
+ list(type), args_method, module_info, int, string, string).
+:- mode generate_multidet_code(in, in, in, in, in, in, in, out, out) is det.
+
+generate_multidet_code(PredName, PragmaVars, ProcID, ArgTypes, ArgsMethod,
+ ModuleInfo, FactTableSize, ProcCode, ExtraCode) :-
+ generate_nondet_proc_code(PragmaVars, PredName, ProcID, ExtraCodeLabel,
+ ProcCode),
- /* 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.
- */
-
- maxfr = curprevfr;
- curfr = cursuccfr;
- {
- Declare_entry(%s);
- GOTO(ENTRY(%s));
- }
- ",
-
- (
- PredName = unqualified(Name)
- ;
- PredName = qualified(_, Name)
- ),
- list__length(PragmaVars, Arity),
- string__format("mercury__%s_%d_%d_xx", [s(Name), i(Arity), i(ProcID)],
- ExtraCodeLabel),
- pragma_vars_to_names_string(PragmaVars, NamesString),
- string__format(ProcCodeTemplate, [s(NamesString), s(ExtraCodeLabel),
- s(ExtraCodeLabel)], ProcCode),
-
ExtraCodeTemplate = "
Define_extern_entry(%s);
@@ -2476,28 +2524,38 @@
GOTO(LABEL(%s_i1));
Define_label(%s_i1);
if (framevar(0) >= %s) fail();
+ {
+ /* declare argument vars */
%s
+ Word ind = framevar(0);
+ /* lookup fact table */
+%s
+ /* save output args to registers */
+%s
+ }
framevar(0)++;
succeed();
END_MODULE
+extern ModuleFunc %s_module;
+
/*
INIT sys_init_%s_module
*/
void sys_init_%s_module(void);
void sys_init_%s_module(void) {
- extern ModuleFunc %s_module;
%s_module();
}
",
- string__append_list(["mercury__", Name, "_fact_table_num_facts"],
+ string__append_list(["mercury__", PredName, "_fact_table_num_facts"],
NumFactsVar),
- string__append_list(["mercury__", Name, "_fact_table"],
- StructName),
-
- gen_index_lookup_code(ArgTypes, 1, StructName, LookupCode),
+ list__length(PragmaVars, Arity),
+ generate_argument_vars_code(PragmaVars, ArgTypes, ArgsMethod,
+ ModuleInfo, ArgDeclCode, _InputCode, OutputCode, _, _, _),
+ generate_fact_lookup_code(PredName, PragmaVars, ModuleInfo, 1,
+ FactTableSize, FactLookupCode),
string__format(ExtraCodeTemplate, [
s(ExtraCodeLabel),
@@ -2506,13 +2564,15 @@
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
- s(Name),
+ s(PredName),
i(Arity),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(NumFactsVar),
- s(LookupCode),
+ s(ArgDeclCode),
+ s(FactLookupCode),
+ s(OutputCode),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
@@ -2521,6 +2581,35 @@
],
ExtraCode).
+:- pred generate_nondet_proc_code(list(pragma_var)::in, string::in, int::in,
+ string::out, string::out) is det.
+
+generate_nondet_proc_code(PragmaVars, PredName, ProcID, 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.
+ */
+
+ maxfr = curprevfr;
+ curfr = cursuccfr;
+ {
+ Declare_entry(%s);
+ GOTO(ENTRY(%s));
+ }
+ ",
+
+ list__length(PragmaVars, Arity),
+ string__format("mercury__%s_%d_%d_xx",
+ [s(PredName), i(Arity), i(ProcID)], ExtraCodeLabel),
+ pragma_vars_to_names_string(PragmaVars, NamesString),
+ string__format(ProcCodeTemplate, [s(NamesString), s(ExtraCodeLabel),
+ s(ExtraCodeLabel)], ProcCode).
+
+
% pragma_vars_to_names_string(PragmaVars, NamesString),
% create a string containing the names of the pragma vars separated by
% a space.
@@ -2532,57 +2621,14 @@
pragma_vars_to_names_string(PVars, NamesString0),
string__append_list([Name, ", ", NamesString0], NamesString).
- % gen_index_lookup_code(ArgTypes, VarNum, StructName, LookupCode)
- % generate c code to do the index lookup.
-:- pred gen_index_lookup_code(list(type), int, string, string).
-:- mode gen_index_lookup_code(in, in, in, out) is det.
-
-gen_index_lookup_code([], _, _, "").
-gen_index_lookup_code([Type | Types], VarNum, StructName, C_Code) :-
- (
- Type = term__functor(term__atom("string"), [], _)
- ->
- Template =
- "\tr%d = (Word) %s[framevar(0)/%d][framevar(0)%%%d].V_%d;\n"
- ;
- Type = term__functor(term__atom("int"), [], _)
- ->
- Template = "\tr%d = %s[framevar(0)/%d][framevar(0)%%%d].V_%d;\n"
- ;
- Type = term__functor(term__atom("float"), [], _)
- ->
- Template =
- "\tr%d = float_to_word(%s[framevar(0)/%d][framevar(0)%%%d].V_%d);\n"
- ;
- % shouldn't get here
- error("fact_table.m: gen_index_lookup_code: type error")
- ),
- fact_table_size(FactTableSize),
- string__format(Template, [
- i(VarNum),
- s(StructName),
- i(FactTableSize),
- i(FactTableSize),
- i(VarNum)
- ],
- C_Code0),
- VarNum1 is VarNum + 1,
- gen_index_lookup_code(Types, VarNum1, StructName, C_Code1),
- string__append(C_Code0, C_Code1, C_Code).
-
%------------------------------------------------------------------------------%
% for cc_multi output mode, just return the first fact in the table
-:- pred generate_cc_multi_code(sym_name, list(pragma_var), string).
+:- pred generate_cc_multi_code(string, list(pragma_var), string).
:- mode generate_cc_multi_code(in, in, out) is det.
generate_cc_multi_code(PredName, PragmaVars, ProcCode) :-
- (
- PredName = unqualified(Name)
- ;
- PredName = qualified(_, Name)
- ),
- string__append_list(["mercury__", Name, "_fact_table"], StructName),
+ string__append_list(["mercury__", PredName, "_fact_table"], StructName),
generate_cc_multi_code_2(PragmaVars, StructName, 1, "", ProcCode).
:- pred generate_cc_multi_code_2(list(pragma_var), string, int, string, string).
@@ -2601,49 +2647,31 @@
%------------------------------------------------------------------------------%
% generate semidet code for all_in mode
-:- pred generate_all_in_code(sym_name, list(pragma_var), proc_id, list(type),
- string).
-:- mode generate_all_in_code(in, in, in, in, out) is det.
-
-generate_all_in_code(PredName, PragmaVars, ProcID, ArgTypes, ProcCode)
- :-
- (
- PredName = unqualified(Name)
- ;
- PredName = qualified(_, Name)
- ),
-
- DeclCodeTemplate = "
- {
- Integer hashval, hashsize;
- Word ind;
- int keyfound;
- void *current_table;
- char keytype;
- Word current_key;
-
- /* initialise current_table to the top level hash table
- * for this ProcID
- */
- current_table =
- (void *)&mercury__%s_fact_table_hash_table_%d_0;
-
- ",
- string__format(DeclCodeTemplate, [s(Name), i(ProcID)], DeclCode),
+:- pred generate_all_in_code(string, list(pragma_var), proc_id, list(type),
+ module_info, string).
+:- mode generate_all_in_code(in, in, in, in, in, out) is det.
+
+generate_all_in_code(PredName, PragmaVars, ProcID, ArgTypes, ModuleInfo,
+ ProcCode) :-
+ generate_decl_code(PredName, ProcID, DeclCode),
+
+ string__format("%s_%d", [s(PredName), i(ProcID)], LabelName),
+ generate_hash_code(PragmaVars, ArgTypes, ModuleInfo, LabelName, 0,
+ HashCode),
- string__format("%s_%d", [s(Name), i(ProcID)], LabelName),
- generate_hash_code(PragmaVars, ArgTypes, LabelName, HashCode),
-
SuccessCodeTemplate = "
- success_code_%s:
- failure_code_%s:
- SUCCESS_INDICATOR = keyfound;
- }
+ success_code_%s:
+ SUCCESS_INDICATOR = TRUE;
+ goto skip_%s;
+ failure_code_%s:
+ SUCCESS_INDICATOR = FALSE;
+ skip_%s:
",
- string__format(SuccessCodeTemplate, [s(LabelName), s(LabelName)],
- SuccessCode),
+ string__format(SuccessCodeTemplate, [s(LabelName), s(LabelName),
+ s(LabelName), s(LabelName)], SuccessCode),
- string__append_list([DeclCode, HashCode, SuccessCode], ProcCode).
+ string__append_list([
+ "\t{\n", DeclCode, HashCode, SuccessCode, "\t}\n"], ProcCode).
%------------------------------------------------------------------------------%
@@ -2650,46 +2678,27 @@
% 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(sym_name, list(pragma_var), proc_id,
- list(type), string).
-:- mode generate_semidet_in_out_code(in, in, in, in, out) is det.
-
-generate_semidet_in_out_code(PredName, PragmaVars, ProcID, ArgTypes, ProcCode):-
- (
- PredName = unqualified(Name)
- ;
- PredName = qualified(_, Name)
- ),
-
- DeclCodeTemplate = "
- {
- Integer hashval, hashsize;
- Word ind;
- int keyfound;
- void *current_table;
- char keytype;
- Word current_key;
-
- /* initialise current_table to the top level hash table
- * for this ProcID
- */
- current_table =
- (void *)&mercury__%s_fact_table_hash_table_%d_0;
-
- ",
+:- pred generate_semidet_in_out_code(string, list(pragma_var), proc_id,
+ list(type), module_info, int, string).
+:- mode generate_semidet_in_out_code(in, in, in, in, in, in, out) is det.
+
+generate_semidet_in_out_code(PredName, PragmaVars, ProcID, ArgTypes,
+ ModuleInfo, FactTableSize, ProcCode):-
+ generate_decl_code(PredName, ProcID, DeclCode),
+
+ string__format("%s_%d", [s(PredName), i(ProcID)], LabelName),
+ generate_hash_code(PragmaVars, ArgTypes, ModuleInfo, LabelName, 0,
+ HashCode),
- string__format(DeclCodeTemplate, [s(Name), i(ProcID)], DeclCode),
-
- string__format("%s_%d", [s(Name), i(ProcID)], LabelName),
- generate_hash_code(PragmaVars, ArgTypes, LabelName, HashCode),
-
SuccessCodeTemplate = "
success_code_%s:
SUCCESS_INDICATOR = TRUE;
+ ind = FACT_TABLE_HASH_INDEX(ind);
",
string__format(SuccessCodeTemplate, [s(LabelName)], SuccessCode),
- generate_fact_lookup_code(Name, PragmaVars, 1, FactLookupCode),
+ generate_fact_lookup_code(PredName, PragmaVars, ModuleInfo, 1,
+ FactTableSize, FactLookupCode),
FailCodeTemplate = "
goto skip_%s;
@@ -2696,55 +2705,79 @@
failure_code_%s:
SUCCESS_INDICATOR = FALSE;
skip_%s:
- }
",
string__format(FailCodeTemplate, [s(LabelName), s(LabelName),
s(LabelName)], FailCode),
- string__append_list([DeclCode, HashCode, SuccessCode, FactLookupCode,
- FailCode], ProcCode).
+ string__append_list(["\t{\n", DeclCode, HashCode, SuccessCode,
+ FactLookupCode, FailCode, "\t}\n"], ProcCode).
%------------------------------------------------------------------------------%
% Some code generation procedures used by various modes.
- % generate code to calculate hash values and lookup the hash tables
-:- pred generate_hash_code(list(pragma_var), list(type), string, string).
-:- mode generate_hash_code(in, in, in, out) is det.
+:- pred generate_decl_code(string::in, proc_id::in, string::out) is det.
+
+generate_decl_code(Name, ProcID, DeclCode) :-
+ DeclCodeTemplate = "
+ Integer hashval, hashsize;
+ Word ind;
+ void *current_table;
+ char keytype;
+ Word current_key;
-generate_hash_code([], [], _, "").
-generate_hash_code([], [_|_], _, _) :- error("generate_hash_code").
-generate_hash_code([_|_], [], _, _) :- error("generate_hash_code").
+ /* initialise current_table to the top level hash table
+ ** for this ProcID
+ */
+ current_table =
+ &mercury__%s_fact_table_hash_table_%d_0;
+
+ ",
+ string__format(DeclCodeTemplate, [s(Name), i(ProcID)], DeclCode).
+
+ % generate code to calculate hash values and lookup the hash tables
+:- pred generate_hash_code(list(pragma_var), list(type), module_info, string,
+ int, string).
+:- mode generate_hash_code(in, in, in, in, in, out) is det.
+
+generate_hash_code([], [], _, _, _, "").
+generate_hash_code([], [_|_], _, _, _, _) :- error("generate_hash_code").
+generate_hash_code([_|_], [], _, _, _, _) :- error("generate_hash_code").
generate_hash_code([pragma_var(_, Name, Mode)|PragmaVars], [Type | Types],
- LabelName, C_Code) :-
- (
- Mode = user_defined_mode(qualified("mercury_builtin", "in"), [])
- ->
+ ModuleInfo, LabelName, LabelNum, C_Code) :-
+ ( mode_is_input(ModuleInfo, Mode) ->
(
Type = term__functor(term__atom("int"), [], _)
->
- generate_hash_int_code(Name, LabelName, C_Code0)
+ generate_hash_int_code(Name, LabelName, LabelNum,
+ C_Code0)
;
Type = term__functor(term__atom("float"), [], _)
->
- generate_hash_float_code(Name, LabelName, C_Code0)
+ generate_hash_float_code(Name, LabelName, LabelNum,
+ C_Code0)
;
Type = term__functor(term__atom("string"), [], _)
->
- generate_hash_string_code(Name, LabelName, C_Code0)
+ generate_hash_string_code(Name, LabelName, LabelNum,
+ C_Code0)
;
- error("generate_make_key_code: unsupported type")
+ error("generate_hash_code: unsupported type")
),
- generate_hash_code(PragmaVars, Types, LabelName, C_Code1),
+ NextLabelNum is LabelNum + 1,
+ generate_hash_code(PragmaVars, Types, ModuleInfo, LabelName,
+ NextLabelNum, C_Code1),
string__append(C_Code0, C_Code1, C_Code)
;
% skip non-input arguments
- generate_hash_code(PragmaVars, Types, LabelName, C_Code)
+ generate_hash_code(PragmaVars, Types, ModuleInfo, LabelName,
+ LabelNum, C_Code)
).
-:- pred generate_hash_int_code(string::in, string::in, string::out) is det.
+:- pred generate_hash_int_code(string::in, string::in, int::in, string::out)
+ is det.
-generate_hash_int_code(Name, LabelName, C_Code) :-
- generate_hash_lookup_code(Name, LabelName, "%s == %s", 'i',
+generate_hash_int_code(Name, LabelName, LabelNum, C_Code) :-
+ generate_hash_lookup_code(Name, LabelName, LabelNum, "%s == %s", 'i',
HashLookupCode),
C_Code_Template = "
@@ -2764,10 +2797,11 @@
string__format(C_Code_Template, [s(Name), s(Name), s(HashLookupCode)],
C_Code).
-:- pred generate_hash_float_code(string::in, string::in, string::out) is det.
+:- pred generate_hash_float_code(string::in, string::in, int::in, string::out)
+ is det.
-generate_hash_float_code(Name, LabelName, C_Code) :-
- generate_hash_lookup_code(Name, LabelName, "%s == %s", 'f',
+generate_hash_float_code(Name, LabelName, LabelNum, C_Code) :-
+ generate_hash_lookup_code(Name, LabelName, LabelNum, "%s == %s", 'f',
HashLookupCode),
C_Code_Template = "
@@ -2783,7 +2817,7 @@
h = log(f);
h = ceil(h);
g = exp(h);
- g = f / g * 1e15;
+ g = f / g * 2147483647.0;
if (h <= 0.0) h = -h;
hashval = (Integer)g %% hashsize;
hashval = ((Integer)h + 31*hashval) %% hashsize;
@@ -2798,11 +2832,12 @@
string__format(C_Code_Template, [s(Name), s(Name), s(HashLookupCode)],
C_Code).
-:- pred generate_hash_string_code(string::in, string::in, string::out) is det.
+:- pred generate_hash_string_code(string::in, string::in, int::in, string::out)
+ is det.
-generate_hash_string_code(Name, LabelName, C_Code) :-
- generate_hash_lookup_code(Name, LabelName, "streq(%s, %s)",
- 's', HashLookupCode),
+generate_hash_string_code(Name, LabelName, LabelNum, C_Code) :-
+ generate_hash_lookup_code(Name, LabelName, LabelNum,
+ "strcmp(%s, %s) == 0", 's', HashLookupCode),
C_Code_Template = "
hashsize = ((struct fact_table_hash_table_s *)current_table)
@@ -2831,11 +2866,11 @@
% 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, string::in,
+:- pred generate_hash_lookup_code(string::in, string::in, int::in, string::in,
char::in, string::out) is det.
-generate_hash_lookup_code(VarName, LabelName, CompareTemplate, KeyType,
- HashLookupCode) :-
+generate_hash_lookup_code(VarName, LabelName, LabelNum, CompareTemplate,
+ KeyType, HashLookupCode) :-
string__format(
"((struct fact_table_hash_table_%c *)current_table)->table[hashval]",
[c(KeyType)], HashTableEntry),
@@ -2845,59 +2880,57 @@
HashLookupCodeTemplate = "
- keyfound = FALSE;
-
do {
- if (%s.type != 0 && %s)
+ if (FACT_TABLE_HASH_ENTRY_TYPE(%s) != 0 && %s)
{
ind = %s.index;
- keyfound = TRUE;
- break;
+ goto found_%s_%d;
}
} while ((hashval = %s.next) != -1);
- if (keyfound == FALSE) goto failure_code_%s;
+ /* key not found */
+ goto failure_code_%s;
+
+ found_%s_%d:
- if (%s.type == 1) {
+ if (FACT_TABLE_HASH_ENTRY_TYPE(%s) == 1) {
keytype = '%c';
hashval = %s.next;
goto success_code_%s;
}
- current_table = (void *)ind;
+ current_table = (void *)FACT_TABLE_HASH_POINTER(ind);
",
string__format(HashLookupCodeTemplate, [s(HashTableEntry),
- s(CompareString), s(HashTableEntry), s(HashTableEntry),
- s(LabelName), s(HashTableEntry), c(KeyType), s(HashTableEntry),
+ s(CompareString), s(HashTableEntry), s(LabelName), i(LabelNum),
+ s(HashTableEntry), s(LabelName), s(LabelName), i(LabelNum),
+ s(HashTableEntry), c(KeyType), s(HashTableEntry),
s(LabelName)], HashLookupCode).
% Generate code to lookup the fact table with a given index
-:- pred generate_fact_lookup_code(string, list(pragma_var), int, string).
-:- mode generate_fact_lookup_code(in, in, in, out) is det.
+:- pred generate_fact_lookup_code(string, list(pragma_var), module_info,
+ int, int, string).
+:- mode generate_fact_lookup_code(in, in, in, in, in, out) is det.
-generate_fact_lookup_code(_, [], _, "").
+generate_fact_lookup_code(_, [], _, _, _, "").
generate_fact_lookup_code(PredName, [pragma_var(_, VarName, Mode)|PragmaVars],
- ArgNum, C_Code) :-
+ ModuleInfo, ArgNum, FactTableSize, C_Code) :-
NextArgNum is ArgNum + 1,
- (
- Mode = user_defined_mode(qualified("mercury_builtin", "out"),
- [])
- ->
- fact_table_size(FactTableSize),
+ ( mode_is_output(ModuleInfo, Mode) ->
C_Code_Template =
- "\t\t\t%s = mercury__%s_fact_table[ind/%d][ind%%%d].V_%d;\n",
+ "\t\t%s = mercury__%s_fact_table[ind/%d][ind%%%d].V_%d;\n",
string__format(C_Code_Template, [s(VarName), s(PredName),
i(FactTableSize), i(FactTableSize),i(ArgNum)], C_Code0),
- generate_fact_lookup_code(PredName, PragmaVars, NextArgNum,
- C_Code1),
+ generate_fact_lookup_code(PredName, PragmaVars, ModuleInfo,
+ NextArgNum, FactTableSize, C_Code1),
string__append(C_Code0, C_Code1, C_Code)
;
% skip non-output arguments
- generate_fact_lookup_code(PredName, PragmaVars, NextArgNum,
- C_Code)
+ generate_fact_lookup_code(PredName, PragmaVars, ModuleInfo,
+ NextArgNum, FactTableSize, C_Code)
).
%------------------------------------------------------------------------------%
@@ -2907,41 +2940,16 @@
% XXX this should change to use the new model_non pragma c_code when
% it has been implemented.
-:- pred generate_primary_nondet_code(sym_name, list(pragma_var), proc_id,
- list(type), args_method, string, string).
-:- mode generate_primary_nondet_code(in, in, in, in, in, out, out) is det.
+:- pred generate_primary_nondet_code(string, list(pragma_var), proc_id,
+ list(type), args_method, module_info, int, string, string).
+:- mode generate_primary_nondet_code(in, in, in, in, in, in, in, out, out)
+ is det.
generate_primary_nondet_code(PredName, PragmaVars, ProcID, ArgTypes, ArgsMethod,
- ProcCode, ExtraCode) :-
-
- 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.
- */
+ ModuleInfo, FactTableSize, ProcCode, ExtraCode) :-
+ generate_nondet_proc_code(PragmaVars, PredName, ProcID, ExtraCodeLabel,
+ ProcCode),
- maxfr = curprevfr;
- curfr = cursuccfr;
- {
- Declare_entry(%s);
- GOTO(ENTRY(%s));
- }
- ",
-
- (
- PredName = unqualified(Name)
- ;
- PredName = qualified(_, Name)
- ),
- list__length(PragmaVars, Arity),
- string__format("mercury__%s_%d_%d_xx", [s(Name), i(Arity), i(ProcID)],
- ExtraCodeLabel),
- pragma_vars_to_names_string(PragmaVars, NamesString),
- string__format(ProcCodeTemplate, [s(NamesString), s(ExtraCodeLabel),
- s(ExtraCodeLabel)], ProcCode),
-
ExtraCodeTemplate = "
Define_extern_entry(%s);
@@ -2956,26 +2964,16 @@
{
/* create argument vars */
%s
- Integer hashval, hashsize;
- Word ind;
- int keyfound;
- void *current_table;
- char keytype;
- Word current_key;
-
+ /* declare local variables */
+%s
/* copy registers to input arg vars */
%s
/* copy registers to framevars */
%s
- /* initialise current_table to the top level hash table
- * for this ProcID
- */
- current_table =
- (void *)&mercury__%s_fact_table_hash_table_%d_0;
-
/* lookup hash table */
%s
success_code_%s:
+ ind = FACT_TABLE_HASH_INDEX(ind);
/* lookup fact table */
%s
/* save output args to registers */
@@ -3007,12 +3005,13 @@
succeed();
END_MODULE
+extern ModuleFunc %s_module;
+
/*
INIT sys_init_%s_module
*/
void sys_init_%s_module(void);
void sys_init_%s_module(void) {
- extern ModuleFunc %s_module;
%s_module();
}
@@ -3019,15 +3018,20 @@
",
generate_argument_vars_code(PragmaVars, ArgTypes, ArgsMethod,
- DeclCode, InputCode, OutputCode, SaveRegsCode, GetRegsCode,
- NumFrameVars),
- string__format("%s_%d", [s(Name), i(ProcID)], LabelName),
- generate_hash_code(PragmaVars, ArgTypes, LabelName, HashCode),
- generate_fact_lookup_code(Name, PragmaVars, 1, FactLookupCode),
- generate_fact_test_code(Name, PragmaVars, ArgTypes, FactTestCode),
+ ModuleInfo, ArgDeclCode, InputCode, OutputCode, SaveRegsCode,
+ GetRegsCode, NumFrameVars),
+ generate_decl_code(PredName, ProcID, DeclCode),
+ string__format("%s_%d", [s(PredName), i(ProcID)], LabelName),
+ generate_hash_code(PragmaVars, ArgTypes, ModuleInfo, LabelName, 0,
+ HashCode),
+ generate_fact_lookup_code(PredName, PragmaVars, ModuleInfo, 1,
+ FactTableSize, FactLookupCode),
+ generate_fact_test_code(PredName, PragmaVars, ArgTypes, ModuleInfo,
+ FactTableSize, FactTestCode),
- string__append_list(["mercury__", Name, "_fact_table_num_facts"],
+ string__append_list(["mercury__", PredName, "_fact_table_num_facts"],
NumFactsVar),
+ list__length(PragmaVars, Arity),
string__format(ExtraCodeTemplate, [
s(ExtraCodeLabel),
@@ -3036,15 +3040,14 @@
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
- s(Name),
+ s(PredName),
i(Arity),
i(NumFrameVars),
s(ExtraCodeLabel),
+ s(ArgDeclCode),
s(DeclCode),
s(InputCode),
s(SaveRegsCode),
- s(Name),
- i(ProcID),
s(HashCode),
s(LabelName),
s(FactLookupCode),
@@ -3052,7 +3055,7 @@
s(LabelName),
s(ExtraCodeLabel),
s(NumFactsVar),
- s(DeclCode),
+ s(ArgDeclCode),
s(GetRegsCode),
s(InputCode),
s(FactTestCode),
@@ -3069,134 +3072,94 @@
% generate code to create argument variables and assign them to
% registers
:- pred generate_argument_vars_code(list(pragma_var), list(type), args_method,
- string, string, string, string, string, int).
-:- mode generate_argument_vars_code(in, in, in, out, out, out, out, out, out)
- is det.
-
-generate_argument_vars_code(PragmaVars, Types, simple, DeclCode, InputCode,
- OutputCode, SaveRegsCode, GetRegsCode, NumInputArgs) :-
- generate_simple_arg_vars_code(PragmaVars, Types, 1, DeclCode, InputCode,
- OutputCode, SaveRegsCode, GetRegsCode, 1, NumInputArgs).
-
-generate_argument_vars_code(PragmaVars, Types, compact, DeclCode, InputCode,
- OutputCode, SaveRegsCode, GetRegsCode, NumInputArgs) :-
- generate_compact_arg_vars_code(PragmaVars, Types, 1, 1, DeclCode,
- InputCode, OutputCode, SaveRegsCode, GetRegsCode, NumInputArgs).
-
-:- pred generate_simple_arg_vars_code(list(pragma_var), list(type), int,
- string, string, string, string, string, int, int).
-:- mode generate_simple_arg_vars_code(in, in, in, out, out, out, out, out, in,
+ module_info, string, string, string, string, string, int).
+:- mode generate_argument_vars_code(in, in, in, in, out, out, out, out, out,
out) is det.
-generate_simple_arg_vars_code([], [], _, "", "", "", "", "", NumInputArgs,
- NumInputArgs).
-generate_simple_arg_vars_code([_|_], [], _, _, _, _, _, _, _, _) :-
- error("generate_simple_arg_vars_code: too many PragmaVars").
-generate_simple_arg_vars_code([], [_|_], _, _, _, _, _, _, _, _) :-
- error("generate_simple_arg_vars_code: too many Types").
-generate_simple_arg_vars_code([PragmaVar|PragmaVars], [Type|Types], RegNum,
+generate_argument_vars_code(PragmaVars, Types, ArgsMethod, ModuleInfo,
DeclCode, InputCode, OutputCode, SaveRegsCode, GetRegsCode,
- NumInputArgs0, NumInputArgs) :-
- PragmaVar = pragma_var(_, Name, Mode),
- generate_arg_decl_code(Name, Type, DeclCode0),
- (
- Mode = user_defined_mode(qualified("mercury_builtin", "in"),
- [])
- ->
- generate_arg_input_code(Name, Type, RegNum, NumInputArgs0,
- InputCode0, SaveRegsCode0, GetRegsCode0),
- NumInputArgs1 is NumInputArgs0 + 1,
- OutputCode0 = ""
- ;
- Mode = user_defined_mode(qualified("mercury_builtin", "out"),
- [])
- ->
- generate_arg_output_code(Name, Type, RegNum, OutputCode0),
- InputCode0 = "",
- SaveRegsCode0 = "",
- GetRegsCode0 = "",
- NumInputArgs1 = NumInputArgs0
- ;
- error("generate_simple_arg_vars_code: invalid mode")
- ),
- NextRegNum is RegNum + 1,
- generate_simple_arg_vars_code(PragmaVars, Types, NextRegNum,
- DeclCode1, InputCode1, OutputCode1, SaveRegsCode1, GetRegsCode1,
- NumInputArgs1, NumInputArgs),
- string__append(DeclCode0, DeclCode1, DeclCode),
- string__append(InputCode0, InputCode1, InputCode),
- string__append(OutputCode0, OutputCode1, OutputCode),
- string__append(SaveRegsCode0, SaveRegsCode1, SaveRegsCode),
- string__append(GetRegsCode0, GetRegsCode1, GetRegsCode).
-
-:- pred generate_compact_arg_vars_code(list(pragma_var), list(type), int, int,
- string, string, string, string, string, int).
-:- mode generate_compact_arg_vars_code(in, in, in, in, out, out, out, out, out,
- out) is det.
-
-generate_compact_arg_vars_code([], [], NumInputArgs, _, "", "", "", "", "",
+ NumInputArgs) :-
+ list__map(lambda([X::in, Y::out] is det, X = pragma_var(_,_,Y)),
+ PragmaVars, Modes),
+ make_arg_infos(ArgsMethod, Types, Modes, model_non, ModuleInfo,
+ ArgInfos),
+ generate_argument_vars_code_2(PragmaVars, ArgInfos, Types, DeclCode,
+ InputCode, OutputCode, SaveRegsCode, GetRegsCode, 1,
NumInputArgs).
-generate_compact_arg_vars_code([_|_], [], _, _, _, _, _, _, _, _) :-
- error("generate_compact_arg_vars_code: too many PragmaVars").
-generate_compact_arg_vars_code([], [_|_], _, _, _, _, _, _, _, _) :-
- error("generate_compact_arg_vars_code: too many Types").
-generate_compact_arg_vars_code([PragmaVar|PragmaVars], [Type|Types], InRegNum,
- OutRegNum, DeclCode, InputCode, OutputCode, SaveRegsCode,
- GetRegsCode, NumInputArgs) :-
- PragmaVar = pragma_var(_, Name, Mode),
- generate_arg_decl_code(Name, Type, DeclCode0),
+
+:- pred generate_argument_vars_code_2(list(pragma_var), list(arg_info),
+ list(type), string, string, string, string, string, int, int).
+:- mode generate_argument_vars_code_2(in, in, in, out, out, out, out, out,
+ in, out) is det.
+
+generate_argument_vars_code_2(PragmaVars0, ArgInfos0, Types0, DeclCode,
+ InputCode, OutputCode, SaveRegsCode, GetRegsCode,
+ NumInputArgs0, NumInputArgs) :-
(
- Mode = user_defined_mode(qualified("mercury_builtin", "in"),
- [])
- ->
- generate_arg_input_code(Name, Type, InRegNum, InRegNum,
- InputCode0, SaveRegsCode0, GetRegsCode0),
- OutputCode0 = "",
- NextInRegNum is InRegNum + 1,
- NextOutRegNum = OutRegNum
- ;
- Mode = user_defined_mode(qualified("mercury_builtin", "out"),
- [])
- ->
- generate_arg_output_code(Name, Type, OutRegNum, OutputCode0),
- InputCode0 = "",
- SaveRegsCode0 = "",
- GetRegsCode0 = "",
- NextOutRegNum is OutRegNum + 1,
- NextInRegNum = InRegNum
+ PragmaVars0 = [],
+ ArgInfos0 = [],
+ Types0 = []
+ ->
+ DeclCode = "",
+ InputCode = "",
+ OutputCode = "",
+ SaveRegsCode = "",
+ GetRegsCode = "",
+ NumInputArgs = NumInputArgs0
+ ;
+ PragmaVars0 = [pragma_var(_, VarName, _) | PragmaVars],
+ ArgInfos0 = [arg_info(Loc, ArgMode) | ArgInfos],
+ Types0 = [Type | Types]
+ ->
+ generate_arg_decl_code(VarName, Type, DeclCode0),
+ ( ArgMode = top_in ->
+ generate_arg_input_code(VarName, Type, Loc,
+ NumInputArgs0, InputCode0, SaveRegsCode0,
+ GetRegsCode0),
+ NumInputArgs1 is NumInputArgs0 + 1,
+ OutputCode0 = ""
+ ; ArgMode = top_out ->
+ generate_arg_output_code(VarName, Type, Loc,
+ OutputCode0),
+ InputCode0 = "",
+ SaveRegsCode0 = "",
+ GetRegsCode0 = "",
+ NumInputArgs1 = NumInputArgs0
+ ;
+ error("generate_argument_vars_code: invalid mode")
+ ),
+ generate_argument_vars_code_2(PragmaVars, ArgInfos, Types,
+ DeclCode1, InputCode1, OutputCode1, SaveRegsCode1,
+ GetRegsCode1, NumInputArgs1, NumInputArgs),
+ string__append(DeclCode0, DeclCode1, DeclCode),
+ string__append(InputCode0, InputCode1, InputCode),
+ string__append(OutputCode0, OutputCode1, OutputCode),
+ string__append(SaveRegsCode0, SaveRegsCode1, SaveRegsCode),
+ string__append(GetRegsCode0, GetRegsCode1, GetRegsCode)
;
- error("generate_compact_arg_vars_code: invalid mode")
- ),
- generate_compact_arg_vars_code(PragmaVars, Types, NextInRegNum,
- NextOutRegNum, DeclCode1, InputCode1, OutputCode1,
- SaveRegsCode1, GetRegsCode1, NumInputArgs),
- string__append(DeclCode0, DeclCode1, DeclCode),
- string__append(InputCode0, InputCode1, InputCode),
- string__append(OutputCode0, OutputCode1, OutputCode),
- string__append(SaveRegsCode0, SaveRegsCode1, SaveRegsCode),
- string__append(GetRegsCode0, GetRegsCode1, GetRegsCode).
-
+ error("generate_argument_vars_code: list length mismatch")
+ ).
:- pred generate_arg_decl_code(string::in, (type)::in, string::out) is det.
generate_arg_decl_code(Name, Type, DeclCode) :-
(
- Type = term__functor(term__atom("string"), [], _)
+ get_c_type_from_mercury_type(Type, C_Type)
->
- Template = "\t\tString %s;\n"
+ string__format("\t\t%s %s;\n", [s(C_Type), s(Name)], DeclCode)
;
- Type = term__functor(term__atom("int"), [], _)
- ->
- Template = "\t\tInteger %s;\n"
- ;
- Type = term__functor(term__atom("float"), [], _)
- ->
- Template = "\t\tFloat %s;\n"
- ;
error("generate_arg_decl_code: invalid type")
- ),
- string__format(Template, [s(Name)], DeclCode).
+ ).
+
+:- pred get_c_type_from_mercury_type((type)::in, string::out) is semidet.
+get_c_type_from_mercury_type(term__functor(term__atom("string"), [], _),
+ "String").
+get_c_type_from_mercury_type(term__functor(term__atom("int"), [], _),
+ "Integer").
+get_c_type_from_mercury_type(term__functor(term__atom("float"), [], _),
+ "Float").
+
:- pred generate_arg_input_code(string::in, (type)::in, int::in, int::in,
string::out, string::out, string::out) is det.
@@ -3205,23 +3168,24 @@
(
Type = term__functor(term__atom("string"), [], _)
->
- Template = "\t\t%s = (String)r%d;\n"
+ Template = "\t\t%s = (String)%s;\n"
;
Type = term__functor(term__atom("int"), [], _)
->
- Template = "\t\t%s = r%d;\n"
+ Template = "\t\t%s = %s;\n"
;
Type = term__functor(term__atom("float"), [], _)
->
- Template = "\t\t%s = word_to_float(r%d);\n"
+ Template = "\t\t%s = word_to_float(%s);\n"
;
error("generate_arg_input_code: invalid type")
),
- string__format(Template, [s(Name), i(RegNum)], InputCode),
- string__format("\t\tframevar(%d) = r%d;\n", [i(FrameVarNum), i(RegNum)],
- SaveRegCode),
- string__format("\t\tr%d = framevar(%d);\n", [i(RegNum), i(FrameVarNum)],
- GetRegCode).
+ get_reg_name(RegNum, RegName),
+ string__format(Template, [s(Name), s(RegName)], InputCode),
+ string__format("\t\tframevar(%d) = %s;\n",
+ [i(FrameVarNum), s(RegName)], SaveRegCode),
+ string__format("\t\t%s = framevar(%d);\n",
+ [s(RegName), i(FrameVarNum)], GetRegCode).
:- pred generate_arg_output_code(string::in, (type)::in, int::in,
string::out) is det.
@@ -3230,58 +3194,69 @@
(
Type = term__functor(term__atom("string"), [], _)
->
- Template = "\t\tr%d = (Word) %s;\n"
+ Template = "\t\t%s = (Word) %s;\n"
;
Type = term__functor(term__atom("int"), [], _)
->
- Template = "\t\tr%d = %s;\n"
+ Template = "\t\t%s = %s;\n"
;
Type = term__functor(term__atom("float"), [], _)
->
- Template = "\t\tr%d = float_to_word(%s);\n"
+ Template = "\t\t%s = float_to_word(%s);\n"
;
error("generate_arg_output_code: invalid type")
),
- string__format(Template, [i(RegNum), s(Name)], OutputCode).
+ get_reg_name(RegNum, RegName),
+ string__format(Template, [s(RegName), s(Name)], OutputCode).
+
+:- pred get_reg_name(int::in, string::out) is det.
+
+get_reg_name(RegNum, RegName) :-
+ code_util__arg_loc_to_register(RegNum, Lval),
+ ( Lval = reg(RegType, N) ->
+ llds_out__reg_to_string(RegType, N, RegName)
+ ;
+ error("get_reg_name: lval is not a register")
+ ).
% 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(string, list(pragma_var), list(type), string).
-:- mode generate_fact_test_code(in, in, in, out) is det.
+:- pred generate_fact_test_code(string, list(pragma_var), list(type),
+ module_info, int, string).
+:- mode generate_fact_test_code(in, in, in, in, in, out) is det.
-generate_fact_test_code(PredName, PragmaVars, ArgTypes, FactTestCode) :-
+generate_fact_test_code(PredName, PragmaVars, ArgTypes, ModuleInfo,
+ FactTableSize, FactTestCode) :-
string__append_list(["mercury__", PredName, "_fact_table"],
FactTableName),
- generate_test_condition_code(FactTableName, PragmaVars, ArgTypes, 1,
- yes, CondCode),
+ generate_test_condition_code(FactTableName, PragmaVars, ArgTypes,
+ ModuleInfo, 1, yes, FactTableSize, CondCode),
string__append_list(["\t\tif(", CondCode, "\t\t) fail();\n"],
FactTestCode).
-:- pred generate_test_condition_code(string, list(pragma_var), list(type), int,
- bool, string).
-:- mode generate_test_condition_code(in, in, in, in, in, out) is det.
+:- pred generate_test_condition_code(string, list(pragma_var), list(type),
+ module_info, int, bool, int, string).
+:- mode generate_test_condition_code(in, in, in, in, in, in, in, out) is det.
-generate_test_condition_code(_, [], [], _, _, "").
-generate_test_condition_code(_, [_|_], [], _, _, "") :-
+generate_test_condition_code(_, [], [], _, _, _, _, "").
+generate_test_condition_code(_, [_|_], [], _, _, _, _, "") :-
error("generate_test_condition_code: too many PragmaVars").
-generate_test_condition_code(_, [], [_|_], _, _, "") :-
+generate_test_condition_code(_, [], [_|_], _, _, _, _, "") :-
error("generate_test_condition_code: too many ArgTypes").
generate_test_condition_code(FactTableName, [PragmaVar|PragmaVars],
- [Type|Types], ArgNum, IsFirstInputArg0, CondCode) :-
+ [Type|Types], ModuleInfo, ArgNum, IsFirstInputArg0,
+ FactTableSize, CondCode) :-
PragmaVar = pragma_var(_, Name, Mode),
- (
- Mode = user_defined_mode(qualified("mercury_builtin", "in"), [])
- ->
+ ( mode_is_input(ModuleInfo, Mode) ->
(
Type = term__functor(term__atom("string"), [], _)
->
- Template = "strdiff(%s[ind/%d][ind%%%d].V_%d, %s)\n"
+ Template = "strcmp(%s[ind/%d][ind%%%d].V_%d, %s) != 0\n"
;
Template = "%s[ind/%d][ind%%%d].V_%d != %s\n"
),
- fact_table_size(FactTableSize),
string__format(Template, [s(FactTableName), i(FactTableSize),
i(FactTableSize), i(ArgNum), s(Name)], CondCode0),
(
@@ -3298,7 +3273,8 @@
),
NextArgNum is ArgNum + 1,
generate_test_condition_code(FactTableName, PragmaVars, Types,
- NextArgNum, IsFirstInputArg, CondCode2),
+ ModuleInfo, NextArgNum, IsFirstInputArg, FactTableSize,
+ CondCode2),
string__append(CondCode1, CondCode2, CondCode).
@@ -3306,40 +3282,15 @@
% XXX this should change to use the new model_non pragma c_code when
% it has been implemented.
-:- pred generate_secondary_nondet_code(sym_name, list(pragma_var), proc_id,
- list(type), args_method, string, string).
-:- mode generate_secondary_nondet_code(in, in, in, in, in, out, out) is det.
+:- pred generate_secondary_nondet_code(string, list(pragma_var), proc_id,
+ list(type), args_method, module_info, int, string, string).
+:- mode generate_secondary_nondet_code(in, in, in, in, in, in, in, out, out)
+ is det.
generate_secondary_nondet_code(PredName, PragmaVars, ProcID, ArgTypes,
- ArgsMethod, ProcCode, ExtraCode) :-
-
- 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.
- */
-
- maxfr = curprevfr;
- curfr = cursuccfr;
- {
- Declare_entry(%s);
- GOTO(ENTRY(%s));
- }
- ",
-
- (
- PredName = unqualified(Name)
- ;
- PredName = qualified(_, Name)
- ),
- list__length(PragmaVars, Arity),
- string__format("mercury__%s_%d_%d_xx", [s(Name), i(Arity), i(ProcID)],
- ExtraCodeLabel),
- pragma_vars_to_names_string(PragmaVars, NamesString),
- string__format(ProcCodeTemplate, [s(NamesString), s(ExtraCodeLabel),
- s(ExtraCodeLabel)], ProcCode),
+ ArgsMethod, ModuleInfo, FactTableSize, ProcCode, ExtraCode) :-
+ generate_nondet_proc_code(PragmaVars, PredName, ProcID, ExtraCodeLabel,
+ ProcCode),
ExtraCodeTemplate = "
@@ -3355,25 +3306,14 @@
{
/* create argument vars */
%s
- Integer hashval, hashsize;
- Word ind;
- int keyfound;
- void *current_table;
- char keytype;
- Word current_key;
-
+ /* declare local variables */
+%s
/* copy registers to input arg vars */
%s
-
- /* initialise current_table to the top level hash table
- * for this ProcID
- */
- current_table =
- (void *)&mercury__%s_fact_table_hash_table_%d_0;
-
/* lookup hash table */
%s
success_code_%s:
+ ind = FACT_TABLE_HASH_INDEX(ind);
/* lookup fact table */
%s
/* save output args to registers */
@@ -3382,7 +3322,7 @@
framevar(0) = hashval;
framevar(1) = (Word) current_table;
framevar(2) = (Word) keytype;
- framevar(3) = current_key; /* save current key to framevar(3) */
+ framevar(3) = current_key;
succeed();
failure_code_%s:
fail();
@@ -3393,7 +3333,6 @@
%s
Integer hashval = framevar(0);
Word ind;
- int keyfound;
void *current_table = (void *)framevar(1);
char keytype = (char) framevar(2);
@@ -3413,6 +3352,7 @@
fatal_error(""fact table hash lookup: nondet stack corrupted?"");
}
success_code_%s:
+ ind = FACT_TABLE_HASH_INDEX(ind);
/* lookup fact table */
%s
/* save output args to registers */
@@ -3425,12 +3365,13 @@
}
END_MODULE
+extern ModuleFunc %s_module;
+
/*
INIT sys_init_%s_module
*/
void sys_init_%s_module(void);
void sys_init_%s_module(void) {
- extern ModuleFunc %s_module;
%s_module();
}
@@ -3437,19 +3378,23 @@
",
generate_argument_vars_code(PragmaVars, ArgTypes, ArgsMethod,
- DeclCode, InputCode, OutputCode, _SaveRegsCode, _GetRegsCode,
- _NumFrameVars),
- string__format("%s_%d", [s(Name), i(ProcID)], LabelName),
+ ModuleInfo, ArgDeclCode, InputCode, OutputCode, _SaveRegsCode,
+ _GetRegsCode, _NumFrameVars),
+ generate_decl_code(PredName, ProcID, DeclCode),
+ string__format("%s_%d", [s(PredName), i(ProcID)], LabelName),
string__append(LabelName, "_2", LabelName2),
- generate_hash_code(PragmaVars, ArgTypes, LabelName, HashCode),
+ generate_hash_code(PragmaVars, ArgTypes, ModuleInfo, LabelName, 0,
+ HashCode),
- generate_hash_lookup_code("(char *)framevar(3)", LabelName2,
- "streq(%s, %s)", 's', StringHashLookupCode),
- generate_hash_lookup_code("framevar(3)", LabelName2, "%s == %s",
+ generate_hash_lookup_code("(char *)framevar(3)", LabelName2, 0,
+ "strcmp(%s, %s) == 0", 's', StringHashLookupCode),
+ generate_hash_lookup_code("framevar(3)", LabelName2, 1, "%s == %s",
'i', IntHashLookupCode),
- generate_hash_lookup_code("word_to_float(framevar(3))", LabelName2,
+ generate_hash_lookup_code("word_to_float(framevar(3))", LabelName2, 2,
"%s == %s", 'f', FloatHashLookupCode),
- generate_fact_lookup_code(Name, PragmaVars, 1, FactLookupCode),
+ generate_fact_lookup_code(PredName, PragmaVars, ModuleInfo, 1,
+ FactTableSize, FactLookupCode),
+ list__length(PragmaVars, Arity),
string__format(ExtraCodeTemplate, [
s(ExtraCodeLabel),
@@ -3458,13 +3403,12 @@
s(ExtraCodeLabel),
s(ExtraCodeLabel),
s(ExtraCodeLabel),
- s(Name),
+ s(PredName),
i(Arity),
s(ExtraCodeLabel),
+ s(ArgDeclCode),
s(DeclCode),
s(InputCode),
- s(Name),
- i(ProcID),
s(HashCode),
s(LabelName),
s(FactLookupCode),
@@ -3471,7 +3415,7 @@
s(OutputCode),
s(LabelName),
s(ExtraCodeLabel),
- s(DeclCode),
+ s(ArgDeclCode),
s(StringHashLookupCode),
s(IntHashLookupCode),
s(FloatHashLookupCode),
Index: compiler/llds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds_out.m,v
retrieving revision 1.37
diff -u -r1.37 llds_out.m
--- llds_out.m 1997/02/17 03:47:32 1.37
+++ llds_out.m 1997/02/21 05:07:57
@@ -31,6 +31,9 @@
:- pred llds_out__lval_to_string(lval, string).
:- mode llds_out__lval_to_string(in, out) is semidet.
+:- pred llds_out__reg_to_string(reg_type, int, string).
+:- mode llds_out__reg_to_string(in, in, out) is det.
+
:- pred llds_out__binary_op_to_string(binary_op, string).
:- mode llds_out__binary_op_to_string(in, out) is det.
@@ -65,6 +68,9 @@
:- pred llds_out__maybe_qualify_name(string, string, string).
:- mode llds_out__maybe_qualify_name(in, in, out) is det.
+:- pred output_c_quoted_string(string, io__state, io__state).
+:- mode output_c_quoted_string(in, di, uo) is det.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -2216,16 +2222,9 @@
:- pred output_reg(reg_type, int, io__state, io__state).
:- mode output_reg(in, in, di, uo) is det.
- % this code ought to be harmonised with llds_out__reg_to_string
output_reg(r, N) -->
- ( { N > 32 } ->
- io__write_string("r("),
- io__write_int(N),
- io__write_string(")")
- ;
- io__write_string("r"),
- io__write_int(N)
- ).
+ { llds_out__reg_to_string(r, N, RegName) },
+ io__write_string(RegName).
output_reg(f, _) -->
{ error("Floating point registers not implemented") }.
@@ -2682,9 +2681,6 @@
%-----------------------------------------------------------------------------%
-:- pred output_c_quoted_string(string, io__state, io__state).
-:- mode output_c_quoted_string(in, di, uo) is det.
-
output_c_quoted_string(S0) -->
( { string__first_char(S0, Char, S1) } ->
( { quote_c_char(Char, QuoteChar) } ->
@@ -2825,14 +2821,13 @@
string__append("reg(", Reg_String, Tmp),
string__append(Tmp, ")", Description).
-:- pred llds_out__reg_to_string(reg_type, int, string).
-:- mode llds_out__reg_to_string(in, in, out) is det.
-
- % this code ought to be harmonised with output_reg
llds_out__reg_to_string(r, N, Description) :-
- string__int_to_string(N, N_String),
- string__append("r(", N_String, Tmp),
- string__append(Tmp, ")", Description).
+ ( N > 32 ->
+ Template = "r(%d)"
+ ;
+ Template = "r%d"
+ ),
+ string__format(Template, [i(N)], Description).
llds_out__reg_to_string(f, N, Description) :-
string__int_to_string(N, N_String),
string__append("f(", N_String, Tmp),
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.221
diff -u -r1.221 make_hlds.m
--- make_hlds.m 1997/02/20 03:04:21 1.221
+++ make_hlds.m 1997/02/21 00:38:39
@@ -3277,11 +3277,13 @@
% compile the fact table into a separate .o file
fact_table_compile_facts(Pred, Arity, FileName,
- PredInfo0, PredInfo, Context),
+ PredInfo0, PredInfo, Context, Module0, C_HeaderCode,
+ PrimaryProcID),
{module_info_set_pred_info(Module0, PredID, PredInfo, Module1)},
{ pred_info_procedures(PredInfo, ProcTable) },
{ pred_info_procids(PredInfo, ProcIDs) },
+ { pred_info_arg_types(PredInfo, _, ArgTypes) },
{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
{
PredOrFunc = predicate,
@@ -3291,10 +3293,21 @@
NumArgs is Arity + 1
},
- % create some pragma c_code to access table in each mode
- module_add_fact_table_procedures(ProcIDs, ProcTable, Pred,
- PredOrFunc, NumArgs, Status, Context,
- Module1, Module, Info0, Info)
+ % create pragma c_header_code to declare extern variables
+ { module_add_c_header(C_HeaderCode, Context, Module1, Module2)},
+
+ io__get_exit_status(ExitStatus),
+ (
+ { ExitStatus = 1 }
+ ->
+ { Module = Module2 },
+ { Info = Info0 }
+ ;
+ % create some pragma c_code to access table in each mode
+ module_add_fact_table_procedures(ProcIDs, PrimaryProcID,
+ ProcTable, Pred, PredOrFunc, NumArgs, ArgTypes,
+ Status, Context, Module2, Module, Info0, Info)
+ )
;
{ PredIDs1 = [_ | _] }, % >1 predicate found
io__set_exit_status(1),
@@ -3320,40 +3333,55 @@
% `pragma fact_table's are represented in the HLDS by a
% `pragma c_code' for each mode of the predicate.
-:- pred module_add_fact_table_procedures(list(proc_id), proc_table, sym_name,
- pred_or_func, arity, import_status, term__context, module_info,
- module_info, qual_info, qual_info, io__state, io__state).
-:- mode module_add_fact_table_procedures(in, in, in, in, in, in, in, in, out,
- in, out, di, uo) is det.
-
-module_add_fact_table_procedures([],_,_,_,_,_,_, Mod, Mod, Inf, Inf) --> [].
-module_add_fact_table_procedures([ProcID | ProcIDs], ProcTable, SymName,
- PredOrFunc, Arity, Status, Context,
+:- pred module_add_fact_table_procedures(list(proc_id), proc_id, proc_table,
+ sym_name, pred_or_func, arity, list(type), import_status,
+ term__context, module_info, module_info, qual_info, qual_info,
+ io__state, io__state).
+:- mode module_add_fact_table_procedures(in, in, in, in, in, in, in, in,
+ in, in, out, in, out, di, uo) is det.
+
+module_add_fact_table_procedures([],_,_,_,_,_,_,_,_,Mod,Mod,Inf,Inf) --> [].
+module_add_fact_table_procedures([ProcID | ProcIDs], PrimaryProcID, ProcTable,
+ SymName, PredOrFunc, Arity, ArgTypes, Status, Context,
Module0, Module, Info0, Info) -->
- module_add_fact_table_proc(ProcID, ProcTable, SymName, PredOrFunc,
- Arity, Status, Context, Module0, Module1, Info0, Info1),
- module_add_fact_table_procedures(ProcIDs, ProcTable, SymName,
- PredOrFunc, Arity, Status, Context,
+ module_add_fact_table_proc(ProcID, PrimaryProcID, ProcTable, SymName,
+ PredOrFunc, Arity, ArgTypes, Status, Context,
+ Module0, Module1, Info0, Info1),
+ module_add_fact_table_procedures(ProcIDs, PrimaryProcID, ProcTable,
+ SymName, PredOrFunc, Arity, ArgTypes, Status, Context,
Module1, Module, Info1, Info).
-:- pred module_add_fact_table_proc(proc_id, proc_table, sym_name, pred_or_func,
- arity, import_status, term__context, module_info, module_info,
- qual_info, qual_info, io__state, io__state).
-:- mode module_add_fact_table_proc(in, in, in, in, in, in, in, in, out,
- in, out, di, uo) is det.
+:- pred module_add_fact_table_proc(proc_id, proc_id, proc_table, sym_name,
+ pred_or_func, arity, list(type), import_status,
+ term__context, module_info, module_info, qual_info, qual_info,
+ io__state, io__state).
+:- mode module_add_fact_table_proc(in, in, in, in, in, in, in, in, in, in,
+ out, in, out, di, uo) is det.
-module_add_fact_table_proc(ProcID, ProcTable, SymName, PredOrFunc, Arity,
- Status, Context, Module0, Module, Info0, Info) -->
+module_add_fact_table_proc(ProcID, PrimaryProcID, ProcTable, SymName,
+ PredOrFunc, Arity, ArgTypes, Status, Context,
+ Module0, Module, Info0, Info) -->
{ map__lookup(ProcTable, ProcID, ProcInfo) },
{ varset__init(VarSet0) },
{ varset__new_vars(VarSet0, Arity, Vars, VarSet) },
{ proc_info_argmodes(ProcInfo, Modes) },
{ fact_table_pragma_vars(Vars, Modes, VarSet, PragmaVars) },
- { fact_table_generate_c_code(SymName, PragmaVars, C_Code) },
+ globals__io_get_args_method(ArgsMethod),
+ fact_table_generate_c_code(SymName, PragmaVars, ProcID, PrimaryProcID,
+ ProcInfo, ArgTypes, ArgsMethod, Module0,
+ C_ProcCode, C_ExtraCode),
+
% XXX this should be modified to use the new type of pragma_c.
- module_add_pragma_c_code(will_not_call_mercury, SymName, PredOrFunc,
- PragmaVars, VarSet, C_Code, Status, Context, no,
- Module0, Module, Info0, Info).
+ module_add_pragma_c_code(will_not_call_mercury, SymName, PredOrFunc,
+ PragmaVars, VarSet, C_ProcCode, Status, Context, no,
+ Module0, Module1, Info0, Info),
+ {
+ C_ExtraCode = ""
+ ->
+ Module = Module1
+ ;
+ module_add_c_body_code(C_ExtraCode, Context, Module1, Module)
+ }.
% Create a list(pragma_var) that looks like the ones that are created
% for pragma c_code in prog_io.m.
Index: compiler/modules.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modules.m,v
retrieving revision 1.30
diff -u -r1.30 modules.m
--- modules.m 1997/02/16 23:48:59 1.30
+++ modules.m 1997/02/20 00:17:09
@@ -398,6 +398,16 @@
{ list__delete_all(ShortDeps2, ModuleName, ShortDeps) },
{ list__sort_and_remove_dups(FactDeps0, FactDeps) },
+ ( { FactDeps \= [] } ->
+ io__write_strings(DepStream,
+ [ModuleName, ".fact_tables = "]),
+ write_dependencies_list(FactDeps, "", DepStream),
+ io__write_string(DepStream, "\n\n")
+ ;
+ []
+ ),
+
+
io__write_strings(DepStream, [
ModuleName, ".optdate ",
ModuleName, ".c ",
@@ -407,7 +417,18 @@
] ),
write_dependencies_list(LongDeps, ".int", DepStream),
write_dependencies_list(ShortDeps, ".int2", DepStream),
- write_dependencies_list(FactDeps, "", DepStream),
+
+ ( { FactDeps \= [] } ->
+ io__write_strings(DepStream, [
+ " \\\n\t$(", ModuleName, ".fact_tables)\n\n",
+ "$(", ModuleName, ".fact_tables:%=%.o) : $(",
+ ModuleName, ".fact_tables)\n\n",
+ "$(", ModuleName, ".fact_tables:%=%.c) : ",
+ ModuleName, ".o\n"
+ ] )
+ ;
+ []
+ ),
globals__io_lookup_bool_option(intermodule_optimization,
Intermod),
@@ -448,17 +469,6 @@
"\trm -rf ", ModuleName, ".dir\n",
"\t$(MCS) -s$(GRADE) $(MCSFLAGS) ", ModuleName, ".m\n"
]),
-
- ( { FactDeps = [_|_] } ->
- { Lambda = lambda([S0::in, S::out] is det,
- string__append(S0, ".c ", S)) },
- { list__map(Lambda, FactDeps, Fact_C_Files) },
- io__nl,
- io__write_strings(DepStream, Fact_C_Files),
- io__write_strings(DepStream, [": ",ModuleName,".o\n"])
- ;
- []
- ),
io__close_output(DepStream),
maybe_write_string(Verbose, " done.\n")
Index: compiler/options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/options.m,v
retrieving revision 1.189
diff -u -r1.189 options.m
--- options.m 1997/02/12 04:53:54 1.189
+++ options.m 1997/02/18 04:25:44
@@ -134,6 +134,15 @@
; cflags_for_gotos
; c_include_directory
; aditi
+ ; fact_table_max_array_size
+ % maximum number of elements in a single
+ % fact table data array
+
+ ; fact_table_hash_percent_full
+ % how full the fact table hash tables should
+ % be allowed to get, given as an integer
+ % percentage.
+
% Optimization Options
; opt_level
; opt_space % default is to optimize time
@@ -366,7 +375,9 @@
% the `mc' script will override the
% above default with a value determined
% at configuration time
- aditi - bool(no)
+ aditi - bool(no),
+ fact_table_max_array_size - int(1024),
+ fact_table_hash_percent_full - int(90)
]).
option_defaults_2(special_optimization_option, [
% Special optimization options.
@@ -614,6 +625,9 @@
long_option("cflags-for-regs", cflags_for_regs).
long_option("cflags-for-gotos", cflags_for_gotos).
long_option("c-include-directory", c_include_directory).
+long_option("fact-table-max-array-size",fact_table_max_array_size).
+long_option("fact-table-hash-percent-full",
+ fact_table_hash_percent_full).
% optimization options
More information about the developers
mailing list