[m-dev.] Re: pragma fact_table
David Matthew OVERTON
dmo at students.cs.mu.oz.au
Wed Feb 26 15:27:03 AEDT 1997
Hi Fergus,
Here are the changes you requested in your last review. Of course I
won't commit them until the `float__hash' changes have been approved
and committed.
Test cases and user documentation are coming soon...
David
Estimated hours taken: 250
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/export.m:
Moved declarations for `convert_type_from_mercury/3' and
`convert_type_to_mercury/3' to the interface so they can be
used by `fact_table.m'.
compiler/handle_options.m:
Add a check to `postprocess_options' to ensure that arguments
to `--fact-table-hash-percent-full' are integers in the range
1 to 100.
compiler/inlining.m:
Stop `model_non' `pragma c_code' being inlined unless it hash
the new `extra_pragma_info' field (which hasn't been fully
implemented yet). This ensures that code such as the lookup
code generated for nondet and multidet modes of `pragma
fact_table's works with inlining turned on.
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/mode_util.m:
Added two new predicates:
`mode_is_fully_input' which is true iff the initial
inst of the mode is ground.
`mode_is_fully_output' which is true iff the inital inst is
free and the final inst is ground.
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).
Documentation for these options has been added to the usage
message but is commented out at the moment.
--- ../../bak/fact_table.m Mon Feb 24 10:43:28 1997
+++ ./fact_table.m Wed Feb 26 14:58:11 1997
@@ -40,13 +40,11 @@
% 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.
+% XXX Cross compilation is not supported for fact tables that are indexed on
+% floats.
+
:- module fact_table.
:- interface.
@@ -78,17 +76,13 @@
% 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,
+ proc_id, proc_info, list(type), module_info, string, string,
+ io__state, io__state).
+:- mode fact_table_generate_c_code(in, in, in, in, in, in, in, out, out,
di, uo) is det.
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
:- implementation.
@@ -96,7 +90,7 @@
:- 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.
+:- import_module code_util, export.
:- type fact_result
---> ok ; error.
@@ -171,14 +165,10 @@
:- 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")
- }.
+ globals__io_lookup_int_option(fact_table_max_array_size,
+ FactTableSize).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
fact_table_compile_facts(PredName, Arity, FileName, PredInfo0, PredInfo,
Context, ModuleInfo, C_HeaderCode, PrimaryProcID) -->
@@ -194,8 +184,8 @@
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),
+ write_fact_table_header(PredName, PredInfo1, FileName,
+ FactArgInfos, OutputStream, C_HeaderCode0, StructName, Result2),
(
{ Result2 = ok },
open_sort_files(CheckProcs, ProcStreams),
@@ -236,7 +226,7 @@
ProcTable, ModuleInfo, NumFacts, FactArgInfos,
WriteHashTables, WriteDataAfterSorting, OutputStream,
C_HeaderCode1, PrimaryProcID),
- write_fact_table_numfacts(PredInfo, NumFacts, OutputStream,
+ write_fact_table_numfacts(PredName, NumFacts, OutputStream,
C_HeaderCode3),
{ string__append_list([C_HeaderCode0, C_HeaderCode1,
C_HeaderCode2, C_HeaderCode3], C_HeaderCode) }
@@ -287,7 +277,7 @@
{ PrimaryProcID = -1 }
).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
% read in facts one by one and check and compile them
:- pred compile_facts(sym_name, arity, pred_info, module_info,
@@ -313,8 +303,9 @@
{ Result0 = term(_VarSet, Term) },
fact_table_size(FactTableSize),
( { 0 is NumFacts0 mod FactTableSize } ->
- globals__io_lookup_bool_option(very_verbose, Verbose),
- ( { Verbose = yes } ->
+ globals__io_lookup_bool_option(very_verbose,
+ VeryVerbose),
+ ( { VeryVerbose = yes } ->
io__format("%% Read fact %d\n", [i(NumFacts0)])
;
[]
@@ -451,8 +442,8 @@
di, uo) is det.
check_fact_type_and_mode(_, [], _, _, _, ok) --> [].
-check_fact_type_and_mode(Types0, [Term | Terms], ArgNum0, PredOrFunc, Context0,
- Result) -->
+check_fact_type_and_mode(Types0, [Term | Terms], ArgNum0, PredOrFunc,
+ Context0, Result) -->
{ ArgNum is ArgNum0 + 1 },
(
{ Term = term__variable(_) },
@@ -538,15 +529,16 @@
),
io__set_exit_status(1).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
-:- pred write_fact_table_header(pred_info, string, list(fact_arg_info),
- io__output_stream, string, string, fact_result,
- io__state, io__state).
-:- mode write_fact_table_header(in, in, in, in, out, out, out, di, uo) is det.
+:- pred write_fact_table_header(sym_name, pred_info, string,
+ list(fact_arg_info), io__output_stream, string, string,
+ fact_result, io__state, io__state).
+:- mode write_fact_table_header(in, in, in, in, in, out, out, out,
+ di, uo) is det.
-write_fact_table_header(PredInfo, FileName, FactArgInfos, OutputStream,
- C_HeaderCode, StructName, Result) -->
+write_fact_table_header(PredName, PredInfo, FileName, FactArgInfos,
+ OutputStream, C_HeaderCode, StructName, Result) -->
{ library__version(Version) },
io__write_strings(OutputStream,
["/*\n** Automatically generated from `", FileName,
@@ -554,9 +546,8 @@
". Do not edit.\n*/\n\n"]),
io__write_string(OutputStream, "#include ""imp.h""\n\n"),
- { pred_info_name(PredInfo, Name) },
- { llds_out__name_mangle(Name, MangledName) },
- { string__append_list(["mercury__", MangledName, "_fact_table"],
+ { make_fact_table_identifier(PredName, Identifier) },
+ { string__append_list(["mercury__", Identifier, "_fact_table"],
StructName) },
% Define a struct for a fact table entry.
@@ -595,7 +586,7 @@
/* hash table for string keys */
struct fact_table_hash_entry_s {
ConstString key; /* lookup key */
- Word index; /* index into fact table data array */
+ const 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*/
@@ -608,7 +599,7 @@
/* hash table for float keys */
struct fact_table_hash_entry_f {
Float key;
- Word index;
+ const Word *index;
#if TAGBITS < 2
short type;
#endif
@@ -618,7 +609,7 @@
/* hash table for int keys */
struct fact_table_hash_entry_i {
Integer key;
- Word index;
+ const Word *index;
#if TAGBITS < 2
short type;
#endif
@@ -627,17 +618,17 @@
#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))
+ #define FACT_TABLE_MAKE_TAGGED_INDEX(i,t) mkword(mktag(t), mkbody(i))
+ #define FACT_TABLE_MAKE_TAGGED_POINTER(p,t) mkword(mktag(t), p)
+ #define FACT_TABLE_HASH_ENTRY_TYPE(p) tag((Word)((p).index))
+ #define FACT_TABLE_HASH_INDEX(w) unmkbody(w)
+ #define FACT_TABLE_HASH_POINTER(w) body(w,tag(w))
#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)
+ #define FACT_TABLE_MAKE_TAGGED_INDEX(i,t) ((const Word *) i), (t)
+ #define FACT_TABLE_MAKE_TAGGED_POINTER(p,t) ((const 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 */
@@ -644,9 +635,7 @@
" },
io__write_string(OutputStream, HashDef),
- { string__append_list([
- "#include <math.h>\n\n", % math.h needed for hashing floats
- StructDef, HashDef ], C_HeaderCode) }.
+ { string__append_list([ StructDef, HashDef ], C_HeaderCode) }.
% Create a struct for the fact table consisting of any arguments
% that are output in some mode.
@@ -720,7 +709,7 @@
{ StructContents = "" }
).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
% Initialise list of fact argument information.
% Input and output flags are initialised to `no' and filled in
% correctly by infer_determinism_pass_1.
@@ -744,7 +733,7 @@
fill_in_fact_arg_infos([Mode | Modes], ModuleInfo, [Info0 | Infos0],
[Info | Infos]) :-
Info0 = fact_arg_info(Type, IsInput, _IsOutput),
- ( mode_is_input(ModuleInfo, Mode) ->
+ ( mode_is_fully_input(ModuleInfo, Mode) ->
% XXX Info = fact_arg_info(Type, yes, IsOutput)
% XXX currently the first input mode requires _all_ arguments to
@@ -753,7 +742,7 @@
% efficient than doing these lookups via the hash table.
Info = fact_arg_info(Type, yes, yes)
- ; mode_is_output(ModuleInfo, Mode) ->
+ ; mode_is_fully_output(ModuleInfo, Mode) ->
Info = fact_arg_info(Type, IsInput, yes)
;
% this is a mode error that will be reported by
@@ -763,7 +752,7 @@
fill_in_fact_arg_infos(Modes, ModuleInfo, Infos0, Infos).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
% First pass of determinism inference.
% (out, out, ..., out) procs are multidet and (in, in, .., in) procs are
@@ -910,9 +899,9 @@
fact_table_mode_type([], _, unknown).
fact_table_mode_type([Mode | Modes], ModuleInfo, ModeType) :-
- ( mode_is_input(ModuleInfo, Mode) ->
+ ( mode_is_fully_input(ModuleInfo, Mode) ->
ModeType0 = all_in
- ; mode_is_output(ModuleInfo, Mode) ->
+ ; mode_is_fully_output(ModuleInfo, Mode) ->
ModeType0 = all_out
;
ModeType0 = other
@@ -932,7 +921,7 @@
)
).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
% open_sort_files(ProcIDs, ProcStreams)
% Open a temporary sort file for each proc_id in ProcIDs.
@@ -995,7 +984,7 @@
write_sort_file_lines(ProcStreams, ProcTable, Terms, ModuleInfo,
FactNumStr, [],no).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
% Create a key for the fact table entry.
% Arguments are separated by ":".
@@ -1012,7 +1001,7 @@
make_sort_file_key([], _, "").
make_sort_file_key([(Mode - Term) | ModeTerms], ModuleInfo, Key) :-
(
- mode_is_input(ModuleInfo, Mode),
+ mode_is_fully_input(ModuleInfo, Mode),
Term = term__functor(Const, [], _Context)
->
make_key_part(Const, KeyPart),
@@ -1091,7 +1080,7 @@
),
key_from_chars_2(Cs, ECs1, ECs).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
% infer_determinism_pass_2(ProcStreams, ProcFiles,
% ProcTable0, ProcTable),
@@ -1099,8 +1088,9 @@
% unique. If they are, the procedure is semidet, otherwise it is
% nondet. Return a list of (proc_id, filename) pairs and the updated
% proc_table.
-:- pred infer_determinism_pass_2(list(proc_stream), assoc_list(proc_id, string),
- bool, proc_table, proc_table, io__state, io__state).
+:- pred infer_determinism_pass_2(list(proc_stream),
+ assoc_list(proc_id, string), bool, proc_table, proc_table,
+ io__state, io__state).
:- mode infer_determinism_pass_2(in, out, in, in, out, di, uo) is det.
infer_determinism_pass_2([], [], _, ProcTable, ProcTable) --> [].
@@ -1152,8 +1142,10 @@
Determinism = nondet
}
;
+ io__progname_base("mercury_compile", ProgName),
io__write_strings([
- "An error occurred in the `sort' program\n",
+ ProgName,
+ ": an error occurred in the `sort' program\n",
" during fact table determinism inference.\n"
]),
io__set_exit_status(1),
@@ -1162,8 +1154,10 @@
;
{ Result = error(ErrorCode) },
{ io__error_message(ErrorCode, ErrorMessage) },
+ io__progname_base("mercury_compile", ProgName),
io__write_strings([
- "Error executing system command `sort':\n ",
+ ProgName,
+ ": error executing system command `sort':\n ",
ErrorMessage,
".\n" ]),
io__set_exit_status(1),
@@ -1175,7 +1169,7 @@
infer_determinism_pass_2(ProcStreams, ProcFiles, ExistsAllInMode,
ProcTable1, ProcTable).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
% write out the fact table data arrays and hash tables
:- pred write_fact_table_arrays(assoc_list(proc_id, string), string, string,
@@ -1258,8 +1252,8 @@
write_new_data_array(OutputStream,
StructName, FactNum)
),
- globals__io_lookup_bool_option(very_verbose, Verbose),
- ( { Verbose = yes } ->
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose),
+ ( { VeryVerbose = yes } ->
io__format("%% Writing fact %d\n", [i(FactNum)])
;
[]
@@ -1271,13 +1265,6 @@
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).
@@ -1287,6 +1274,12 @@
io__format(OutputStream, "struct %s_struct %s%d[] = {\n",
[s(StructName), s(StructName), i(FactNum)]).
+ % 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").
:- pred write_fact_args(list(fact_arg), io__output_stream,
io__state, io__state).
@@ -1343,8 +1336,10 @@
;
{ Result = error(ErrorCode) },
{ io__error_message(ErrorCode, ErrorMessage) },
+ io__progname_base("mercury_compile", ProgName),
io__write_strings([
- "Error executing system command `cat':\n ",
+ ProgName,
+ ": error executing system command `cat':\n ",
ErrorMessage,
".\n" ]),
io__set_exit_status(1)
@@ -1459,8 +1454,8 @@
:- pred write_secondary_hash_tables(assoc_list(proc_id, string), string,
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, in, out, di, uo)
- is det.
+:- 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)
--> [].
@@ -1540,12 +1535,12 @@
% 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), 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, in,
- out, di, uo) is det.
+:- 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,
+ in, out, di, uo) is det.
build_hash_table(FactNum, InputArgNum, HashTableName, StructName, TableNum,
ArgModes, ModuleInfo, Infos, IsPrimaryTable, OutputStream,
@@ -1732,10 +1727,10 @@
{ MatchingFacts = [Fact | MatchingFacts1] }.
-:- 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), module_info,
- io__state, io__state).
+:- 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),
+ module_info, io__state, io__state).
:- mode top_level_collect_matching_facts_2(in, in, out, out, in, in, in,
di, uo) is det.
@@ -1770,8 +1765,9 @@
% Same as above, but reads facts from a list instead of from the
% sort file.
-:- pred lower_level_collect_matching_facts(sort_file_line, list(sort_file_line),
- list(sort_file_line), list(sort_file_line), int).
+:- pred lower_level_collect_matching_facts(sort_file_line,
+ list(sort_file_line), list(sort_file_line),
+ list(sort_file_line), int).
:- mode lower_level_collect_matching_facts(in, in, out, out, in) is det.
lower_level_collect_matching_facts(Fact, Facts0, Matching, Remaining,
@@ -1819,7 +1815,7 @@
NextFactNum is FactNum + 1,
update_fact_map(NextFactNum, Facts, FactMap1, FactMap).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
% Break up a string into the components of a sort file line
:- pred split_sort_file_line(list(fact_arg_info), list(mode), module_info,
@@ -1891,7 +1887,7 @@
error("get_input_args_list: too many argmodes").
get_input_args_list([Info | Infos], [Mode | Modes], ModuleInfo, ArgStrings0,
Args) :-
- ( mode_is_input(ModuleInfo, Mode) ->
+ ( mode_is_fully_input(ModuleInfo, Mode) ->
(
ArgStrings0 = [ArgString | ArgStrings],
Info = fact_arg_info(Type, _, _),
@@ -1908,7 +1904,8 @@
get_input_args_list(Infos, Modes, ModuleInfo, ArgStrings0, Args)
).
-:- pred get_output_args_list(list(fact_arg_info), list(string), list(fact_arg)).
+:- pred get_output_args_list(list(fact_arg_info), list(string),
+ list(fact_arg)).
:- mode get_output_args_list(in, in, out) is det.
get_output_args_list([], _, []).
@@ -2012,7 +2009,7 @@
).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
% Select a prime number > NumEntries * 100 / PercentFull
% The prime number is selected from a list of primes each of which is
@@ -2021,22 +2018,15 @@
:- 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")
- }.
+ globals__io_lookup_int_option(fact_table_hash_percent_full,
+ PercentFull),
+ { Primes = [ 2, 3, 5, 11, 17, 37, 67, 131, 257, 521, 1031, 2053,
+ 4099, 8209, 16411, 32771, 65537, 131101, 262147,
+ 524309, 1048627, 2097257, 4194493, 8388949, 16777903,
+ 33555799, 67108879, 134217757, 268435459, 536870923,
+ 1073741827, 2147483647 ] },
+ { N is (NumEntries * 100) // PercentFull },
+ { calculate_hash_table_size_2(N, Primes, HashTableSize) }.
:- pred calculate_hash_table_size_2(int, list(int), int).
:- mode calculate_hash_table_size_2(in, in, out) is det.
@@ -2144,22 +2134,9 @@
->
% 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 * 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 ((2^31)-1)*exp(-1) and (2^31)-1
- Ns = [N1, N2]
+ % representations.
+ float__hash(Float, N),
+ Ns = [N]
;
error("fact_table_hash: unsupported type in key")
),
@@ -2220,7 +2197,7 @@
map__set(Map0, Index, Value, Map),
HashTable = hash_table(Size, Map).
-%------------------------------------------------------------------------------%
+%--------------------------------------------------------------------------%
% write out the C code for a hash table
:- pred write_hash_table(string, int, hash_table, io__output_stream,
@@ -2282,18 +2259,18 @@
(
{ Index = fact(I) },
io__format(
- ", FACT_TABLE_MAKE_TAGGED_INDEX(%d,1), ",
+ ", FACT_TABLE_MAKE_TAGGED_INDEX(%d, 1), ",
[i(I)])
;
{ Index = hash_table(I, H) },
io__format(
- ", FACT_TABLE_MAKE_TAGGED_POINTER(&%s%d,2), ",
+ ", FACT_TABLE_MAKE_TAGGED_POINTER(&%s%d, 2), ",
[s(H), i(I)])
),
io__write_int(Next)
;
io__write_string(
- "0, FACT_TABLE_MAKE_TAGGED_POINTER(0,0), -1 ")
+ "0, FACT_TABLE_MAKE_TAGGED_POINTER(NULL, 0), -1 ")
),
io__write_string("},\n"),
{ NextIndex is CurrIndex + 1 },
@@ -2346,7 +2323,7 @@
get_hash_table_type_2(Map, NextIndex, TableType)
).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
% write out the array of pointers to the fact table arrays.
:- pred write_fact_table_pointer_array(int, string, io__output_stream, string,
@@ -2384,19 +2361,18 @@
).
-:- pred write_fact_table_numfacts(pred_info, int, io__output_stream,
+:- pred write_fact_table_numfacts(sym_name, int, io__output_stream,
string, io__state, io__state).
:- mode write_fact_table_numfacts(in, in, in, out, di, uo) is det.
-write_fact_table_numfacts(PredInfo, NumFacts, OutputStream, C_HeaderCode) -->
+write_fact_table_numfacts(PredName, NumFacts, OutputStream, C_HeaderCode) -->
io__set_output_stream(OutputStream, OldOutputStream),
% Write out the size of the fact table.
- { pred_info_name(PredInfo, Name) },
- { llds_out__name_mangle(Name, MangledName) },
+ { make_fact_table_identifier(PredName, Identifier) },
io__write_strings([
"const Integer mercury__",
- MangledName,
+ Identifier,
"_fact_table_num_facts = "]),
io__write_int(NumFacts),
io__write_string(";\n\n"),
@@ -2404,7 +2380,7 @@
{ string__append_list(
[
"extern const Integer mercury__",
- MangledName,
+ Identifier,
"_fact_table_num_facts;\n"
],
C_HeaderCode) },
@@ -2411,7 +2387,18 @@
io__set_output_stream(OldOutputStream, _).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+:- pred make_fact_table_identifier(sym_name::in, string::out) is det.
+
+make_fact_table_identifier(qualified(ModuleName, PredName), Identifier) :-
+ llds_out__name_mangle(ModuleName, MangledModuleName),
+ llds_out__name_mangle(PredName, MangledPredName),
+ llds_out__maybe_qualify_name(MangledModuleName, MangledPredName,
+ Identifier).
+
+make_fact_table_identifier(unqualified(PredName), Identifier) :-
+ llds_out__name_mangle(PredName, Identifier).
+%---------------------------------------------------------------------------%
% 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.
@@ -2423,8 +2410,10 @@
;
{ Result = error(ErrorCode) },
{ io__error_message(ErrorCode, ErrorMessage) },
+ io__progname_base("mercury_compile", ProgName),
io__write_strings([
- "Error deleting file `",
+ ProgName,
+ ": error deleting file `",
FileName,
"':\n ",
ErrorMessage,
@@ -2432,27 +2421,22 @@
io__set_exit_status(1)
).
-%------------------------------------------------------------------------------%
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
fact_table_generate_c_code(PredName, PragmaVars, ProcID, PrimaryProcID,
- ProcInfo, ArgTypes, ArgsMethod, ModuleInfo, ProcCode,
- ExtraCode) -->
+ ProcInfo, ArgTypes, ModuleInfo, ProcCode, ExtraCode) -->
fact_table_size(FactTableSize),
+ globals__io_get_args_method(ArgsMethod),
{ proc_info_argmodes(ProcInfo, ArgModes) },
- { proc_info_inferred_determinism(ProcInfo, Determinism) },
+ { proc_info_interface_determinism(ProcInfo, Determinism) },
{ fact_table_mode_type(ArgModes, ModuleInfo, ModeType) },
- {
- PredName = unqualified(PredNameString)
- ;
- PredName = qualified(_, PredNameString)
- },
- { llds_out__name_mangle(PredNameString, MangledName) },
+ { make_fact_table_identifier(PredName, Identifier) },
{
ModeType = all_out,
Determinism = multidet
->
- generate_multidet_code(MangledName, PragmaVars, ProcID,
+ generate_multidet_code(Identifier, PragmaVars, ProcID,
ArgTypes, ArgsMethod, ModuleInfo, FactTableSize,
ProcCode, ExtraCode)
;
@@ -2459,13 +2443,13 @@
ModeType = all_out,
Determinism = cc_multidet
->
- generate_cc_multi_code(MangledName, PragmaVars, ProcCode),
+ generate_cc_multi_code(Identifier, PragmaVars, ProcCode),
ExtraCode = ""
;
ModeType = all_in,
Determinism = semidet
->
- generate_all_in_code(MangledName, PragmaVars, ProcID,
+ generate_all_in_code(Identifier, PragmaVars, ProcID,
ArgTypes, ModuleInfo, ProcCode),
ExtraCode = ""
;
@@ -2472,7 +2456,7 @@
ModeType = in_out,
( Determinism = semidet ; Determinism = cc_nondet )
->
- generate_semidet_in_out_code(MangledName, PragmaVars, ProcID,
+ generate_semidet_in_out_code(Identifier, PragmaVars, ProcID,
ArgTypes, ModuleInfo, FactTableSize, ProcCode),
ExtraCode = ""
;
@@ -2480,7 +2464,7 @@
Determinism = nondet,
ProcID = PrimaryProcID
->
- generate_primary_nondet_code(MangledName, PragmaVars,
+ generate_primary_nondet_code(Identifier, PragmaVars,
ProcID, ArgTypes, ArgsMethod, ModuleInfo,
FactTableSize, ProcCode, ExtraCode)
;
@@ -2488,7 +2472,7 @@
Determinism = nondet,
ProcID \= PrimaryProcID
->
- generate_secondary_nondet_code(MangledName, PragmaVars,
+ generate_secondary_nondet_code(Identifier, PragmaVars,
ProcID, ArgTypes, ArgsMethod, ModuleInfo, FactTableSize,
ProcCode, ExtraCode)
;
@@ -2496,7 +2480,7 @@
}.
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
% XXX this should change to use the new model_non pragma c_code when
% it has been implemented.
@@ -2554,7 +2538,7 @@
list__length(PragmaVars, Arity),
generate_argument_vars_code(PragmaVars, ArgTypes, ArgsMethod,
ModuleInfo, ArgDeclCode, _InputCode, OutputCode, _, _, _),
- generate_fact_lookup_code(PredName, PragmaVars, ModuleInfo, 1,
+ generate_fact_lookup_code(PredName, PragmaVars, ArgTypes, ModuleInfo, 1,
FactTableSize, FactLookupCode),
string__format(ExtraCodeTemplate, [
@@ -2588,7 +2572,8 @@
ProcCode) :-
ProcCodeTemplate = "
- /* Mention arguments %s to stop the compiler giving a warning
+ /*
+ ** 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.
@@ -2621,7 +2606,7 @@
pragma_vars_to_names_string(PVars, NamesString0),
string__append_list([Name, ", ", NamesString0], NamesString).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
% for cc_multi output mode, just return the first fact in the table
:- pred generate_cc_multi_code(string, list(pragma_var), string).
@@ -2631,7 +2616,8 @@
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).
+:- pred generate_cc_multi_code_2(list(pragma_var), string, int, string,
+ string).
:- mode generate_cc_multi_code_2(in, in, in, in, out) is det.
generate_cc_multi_code_2([], _, _, ProcCode, ProcCode).
@@ -2644,7 +2630,7 @@
generate_cc_multi_code_2(PragmaVars, StructName, NextArgNum, ProcCode2,
ProcCode).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
% generate semidet code for all_in mode
:- pred generate_all_in_code(string, list(pragma_var), proc_id, list(type),
@@ -2673,7 +2659,7 @@
string__append_list([
"\t{\n", DeclCode, HashCode, SuccessCode, "\t}\n"], ProcCode).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
% Generate code for semidet and cc_nondet in_out modes.
% Lookup key in hash table and if found return first match.
@@ -2697,7 +2683,7 @@
",
string__format(SuccessCodeTemplate, [s(LabelName)], SuccessCode),
- generate_fact_lookup_code(PredName, PragmaVars, ModuleInfo, 1,
+ generate_fact_lookup_code(PredName, PragmaVars, ArgTypes, ModuleInfo, 1,
FactTableSize, FactLookupCode),
FailCodeTemplate = "
@@ -2712,7 +2698,7 @@
string__append_list(["\t{\n", DeclCode, HashCode, SuccessCode,
FactLookupCode, FailCode, "\t}\n"], ProcCode).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
% Some code generation procedures used by various modes.
:- pred generate_decl_code(string::in, proc_id::in, string::out) is det.
@@ -2725,8 +2711,9 @@
char keytype;
Word current_key;
- /* initialise current_table to the top level hash table
- ** for this ProcID
+ /*
+ ** Initialise current_table to the top level hash table
+ ** for this ProcID.
*/
current_table =
&mercury__%s_fact_table_hash_table_%d_0;
@@ -2744,7 +2731,7 @@
generate_hash_code([_|_], [], _, _, _, _) :- error("generate_hash_code").
generate_hash_code([pragma_var(_, Name, Mode)|PragmaVars], [Type | Types],
ModuleInfo, LabelName, LabelNum, C_Code) :-
- ( mode_is_input(ModuleInfo, Mode) ->
+ ( mode_is_fully_input(ModuleInfo, Mode) ->
(
Type = term__functor(term__atom("int"), [], _)
->
@@ -2810,18 +2797,7 @@
hashsize = ((struct fact_table_hash_table_f *)current_table)
->size;
- {
- Float f = %s, g, h;
- if (f <= 0.0) f = -f;
- if (f == 0.0) f = 1e-15;
- h = log(f);
- h = ceil(h);
- g = exp(h);
- g = f / g * 2147483647.0;
- if (h <= 0.0) h = -h;
- hashval = (Integer)g %% hashsize;
- hashval = ((Integer)h + 31*hashval) %% hashsize;
- }
+ hashval = hash_float(%s) %% hashsize;
current_key = float_to_word(%s);
@@ -2883,7 +2859,7 @@
do {
if (FACT_TABLE_HASH_ENTRY_TYPE(%s) != 0 && %s)
{
- ind = %s.index;
+ ind = (Word)%s.index;
goto found_%s_%d;
}
} while ((hashval = %s.next) != -1);
@@ -2911,28 +2887,42 @@
% Generate code to lookup the fact table with a given index
-:- 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(_, [], _, _, _, "").
+:- pred generate_fact_lookup_code(string, list(pragma_var), list(type),
+ module_info, int, int, string).
+:- mode generate_fact_lookup_code(in, in, in, in, in, in, out) is det.
+
+generate_fact_lookup_code(_, [], [], _, _, _, "").
+generate_fact_lookup_code(_, [_|_], [], _, _, _, _) :-
+ error("generate_fact_lookup_code: too many pragma vars").
+generate_fact_lookup_code(_, [], [_|_], _, _, _, _) :-
+ error("generate_fact_lookup_code: too many types").
generate_fact_lookup_code(PredName, [pragma_var(_, VarName, Mode)|PragmaVars],
- ModuleInfo, ArgNum, FactTableSize, C_Code) :-
+ [Type | Types], ModuleInfo, ArgNum, FactTableSize, C_Code) :-
NextArgNum is ArgNum + 1,
- ( mode_is_output(ModuleInfo, Mode) ->
+ ( mode_is_fully_output(ModuleInfo, Mode) ->
C_Code_Template =
- "\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, ModuleInfo,
- NextArgNum, FactTableSize, C_Code1),
+ "\t\t%s = %smercury__%s_fact_table[ind/%d][ind%%%d].V_%d;\n",
+ ( Type = term__functor(term__atom("string"), [], _) ->
+ % Cast ConstString -> Word -> String to avoid
+ % gcc warning "assignment discards `const'".
+ % XXX Is this safe or should I be copying the string
+ % onto the heap?
+ Cast = "(String)(Word)"
+ ;
+ Cast = ""
+ ),
+ string__format(C_Code_Template, [s(VarName), s(Cast),
+ s(PredName), i(FactTableSize), i(FactTableSize),
+ i(ArgNum)], C_Code0),
+ generate_fact_lookup_code(PredName, PragmaVars, Types,
+ ModuleInfo, NextArgNum, FactTableSize, C_Code1),
string__append(C_Code0, C_Code1, C_Code)
;
% skip non-output arguments
- generate_fact_lookup_code(PredName, PragmaVars, ModuleInfo,
- NextArgNum, FactTableSize, C_Code)
+ generate_fact_lookup_code(PredName, PragmaVars, Types,
+ ModuleInfo, NextArgNum, FactTableSize, C_Code)
).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
% Code for lookup in nondet modes.
@@ -2945,8 +2935,8 @@
:- 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,
- ModuleInfo, FactTableSize, ProcCode, ExtraCode) :-
+generate_primary_nondet_code(PredName, PragmaVars, ProcID, ArgTypes,
+ ArgsMethod, ModuleInfo, FactTableSize, ProcCode, ExtraCode) :-
generate_nondet_proc_code(PragmaVars, PredName, ProcID, ExtraCodeLabel,
ProcCode),
@@ -3024,7 +3014,7 @@
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,
+ generate_fact_lookup_code(PredName, PragmaVars, ArgTypes, ModuleInfo, 1,
FactTableSize, FactLookupCode),
generate_fact_test_code(PredName, PragmaVars, ArgTypes, ModuleInfo,
FactTableSize, FactTestCode),
@@ -3143,45 +3133,18 @@
:- pred generate_arg_decl_code(string::in, (type)::in, string::out) is det.
generate_arg_decl_code(Name, Type, DeclCode) :-
- (
- get_c_type_from_mercury_type(Type, C_Type)
- ->
- string__format("\t\t%s %s;\n", [s(C_Type), s(Name)], DeclCode)
- ;
- error("generate_arg_decl_code: invalid type")
- ).
-
-:- pred get_c_type_from_mercury_type((type)::in, string::out) is semidet.
+ export__term_to_type_string(Type, C_Type),
+ string__format("\t\t%s %s;\n", [s(C_Type), s(Name)], DeclCode).
-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.
-generate_arg_input_code(Name, Type, RegNum, FrameVarNum, InputCode, SaveRegCode,
- GetRegCode) :-
- (
- Type = term__functor(term__atom("string"), [], _)
- ->
- Template = "\t\t%s = (String)%s;\n"
- ;
- Type = term__functor(term__atom("int"), [], _)
- ->
- Template = "\t\t%s = %s;\n"
- ;
- Type = term__functor(term__atom("float"), [], _)
- ->
- Template = "\t\t%s = word_to_float(%s);\n"
- ;
- error("generate_arg_input_code: invalid type")
- ),
+generate_arg_input_code(Name, Type, RegNum, FrameVarNum, InputCode,
+ SaveRegCode, GetRegCode) :-
get_reg_name(RegNum, RegName),
- string__format(Template, [s(Name), s(RegName)], InputCode),
+ convert_type_from_mercury(RegName, Type, Converted),
+ Template = "\t\t%s = %s;\n",
+ string__format(Template, [s(Name), s(Converted)], InputCode),
string__format("\t\tframevar(%d) = %s;\n",
[i(FrameVarNum), s(RegName)], SaveRegCode),
string__format("\t\t%s = framevar(%d);\n",
@@ -3191,23 +3154,10 @@
string::out) is det.
generate_arg_output_code(Name, Type, RegNum, OutputCode) :-
- (
- Type = term__functor(term__atom("string"), [], _)
- ->
- Template = "\t\t%s = (Word) %s;\n"
- ;
- Type = term__functor(term__atom("int"), [], _)
- ->
- Template = "\t\t%s = %s;\n"
- ;
- Type = term__functor(term__atom("float"), [], _)
- ->
- Template = "\t\t%s = float_to_word(%s);\n"
- ;
- error("generate_arg_output_code: invalid type")
- ),
get_reg_name(RegNum, RegName),
- string__format(Template, [s(RegName), s(Name)], OutputCode).
+ convert_type_to_mercury(Name, Type, Converted),
+ Template = "\t\t%s = %s;\n",
+ string__format(Template, [s(RegName), s(Converted)], OutputCode).
:- pred get_reg_name(int::in, string::out) is det.
@@ -3249,7 +3199,7 @@
[Type|Types], ModuleInfo, ArgNum, IsFirstInputArg0,
FactTableSize, CondCode) :-
PragmaVar = pragma_var(_, Name, Mode),
- ( mode_is_input(ModuleInfo, Mode) ->
+ ( mode_is_fully_input(ModuleInfo, Mode) ->
(
Type = term__functor(term__atom("string"), [], _)
->
@@ -3392,7 +3342,7 @@
'i', IntHashLookupCode),
generate_hash_lookup_code("word_to_float(framevar(3))", LabelName2, 2,
"%s == %s", 'f', FloatHashLookupCode),
- generate_fact_lookup_code(PredName, PragmaVars, ModuleInfo, 1,
+ generate_fact_lookup_code(PredName, PragmaVars, ArgTypes, ModuleInfo, 1,
FactTableSize, FactLookupCode),
list__length(PragmaVars, Arity),
Index: export.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/export.m,v
retrieving revision 1.10
diff -u -r1.10 export.m
--- export.m 1997/02/19 05:30:05 1.10
+++ export.m 1997/02/25 02:48:47
@@ -33,6 +33,16 @@
:- pred export__term_to_type_string(term, string).
:- mode export__term_to_type_string(in, out) is det.
+ % Convert an rval (represented as a string), from a C type to
+ % a mercury C type. (ie. convert strings and floats to words).
+:- pred convert_type_to_mercury(string, type, string).
+:- mode convert_type_to_mercury(in, in, out) is det.
+
+ % Convert an rval (represented as a string), from a mercury C type to
+ % a C type. (ie. convert words to strings and floats if required).
+:- pred convert_type_from_mercury(string, type, string).
+:- mode convert_type_from_mercury(in, in, out) is det.
+
:- implementation.
:- import_module code_gen, code_util, hlds_pred, llds, llds_out.
@@ -345,11 +355,6 @@
string__append("r", RegNumString, RegName)
).
- % Convert an rval (represented as a string), from a C type to
- % a mercury C type. (ie. convert strings and floats to words).
-:- pred convert_type_to_mercury(string, type, string).
-:- mode convert_type_to_mercury(in, in, out) is det.
-
convert_type_to_mercury(Rval, Type, ConvertedRval) :-
(
Type = term__functor(term__atom("string"), [], _)
@@ -370,11 +375,6 @@
;
ConvertedRval = Rval
).
-
- % Convert an rval (represented as a string), from a mercury C type to
- % a C type. (ie. convert words to strings and floats if required).
-:- pred convert_type_from_mercury(string, type, string).
-:- mode convert_type_from_mercury(in, in, out) is det.
convert_type_from_mercury(Rval, Type, ConvertedRval) :-
(
Index: handle_options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/handle_options.m,v
retrieving revision 1.21
diff -u -r1.21 handle_options.m
--- handle_options.m 1997/02/14 05:54:01 1.21
+++ handle_options.m 1997/02/24 01:36:32
@@ -127,10 +127,21 @@
{ convert_prolog_dialect(PrologDialectStr,
PrologDialect) }
->
- postprocess_options_2(OptionTable, GC_Method,
- TagsMethod, ArgsMethod, TypeInfoMethod,
- PrologDialect),
- { Error = no }
+ { map__lookup(OptionTable,
+ fact_table_hash_percent_full,
+ PercentFull) },
+ (
+ { PercentFull = int(Percent) },
+ { Percent >= 1 },
+ { Percent =< 100 }
+ ->
+ postprocess_options_2(OptionTable,
+ GC_Method, TagsMethod, ArgsMethod,
+ TypeInfoMethod, PrologDialect),
+ { Error = no }
+ ;
+ { Error = yes("Invalid argument to option `--fact-table-hash-percent-full'\n (must be an integer between 1 and 100)") }
+ )
;
{ Error = yes("Invalid prolog-dialect option (must be `sicstus', `nu', or `default')") }
)
Index: inlining.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inlining.m,v
retrieving revision 1.57
diff -u -r1.57 inlining.m
--- inlining.m 1997/02/23 06:06:40 1.57
+++ inlining.m 1997/02/25 05:58:42
@@ -214,7 +214,21 @@
{ NumUses = 1 }
),
% Don't inline recursive predicates
- { \+ goal_calls(CalledGoal, PredProcId) }
+ { \+ goal_calls(CalledGoal, PredProcId) },
+
+ % Don't inline model_non pragma c that doesn't have an
+ % `extra_pragma_info'.
+ %
+ % XXX model_non pragma c without `extra_pragma_info' should
+ % not be accepted by the compiler, but at the moment it's
+ % the only way to get model_non pragma c (the ``correct''
+ % way of doing it hasn't been implemented yet). We just
+ % have to make sure it doesn't get inlined because that stops
+ % it from working.
+ \+ {
+ CalledGoal = pragma_c_code(_,_,_,_,_,_,none) - _,
+ proc_info_interface_code_model(ProcInfo, model_non)
+ }
->
inlining__mark_proc_as_inlined(PredProcId, ModuleInfo,
InlinedProcs0, InlinedProcs)
Index: make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.222
diff -u -r1.222 make_hlds.m
--- make_hlds.m 1997/02/23 06:07:03 1.222
+++ make_hlds.m 1997/02/24 06:08:16
@@ -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,53 @@
% `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) },
+ fact_table_generate_c_code(SymName, PragmaVars, ProcID, PrimaryProcID,
+ ProcInfo, ArgTypes, 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: mode_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_util.m,v
retrieving revision 1.82
diff -u -r1.82 mode_util.m
--- mode_util.m 1997/02/23 06:07:22 1.82
+++ mode_util.m 1997/02/24 00:37:26
@@ -28,11 +28,20 @@
:- pred mode_is_input(module_info, mode).
:- mode mode_is_input(in, in) is semidet.
+ % a mode is considered fully input if the inital inst is ground
+:- pred mode_is_fully_input(module_info, mode).
+:- mode mode_is_fully_input(in, in) is semidet.
+
% a mode is considered output if the initial inst is free
% and the final inst is bound
:- pred mode_is_output(module_info, mode).
:- mode mode_is_output(in, in) is semidet.
+ % a mode is considered fully output if the inital inst is free and
+ % the final inst is ground
+:- pred mode_is_fully_output(module_info, mode).
+:- mode mode_is_fully_output(in, in) is semidet.
+
% a mode is considered unused if both initial and final insts are free
:- pred mode_is_unused(module_info, mode).
:- mode mode_is_unused(in, in) is semidet.
@@ -314,6 +323,12 @@
mode_get_insts(ModuleInfo, Mode, InitialInst, _FinalInst),
inst_is_bound(ModuleInfo, InitialInst).
+ % A mode is considered fully input if its initial inst is ground.
+
+mode_is_fully_input(ModuleInfo, Mode) :-
+ mode_get_insts(ModuleInfo, Mode, InitialInst, _FinalInst),
+ inst_is_ground(ModuleInfo, InitialInst).
+
% A mode is considered an output mode if the top-level
% node is output.
@@ -321,6 +336,14 @@
mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst),
inst_is_free(ModuleInfo, InitialInst),
inst_is_bound(ModuleInfo, FinalInst).
+
+ % A mode is considered fully output if its initial inst is free
+ % and its final insts is ground.
+
+mode_is_fully_output(ModuleInfo, Mode) :-
+ mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst),
+ inst_is_free(ModuleInfo, InitialInst),
+ inst_is_ground(ModuleInfo, FinalInst).
% A mode is considered a unused mode if it is equivalent
% to free->free.
Index: modules.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modules.m,v
retrieving revision 1.31
diff -u -r1.31 modules.m
--- modules.m 1997/02/23 06:07:32 1.31
+++ modules.m 1997/02/25 03:45:04
@@ -398,6 +398,38 @@
{ 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__nl(DepStream),
+ globals__io_lookup_bool_option(assume_gmake,
+ AssumeGmake),
+ ( { AssumeGmake = no} ->
+ io__write_strings(DepStream,
+ [ModuleName, ".fact_tables.os = "]),
+ write_dependencies_list(FactDeps, ".o",
+ DepStream),
+ io__write_strings(DepStream, [
+ "\n\n", ModuleName,
+ ".fact_tables.cs = $(", ModuleName,
+ ".fact_tables.os:.o=.c)\n\n"
+ ])
+ ;
+ io__write_strings(DepStream, [
+ "\n\n", ModuleName,
+ ".fact_tables.os = $(", ModuleName,
+ ".fact_tables:%=%.o)\n\n",
+ ModuleName,
+ ".fact_tables.cs = $(", ModuleName,
+ ".fact_tables:%=%.c)\n\n"
+ ])
+ )
+ ;
+ []
+ ),
+
+
io__write_strings(DepStream, [
ModuleName, ".optdate ",
ModuleName, ".c ",
@@ -407,7 +439,19 @@
] ),
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.os) : $(",
+ ModuleName, ".fact_tables) ",
+ ModuleName, ".m\n\n",
+ "$(", ModuleName, ".fact_tables.cs) : ",
+ ModuleName, ".o\n"
+ ] )
+ ;
+ []
+ ),
globals__io_lookup_bool_option(intermodule_optimization,
Intermod),
@@ -448,17 +492,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: 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/24 06:00:28
@@ -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
@@ -1303,6 +1317,19 @@
io__write_string("\t\tSpecify the directory containing the Mercury C header files.\n"),
io__write_string("\t--cflags <options>\n"),
io__write_string("\t\tSpecify options to be passed to the C compiler.\n").
+
+/*************
+ % XXX documentation on `pragma fact_table' options should be uncommented when
+ % fact tables are ready for public release.
+
+ io__write_string("\t--fact-table-max-array-size <n>\n"),
+ io__write_string("\t\tSpecify the maximum number of elements in a single\n"),
+ io__write_string("\t\t`pragma fact_table' data array (default: 1024).\n"),
+ io__write_string("\t--fact-table-hash-percent-full <percentage>\n"),
+ io__write_string("\t\tSpecify how full the `pragma fact_table' hash tables should be\n"),
+ io__write_string("\t\tallowed to get. Given as an integer percentage\n"),
+ io__write_string("\t\t(valid range: 1 to 100, default: 90).\n").
+**************/
:- pred options_help_optimization(io__state::di, io__state::uo) is det.
More information about the developers
mailing list