[m-rev.] for review: calling Mercury from Aditi
Simon Taylor
stayl at cs.mu.OZ.AU
Wed Oct 1 02:40:57 AEST 2003
Estimated hours taken: 200
Branches: main
Allow Aditi to call Mercury. At the moment, this involves Aditi
loading a shared library containing the user's code.
runtime/mercury_aditi.h:
Define a structure MR_Aditi_Proc_Info used to describe
a procedure called by Aditi. Aditi will use dlsym() to
look up these structures in the shared library supplied
by the user.
compiler/rtti.m:
compiler/rtti_out.m:
compiler/rtti_to_mlds.m:
compiler/ml_code_util.m:
compiler/mlds_to_gcc.m:
compiler/opt_debug.m:
Add an aditi_proc_info alternative to the rtti_data type,
which corresponds to an MR_AditiProcInfo structure in
the generated code.
In the rtti_proc_label type, record the determinism rather
than the code_model for use by Aditi.
compiler/options.m:
doc/user_guide.texi:
Add an option `--aditi-calls-mercury'.
This is needed for the Aditi tests, which currently don't
handle loading the shared libraries for user defined code.
Move `--aditi' into the compilation model options section.
compiler/rl.m:
Sort the constructors for d.u. types when creating an Aditi
type declaration to make it easier to find a particular
constructor.
compiler/code_model.m:
compiler/stack_layout.m:
Move represent_determinism into code_model.m, for use
by rtti_to_mlds.m.
compiler/rl_exprn.m:
compiler/rl_file.pp:
compiler/rl_out.pp:
compiler/hlds_module.m:
compiler/mercury_compile.m:
Create the procedures for each top-down Mercury goal which
needs to be called from Aditi.
Each created procedure has one input and one output argument,
both of which will have a `{}/N' type.
Allow nondet join conditions.
compiler/rl_exprn.m:
Use record syntax.
compiler/rl_out.pp:
Minor changes to the support for memoing.
runtime/Mmakefile:
runtime/mercury_imp.h:
runtime/mercury.h:
Add mercury_aditi.h.
runtime/mercury_stack_layout.m:
Add a comment about the duplication between MR_DETISM_*
and code_model.represent_determinism.
tests/valid/Mmakefile:
tests/valid/Mercury.options:
tests/valid/aditi_calls_mercury.m:
Test case.
Also, enable the Aditi tests in hlc grades.
Index: compiler/code_model.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_model.m,v
retrieving revision 1.3
diff -u -u -r1.3 code_model.m
--- compiler/code_model.m 15 Mar 2003 03:08:43 -0000 1.3
+++ compiler/code_model.m 23 Sep 2003 00:40:03 -0000
@@ -40,10 +40,24 @@
:- pred goal_info_get_code_model(hlds_goal_info, code_model).
:- mode goal_info_get_code_model(in, out) is det.
+ % Construct a representation of the interface determinism of a
+ % procedure. The code we have chosen is not sequential; instead
+ % it encodes the various properties of each determinism.
+ % This must match the encoding of MR_Determinism in
+ % mercury_stack_layout.h.
+ %
+ % The 8 bit is set iff the context is first_solution.
+ % The 4 bit is set iff the min number of solutions is more than zero.
+ % The 2 bit is set iff the max number of solutions is more than zero.
+ % The 1 bit is set iff the max number of solutions is more than one.
+:- func represent_determinism(determinism) = int.
+
%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module int.
+
determinism_to_code_model(det, model_det).
determinism_to_code_model(semidet, model_semi).
determinism_to_code_model(nondet, model_non).
@@ -60,5 +74,28 @@
goal_info_get_code_model(GoalInfo, CodeModel) :-
goal_info_get_determinism(GoalInfo, Determinism),
determinism_to_code_model(Determinism, CodeModel).
+
+represent_determinism(det) = max_more_than_zero \/ min_more_than_zero.
+represent_determinism(semidet) = max_more_than_zero.
+represent_determinism(nondet) = max_more_than_one.
+represent_determinism(multidet) = max_more_than_one \/ min_more_than_zero.
+represent_determinism(erroneous) = min_more_than_zero.
+represent_determinism(failure) = 0.
+represent_determinism(cc_nondet) =
+ represent_determinism(nondet) \/ first_solution.
+represent_determinism(cc_multidet) =
+ represent_determinism(multidet) \/ first_solution.
+
+:- func first_solution = int.
+first_solution = 8.
+
+:- func min_more_than_zero = int.
+min_more_than_zero = 4.
+
+:- func max_more_than_zero = int.
+max_more_than_zero = 2.
+
+:- func max_more_than_one = int.
+max_more_than_one = 3.
%-----------------------------------------------------------------------------%
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.90
diff -u -u -r1.90 hlds_module.m
--- compiler/hlds_module.m 26 Jun 2003 00:26:46 -0000 1.90
+++ compiler/hlds_module.m 23 Sep 2003 00:40:03 -0000
@@ -117,6 +117,17 @@
---> do_aditi_compilation
; no_aditi_compilation.
+ % Mercury procedures which can be called from Aditi join conditions.
+ % Each procedure has one input and one output argument.
+ % The compiler generates a constant structure containing
+ % the address and other information for each procedure,
+ % which Aditi will find using dlsym().
+:- type aditi_top_down_proc
+ ---> aditi_top_down_proc(
+ pred_proc_id,
+ string % name of the constant.
+ ).
+
%-----------------------------------------------------------------------------%
% Various predicates for manipulating the module_info data structure
@@ -384,6 +395,18 @@
analysis_info, module_info).
:- mode module_info_set_analysis_info(in, in, out) is det.
+:- pred module_info_aditi_top_down_procs(module_info,
+ list(aditi_top_down_proc)).
+:- mode module_info_aditi_top_down_procs(in, out) is det.
+
+:- pred module_info_set_aditi_top_down_procs(module_info,
+ list(aditi_top_down_proc), module_info).
+:- mode module_info_set_aditi_top_down_procs(in, in, out) is det.
+
+:- pred module_info_next_aditi_top_down_proc(module_info, int,
+ module_info).
+:- mode module_info_next_aditi_top_down_proc(in, out, out) is det.
+
%-----------------------------------------------------------------------------%
:- pred module_info_preds(module_info, pred_table).
@@ -607,10 +630,16 @@
% but lookups in this table
% will be much faster.
- analysis_info :: analysis_info
+ analysis_info :: analysis_info,
% Information for the
% inter-module analysis
% framework.
+ aditi_top_down_procs :: list(aditi_top_down_proc),
+ % List of top-down procedures
+ % which could be called from
+ % bottom-up Aditi procedures.
+ aditi_proc_counter :: counter
+
).
% A predicate which creates an empty module
@@ -652,7 +681,7 @@
[], StratPreds, UnusedArgInfo, counter__init(1),
counter__init(1), ImportedModules, IndirectlyImportedModules,
no_aditi_compilation, TypeSpecInfo,
- NoTagTypes, init_analysis_info(mmc)),
+ NoTagTypes, init_analysis_info(mmc), [], counter__init(1)),
ModuleInfo = module(ModuleSubInfo, PredicateTable, Requests,
UnifyPredMap, QualifierInfo, Types, Insts, Modes, Ctors,
ClassTable, SuperClassTable, InstanceTable, AssertionTable,
@@ -733,6 +762,12 @@
module_info_type_spec_info(MI, MI ^ sub_info ^ type_spec_info).
module_info_no_tag_types(MI, MI ^ sub_info ^ no_tag_type_table).
module_info_analysis_info(MI, MI ^ sub_info ^ analysis_info).
+module_info_aditi_top_down_procs(MI, MI ^ sub_info ^ aditi_top_down_procs).
+
+module_info_next_aditi_top_down_proc(MI0, Proc, MI) :-
+ Counter0 = MI0 ^ sub_info ^ aditi_proc_counter,
+ counter__allocate(Proc, Counter0, Counter),
+ MI = MI0 ^ sub_info ^ aditi_proc_counter := Counter.
%-----------------------------------------------------------------------------%
@@ -783,6 +818,8 @@
MI ^ sub_info ^ no_tag_type_table := NewVal).
module_info_set_analysis_info(MI, NewVal,
MI ^ sub_info ^ analysis_info := NewVal).
+module_info_set_aditi_top_down_procs(MI, NewVal,
+ MI ^ sub_info ^ aditi_top_down_procs := NewVal).
%-----------------------------------------------------------------------------%
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.289
diff -u -u -r1.289 mercury_compile.m
--- compiler/mercury_compile.m 6 Aug 2003 12:38:10 -0000 1.289
+++ compiler/mercury_compile.m 24 Sep 2003 16:37:36 -0000
@@ -132,6 +132,7 @@
:- import_module aditi_backend__rl_file.
:- import_module backend_libs__compile_target_code.
:- import_module backend_libs__name_mangle.
+:- import_module backend_libs__rtti.
:- import_module check_hlds__goal_path.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_module.
@@ -1354,24 +1355,24 @@
[]
),
- mercury_compile__maybe_generate_rl_bytecode(HLDS50,
- Verbose, MaybeRLFile),
+ mercury_compile__maybe_generate_rl_bytecode(Verbose,
+ MaybeRLFile, HLDS50, HLDS51),
( { Target = c ; Target = asm } ->
%
% Produce the grade independent header file
% <module>.mh containing function prototypes
% for the `:- pragma export'ed procedures.
%
- { export__get_foreign_export_decls(HLDS50,
+ { export__get_foreign_export_decls(HLDS51,
ExportDecls) },
export__produce_header_file(ExportDecls, ModuleName)
;
[]
),
( { AditiOnly = yes } ->
- { HLDS = HLDS50 }
+ { HLDS = HLDS51 }
; { Target = il } ->
- { HLDS = HLDS50 },
+ { HLDS = HLDS51 },
mercury_compile__mlds_backend(HLDS, MLDS),
( { TargetCodeOnly = yes } ->
mercury_compile__mlds_to_il_assembler(MLDS)
@@ -1385,7 +1386,7 @@
maybe_set_exit_status(Succeeded)
)
; { Target = java } ->
- { HLDS = HLDS50 },
+ { HLDS = HLDS51 },
mercury_compile__mlds_backend(HLDS, MLDS),
mercury_compile__mlds_to_java(MLDS),
( { TargetCodeOnly = yes } ->
@@ -1400,7 +1401,7 @@
)
; { Target = asm } ->
% compile directly to assembler using the gcc back-end
- { HLDS = HLDS50 },
+ { HLDS = HLDS51 },
mercury_compile__mlds_backend(HLDS, MLDS),
mercury_compile__maybe_mlds_to_gcc(MLDS,
MaybeRLFile, ContainsCCode),
@@ -1447,7 +1448,7 @@
)
)
; { HighLevelCode = yes } ->
- { HLDS = HLDS50 },
+ { HLDS = HLDS51 },
mercury_compile__mlds_backend(HLDS, MLDS),
mercury_compile__mlds_to_high_level_c(MLDS,
MaybeRLFile),
@@ -1468,7 +1469,7 @@
maybe_set_exit_status(CompileOK)
)
;
- mercury_compile__backend_pass(HLDS50, HLDS,
+ mercury_compile__backend_pass(HLDS51, HLDS,
DeepProfilingStructures, GlobalData, LLDS),
mercury_compile__output_pass(HLDS, GlobalData, LLDS,
MaybeRLFile, ModuleName, _CompileErrors)
@@ -2194,17 +2195,17 @@
%-----------------------------------------------------------------------------%
-:- pred mercury_compile__maybe_generate_rl_bytecode(module_info, bool,
- maybe(rl_file), io__state, io__state).
-:- mode mercury_compile__maybe_generate_rl_bytecode(in, in,
- out, di, uo) is det.
+:- pred mercury_compile__maybe_generate_rl_bytecode(bool, maybe(rl_file),
+ module_info, module_info, io__state, io__state).
+:- mode mercury_compile__maybe_generate_rl_bytecode(in, out,
+ in, out, di, uo) is det.
-mercury_compile__maybe_generate_rl_bytecode(ModuleInfo,
- Verbose, MaybeRLFile) -->
+mercury_compile__maybe_generate_rl_bytecode(Verbose, MaybeRLFile,
+ ModuleInfo0, ModuleInfo) -->
globals__io_lookup_bool_option(aditi, Aditi),
(
{ Aditi = yes },
- { module_info_get_do_aditi_compilation(ModuleInfo,
+ { module_info_get_do_aditi_compilation(ModuleInfo0,
AditiCompile) },
(
{ AditiCompile = do_aditi_compilation },
@@ -2214,25 +2215,24 @@
%
maybe_write_string(Verbose, "% Generating RL...\n"),
maybe_flush_output(Verbose),
- rl_gen__module(ModuleInfo, RLProcs0),
+ rl_gen__module(ModuleInfo0, RLProcs0),
mercury_compile__maybe_dump_rl(RLProcs0,
- ModuleInfo, "", ""),
+ ModuleInfo0, "", ""),
%
% Optimize the RL procedures.
%
- rl_opt__procs(ModuleInfo, RLProcs0, RLProcs),
+ rl_opt__procs(ModuleInfo0, RLProcs0, RLProcs),
mercury_compile__maybe_dump_rl(RLProcs,
- ModuleInfo, "", ".opt"),
+ ModuleInfo0, "", ".opt"),
%
% Convert the RL procedures to bytecode.
%
- rl_out__generate_rl_bytecode(ModuleInfo,
- RLProcs, MaybeRLFile)
+ rl_out__generate_rl_bytecode(RLProcs, MaybeRLFile,
+ ModuleInfo0, ModuleInfo)
;
{ AditiCompile = no_aditi_compilation },
- { MaybeRLFile = no },
globals__io_lookup_bool_option(aditi_only, AditiOnly),
(
@@ -2241,17 +2241,31 @@
% Always generate a `.rlo' file if compiling
% with `--aditi-only'.
{ RLProcs = [] },
- rl_out__generate_rl_bytecode(ModuleInfo,
- RLProcs, _)
+ rl_out__generate_rl_bytecode(RLProcs,
+ MaybeRLFile, ModuleInfo0, ModuleInfo)
;
- { AditiOnly = no }
+ { AditiOnly = no },
+ { ModuleInfo = ModuleInfo0 },
+ { MaybeRLFile = no }
)
)
;
{ Aditi = no },
+ { ModuleInfo = ModuleInfo0 },
{ MaybeRLFile = no }
).
+:- pred mercury_compile__generate_aditi_proc_info(module_info,
+ list(rtti_data)).
+:- mode mercury_compile__generate_aditi_proc_info(in, out) is det.
+
+mercury_compile__generate_aditi_proc_info(HLDS, AditiProcInfoRttiData) :-
+ module_info_aditi_top_down_procs(HLDS, Procs),
+ AditiProcInfoRttiData = list__map(
+ (func(aditi_top_down_proc(proc(PredId, ProcId), _)) =
+ rtti__make_aditi_proc_info(HLDS, PredId, ProcId)
+ ), Procs).
+
%-----------------------------------------------------------------------------%
:- pred mercury_compile__backend_pass(module_info, module_info,
@@ -3583,11 +3597,15 @@
%
{ type_ctor_info__generate_rtti(HLDS, TypeCtorRttiData) },
{ base_typeclass_info__generate_rtti(HLDS, TypeClassInfoRttiData) },
+ { generate_aditi_proc_info(HLDS, AditiProcInfoRttiData) },
{ list__map(llds__wrap_rtti_data, TypeCtorRttiData, TypeCtorTables) },
{ list__map(llds__wrap_rtti_data, TypeClassInfoRttiData,
TypeClassInfos) },
+ { list__map(llds__wrap_rtti_data, AditiProcInfoRttiData,
+ AditiProcInfos) },
{ stack_layout__generate_llds(HLDS, GlobalData0, GlobalData,
StackLayouts, LayoutLabels) },
+
%
% Here we perform some optimizations on the LLDS data.
% XXX this should perhaps be part of backend_pass
@@ -3605,7 +3623,8 @@
% Next we put it all together and output it to one or more C files.
%
{ list__condense([StaticCells, ClosureLayouts, StackLayouts,
- DeepProfData, TypeCtorTables, TypeClassInfos], AllData) },
+ DeepProfData, TypeCtorTables, TypeClassInfos, AditiProcInfos],
+ AllData) },
mercury_compile__construct_c_file(HLDS, C_InterfaceInfo,
Procs, GlobalVars, AllData, CFile, NumChunks),
mercury_compile__output_llds(ModuleName, CFile, LayoutLabels,
@@ -3950,7 +3969,9 @@
mercury_compile__mlds_gen_rtti_data(HLDS, MLDS0, MLDS) :-
type_ctor_info__generate_rtti(HLDS, TypeCtorRtti),
base_typeclass_info__generate_rtti(HLDS, TypeClassInfoRtti),
- list__append(TypeCtorRtti, TypeClassInfoRtti, RttiData),
+ generate_aditi_proc_info(HLDS, AditiProcInfoRtti),
+ list__condense([TypeCtorRtti, TypeClassInfoRtti, AditiProcInfoRtti],
+ RttiData),
RttiDefns = rtti_data_list_to_mlds(HLDS, RttiData),
MLDS0 = mlds(ModuleName, ForeignCode, Imports, Defns0),
list__append(RttiDefns, Defns0, Defns),
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.73
diff -u -u -r1.73 ml_code_util.m
--- compiler/ml_code_util.m 25 Sep 2003 07:56:28 -0000 1.73
+++ compiler/ml_code_util.m 30 Sep 2003 09:45:32 -0000
@@ -1154,7 +1154,8 @@
ArgTypes = RttiProcId^arg_types,
ArgModes = RttiProcId^proc_arg_modes,
PredOrFunc = RttiProcId^pred_or_func,
- CodeModel = RttiProcId^proc_interface_code_model,
+ determinism_to_code_model(RttiProcId^proc_interface_determinism,
+ CodeModel),
HeadVarNames = list__map((func(Var - Name) = Result :-
term__var_to_int(Var, N),
Result = mlds__var_name(Name, yes(N))
@@ -1449,7 +1450,7 @@
MLDS_Module) :-
RttiProcLabel = rtti_proc_label(PredOrFunc, ThisModule, PredModule,
PredName, PredArity, _ArgTypes, PredId, ProcId,
- _HeadVarsWithNames, _ArgModes, CodeModel,
+ _HeadVarsWithNames, _ArgModes, Detism,
IsImported, _IsPseudoImported, _IsExported,
IsSpecialPredInstance),
(
@@ -1518,6 +1519,7 @@
;
NonOutputFunc = no
),
+ determinism_to_code_model(Detism, CodeModel),
MLDS_PredLabel = pred(PredOrFunc, MaybeDeclaringModule,
PredName, PredArity, CodeModel,
NonOutputFunc)
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.86
diff -u -u -r1.86 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 13 May 2003 08:51:48 -0000 1.86
+++ compiler/mlds_to_gcc.m 23 Sep 2003 00:40:03 -0000
@@ -1938,6 +1938,21 @@
build_rtti_type_name(RttiName, Size, GCC_Type).
build_rtti_type(tc_rtti_id(TCRttiName), Size, GCC_Type) -->
build_rtti_type_tc_name(TCRttiName, Size, GCC_Type).
+build_rtti_type(aditi_rtti_id(_), _, GCC_Type) -->
+ % typedef struct {
+ % MR_Code *MR_aditi_proc_addr;
+ % MR_String MR_aditi_proc_name;
+ % MR_TypeInfo MR_aditi_input_type_info;
+ % MR_TypeInfo MR_aditi_output_type_info;
+ % MR_Determinism MR_aditi_proc_detism;
+ % }
+ build_struct_type("MR_Aditi_Proc_Info",
+ ['MR_Code*' - "MR_aditi_proc_addr",
+ 'MR_ConstString' - "MR_aditi_proc_name",
+ 'MR_TypeInfo' - "MR_aditi_input_type_info",
+ 'MR_TypeInfo' - "MR_aditi_output_type_info",
+ 'MR_Determinism' - "MR_aditi_proc_detism"],
+ GCC_Type).
:- pred build_rtti_type_name(ctor_rtti_name::in, initializer_array_size::in,
gcc__type::out, io__state::di, io__state::uo) is det.
@@ -2406,6 +2421,7 @@
RttiTypeCtor = fixup_rtti_type_ctor(RttiTypeCtor0),
RttiName = fixup_rtti_name(RttiName0).
fixup_rtti_id(tc_rtti_id(TCRttiName)) = tc_rtti_id(TCRttiName).
+fixup_rtti_id(aditi_rtti_id(ProcLabel)) = aditi_rtti_id(ProcLabel).
% XXX sometimes earlier stages of the compiler forget to add
% the appropriate qualifiers for stuff in the `builtin' module;
@@ -3549,10 +3565,12 @@
:- func 'MR_ConstString' = gcc__type.
:- func 'MR_Word' = gcc__type.
:- func 'MR_bool' = gcc__type.
+:- func 'MR_Code*' = gcc__type.
:- func 'MR_TypeInfo' = gcc__type.
:- func 'MR_PseudoTypeInfo' = gcc__type.
:- func 'MR_Sectag_Locn' = gcc__type.
:- func 'MR_TypeCtorRep' = gcc__type.
+:- func 'MR_Determinism' = gcc__type.
:- func 'MR_int_least8_t' = gcc__type.
:- func 'MR_int_least16_t' = gcc__type.
@@ -3570,16 +3588,18 @@
% XXX 'MR_Word' should perhaps be unsigned, to match the C back-end
'MR_Word' = gcc__intptr_type_node.
'MR_bool' = gcc__integer_type_node. % i.e. typedef int MR_bool
+'MR_Code*' = gcc__ptr_type_node.
'MR_TypeInfo' = gcc__ptr_type_node.
'MR_PseudoTypeInfo' = gcc__ptr_type_node.
- % XXX MR_Sectag_Locn and MR_TypeCtorRep are actually enums
- % in the C back-end. Binary compatibility between this
+ % XXX MR_Sectag_Locn, MR_TypeCtorRep and MR_Determinism are actually
+ % enums in the C back-end. Binary compatibility between this
% back-end and the C back-end only works if the C compiler
% represents these enums the same as `int'.
'MR_Sectag_Locn' = gcc__integer_type_node.
'MR_TypeCtorRep' = gcc__integer_type_node.
+'MR_Determinism' = gcc__integer_type_node.
'MR_int_least8_t' = gcc__int8_type_node.
'MR_int_least16_t' = gcc__int16_type_node.
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.133
diff -u -u -r1.133 opt_debug.m
--- compiler/opt_debug.m 27 May 2003 05:57:15 -0000 1.133
+++ compiler/opt_debug.m 23 Sep 2003 00:40:04 -0000
@@ -344,6 +344,12 @@
string__append_list(
["tc_rtti_addr(", TCDataName_str, ")"],
Str).
+opt_debug__dump_data_addr(rtti_addr(aditi_rtti_id(ProcLabel)), Str) :-
+ opt_debug__dump_proclabel(make_proc_label_from_rtti(ProcLabel),
+ ProcLabelStr),
+ string__append_list(
+ ["aditi_rtti_addr(", ProcLabelStr, ")"],
+ Str).
opt_debug__dump_data_addr(layout_addr(LayoutName), Str) :-
opt_debug__dump_layout_name(LayoutName, LayoutName_str),
string__append_list(["layout_addr(", LayoutName_str, ")"], Str).
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.417
diff -u -u -r1.417 options.m
--- compiler/options.m 25 Sep 2003 07:56:28 -0000 1.417
+++ compiler/options.m 30 Sep 2003 15:46:01 -0000
@@ -231,7 +231,11 @@
% only for benchmarks for the paper.
; deep_profile_tail_recursion
- % (c) Miscellaneous
+ % (c) Aditi
+ ; aditi
+ ; aditi_calls_mercury
+
+ % (d) Miscellaneous
; gc
; parallel
; use_trail
@@ -655,9 +659,6 @@
; intermod_directories
; use_search_directories_for_intermod
; filenames_from_stdin
- ; aditi % XXX this should be in the
- % "Auxiliary output options"
- % section
; aditi_user
; help
; fullarch
@@ -872,6 +873,8 @@
use_trail - bool(no),
use_minimal_model - bool(no),
type_layout - bool(yes),
+ aditi - bool(no),
+ aditi_calls_mercury - bool(no),% XXX eventually yes
% Data representation compilation model options
reserve_tag - bool(no),
@@ -1279,7 +1282,6 @@
option_defaults_2(miscellaneous_option, [
% Miscellaneous Options
filenames_from_stdin - bool(no),
- aditi - bool(no),
aditi_user - string(""),
help - bool(no),
fullarch - string(""),
@@ -1509,6 +1511,8 @@
long_option("parallel", parallel).
long_option("use-trail", use_trail).
long_option("type-layout", type_layout).
+long_option("aditi", aditi).
+long_option("aditi-calls-mercury", aditi_calls_mercury).
% Data represention options
long_option("reserve-tag", reserve_tag).
long_option("use-minimal-model", use_minimal_model).
@@ -1938,7 +1942,6 @@
% misc options
long_option("help", help).
long_option("filenames-from-stdin", filenames_from_stdin).
-long_option("aditi", aditi).
long_option("aditi-user", aditi_user).
long_option("fullarch", fullarch).
long_option("bug-intermod-2002-06-13", compiler_sufficiently_recent).
@@ -3053,6 +3056,21 @@
"\tmemory usage information, not call counts.",
********************/
]),
+ io__write_string(" Aditi\n"),
+ write_tabbed_lines([
+ "--aditi",
+ "\tEnable Aditi compilation. You need to enable this",
+ "\toption if you are making use of the Aditi deductive",
+ "\tdatabase interface.",
+ "--aditi-calls-mercury",
+ "\tEnable calling arbitrary Mercury code from predicates",
+ "\twith `:- pragma aditi' declarations."
+
+ % --aditi-calls-mercury is not fully implemented.
+ %"--aditi-calls-mercury",
+ %"\tEnable calling ordinary Mercury code from Aditi."
+ ]),
+
io__write_string(" Miscellaneous optional features\n"),
write_tabbed_lines([
"--gc {none, conservative, boehm, mps, accurate}",
@@ -4063,10 +4081,6 @@
"\tis reached. (This allows a program or user to interactively",
"\tcompile several modules without the overhead of process",
"\tcreation for each one.)",
- "--aditi",
- "\tEnable Aditi compilation. You need to enable this",
- "\toption if you are making use of the Aditi deductive",
- "\tdatabase interface.",
"--aditi-user",
"\tSpecify the Aditi login of the owner of the predicates",
"\tin any Aditi RL files produced. The owner field is",
Index: compiler/rl.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl.m,v
retrieving revision 1.23
diff -u -u -r1.23 rl.m
--- compiler/rl.m 26 May 2003 09:00:07 -0000 1.23
+++ compiler/rl.m 23 Sep 2003 00:40:04 -0000
@@ -1313,8 +1313,27 @@
RecursiveTypes0, RecursiveTypes, Decls0, Decls, ThisType) :-
(
type_to_ctor_and_args(Type, TypeCtor, Args),
- type_constructors(Type, ModuleInfo, Ctors)
+ type_constructors(Type, ModuleInfo, Ctors0)
->
+ % Sort the constructors. This is needed so that
+ % the conversion from Aditi to Mercury can just
+ % call std_util__get_functor without needing to
+ % search for the functor.
+ list__sort(
+ (pred(Ctor1::in, Ctor2::in, CompareResult::out) is det :-
+ Ctor1 = ctor(_, _, QName1, Args1),
+ Ctor2 = ctor(_, _, QName2, Args2),
+ unqualify_name(QName1, Name1),
+ unqualify_name(QName2, Name2),
+ compare(NameResult, Name1, Name2),
+ ( NameResult = (=) ->
+ compare(CompareResult, list__length(Args1),
+ list__length(Args2) `with_type` int)
+ ;
+ CompareResult = NameResult
+ )
+ ), Ctors0, Ctors),
+
( set__member(TypeCtor - Args, Parents) ->
set__insert(RecursiveTypes0, TypeCtor - Args,
RecursiveTypes1)
Index: compiler/rl_exprn.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.33
diff -u -u -r1.33 rl_exprn.m
--- compiler/rl_exprn.m 24 Jun 2003 14:20:51 -0000 1.33
+++ compiler/rl_exprn.m 25 Sep 2003 02:15:30 -0000
@@ -113,8 +113,9 @@
% ExprnMode, ExprnVarTypes).
%
% Generate an expression for a join/project/subtract condition.
-:- pred rl_exprn__generate(module_info::in, rl_goal::in, list(bytecode)::out,
- int::out, exprn_mode::out, list(type)::out) is det.
+:- pred rl_exprn__generate(rl_goal::in, list(bytecode)::out,
+ int::out, exprn_mode::out, list(type)::out,
+ module_info::in, module_info::out) is det.
% rl_exprn__aggregate(ModuleInfo, InitAccPred, UpdateAccPred,
% GrpByType, NonGrpByType, AccType, ExprnCode, Decls).
@@ -122,9 +123,9 @@
% Given the closures used to create the initial accumulator for each
% group and update the accumulator for each tuple, create
% an expression to evaluate the aggregate.
-:- pred rl_exprn__aggregate(module_info::in, pred_proc_id::in,
- pred_proc_id::in, (type)::in, (type)::in, (type)::in,
- list(bytecode)::out, list(type)::out) is det.
+:- pred rl_exprn__aggregate(pred_proc_id::in, pred_proc_id::in,
+ (type)::in, (type)::in, (type)::in, list(bytecode)::out,
+ list(type)::out, module_info::in, module_info::out) is det.
%-----------------------------------------------------------------------------%
@@ -132,21 +133,28 @@
:- import_module aditi_backend__rl_out.
:- import_module backend_libs__builtin_ops.
+:- import_module backend_libs__rtti.
:- import_module check_hlds__inst_match.
:- import_module check_hlds__mode_util.
:- import_module check_hlds__type_util.
:- import_module hlds__error_util.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_goal.
+:- import_module hlds__goal_util.
:- import_module hlds__hlds_pred.
:- import_module hlds__instmap.
:- import_module hlds__special_pred.
+:- import_module hlds__error_util.
:- import_module libs__tree.
+:- import_module libs__globals.
+:- import_module libs__options.
:- import_module parse_tree__prog_out.
:- import_module parse_tree__prog_util.
+:- import_module parse_tree__inst.
:- import_module transform_hlds__inlining.
+:- import_module backend_libs__name_mangle.
-:- import_module assoc_list, bool, char, int, map.
+:- import_module assoc_list, bool, char, counter, int, map.
:- import_module require, set, std_util, string, term, varset.
% A compare expression tests each attribute in a list of attributes
@@ -592,18 +600,502 @@
%-----------------------------------------------------------------------------%
-rl_exprn__generate(ModuleInfo, RLGoal, Code, NumParams, Mode, Decls) :-
+rl_exprn__generate(RLGoal, Code, NumParams, Mode, Decls,
+ ModuleInfo0, ModuleInfo) :-
RLGoal = rl_goal(_, VarSet, VarTypes, InstMap,
Inputs, MaybeOutputs, Goals, _),
- rl_exprn_info_init(ModuleInfo, InstMap, VarTypes, VarSet, Info0),
- rl_exprn__generate_2(Inputs, MaybeOutputs, Goals,
- Code, NumParams, Mode, Decls, Info0, _).
+ rl_exprn_info_init(ModuleInfo0, InstMap, VarTypes, VarSet, Info0),
+ module_info_globals(ModuleInfo0, Globals),
+ globals__lookup_bool_option(Globals, aditi_calls_mercury,
+ AditiCallsMercury),
+ (
+ %
+ % We prefer to generate code using the
+ % bytecodes if possible, to avoid data conversion.
+ % XXX If there is a simple semidet prefix of the
+ % conjunction, we could generate that using the
+ % bytecodes.
+ %
+ ( AditiCallsMercury = no
+ ; \+ rl_exprn__goal_is_complex(ModuleInfo0,
+ InstMap, Goals)
+ )
+ ->
+ rl_exprn__generate_simple_goal(Inputs, MaybeOutputs, Goals,
+ Code, NumParams, Mode, Decls, Info0, Info)
+ ;
+ rl_exprn__generate_top_down_call(Inputs, MaybeOutputs,
+ Goals, Code, NumParams, Mode, Decls, Info0, Info)
+ ),
+ rl_exprn_info_get_module_info(ModuleInfo, Info, _).
+
+:- pred rl_exprn__goal_is_complex(module_info::in,
+ instmap::in, list(hlds_goal)::in) is semidet.
+
+rl_exprn__goal_is_complex(ModuleInfo, _InstMap, Goals) :-
+ list__member(Goal, Goals),
+ goal_contains_goal(Goal, SubGoal),
+ SubGoal = SubGoalExpr - SubGoalInfo,
+ (
+ goal_info_get_determinism(SubGoalInfo, Detism),
+ determinism_components(Detism, _, at_most_many)
+ ;
+ SubGoalExpr = call(PredId, ProcId, _, _, _, _),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ \+ rl_exprn__is_builtin(PredId, ProcId, PredInfo)
+ ;
+ SubGoalExpr = generic_call(_, _, _, _)
+ ;
+ SubGoalExpr = foreign_proc(_, _, _, _, _, _, _)
+ ;
+ SubGoalExpr = par_conj(_)
+ ;
+ SubGoalExpr = unify(_, _, _, Unification, _),
+ Unification = construct(_, ConsId, _, _, _, _, _),
+ ( ConsId = pred_const(_, _, _)
+ ; ConsId = base_typeclass_info_const(_, _, _, _)
+ ; ConsId = type_ctor_info_const(_, _, _)
+ ; ConsId = tabling_pointer_const(_, _)
+ )
+ ).
+
+:- func rl_exprn__cons_id_is_complex(cons_id) = bool.
+
+rl_exprn__cons_id_is_complex(cons(_, _)) = no.
+rl_exprn__cons_id_is_complex(int_const(_)) = no.
+rl_exprn__cons_id_is_complex(string_const(_)) = no.
+rl_exprn__cons_id_is_complex(float_const(_)) = no.
+rl_exprn__cons_id_is_complex(pred_const(_, _, _)) = yes.
+rl_exprn__cons_id_is_complex(type_ctor_info_const(_, _, _)) = yes.
+rl_exprn__cons_id_is_complex(base_typeclass_info_const(_, _, _, _)) = yes.
+rl_exprn__cons_id_is_complex(type_info_cell_constructor) = yes.
+rl_exprn__cons_id_is_complex(typeclass_info_cell_constructor) = yes.
+rl_exprn__cons_id_is_complex(tabling_pointer_const(_, _)) = yes.
+rl_exprn__cons_id_is_complex(deep_profiling_proc_static(_)) = yes.
+rl_exprn__cons_id_is_complex(table_io_decl(_)) = yes.
+
+%-----------------------------------------------------------------------------%
+
+:- pred rl_exprn__generate_top_down_call(rl_goal_inputs::in,
+ rl_goal_outputs::in, list(hlds_goal)::in, list(bytecode)::out,
+ int::out, exprn_mode::out, list(type)::out,
+ rl_exprn_info::in, rl_exprn_info::out) is det.
+
+rl_exprn__generate_top_down_call(Inputs, MaybeOutputs,
+ GoalList, Code, NumParams, Mode, Decls) -->
+ %
+ % Produce a procedure containing the join condition.
+ %
+ { goal_list_determinism(GoalList, Detism) },
+ { determinism_components(Detism, CanFail, MaxSoln) },
+ { goal_list_nonlocals(GoalList, NonLocals0) },
+ { MaybeOutputs = yes(OutputArgs0) ->
+ OutputArgs = OutputArgs0,
+ set__insert_list(NonLocals0, OutputArgs, NonLocals)
+ ;
+ OutputArgs = [],
+ NonLocals = NonLocals0
+ },
+
+ % XXX It is common for arguments to be passed through a join
+ % condition without being used. In that case we should avoid
+ % the conversion to and from Mercury.
+
+ rl_exprn_info_get_free_reg(int_type, ArgsLoc),
+ rl_exprn_info_reg_is_args_location(ArgsLoc),
+ (
+ { Inputs = no_inputs },
+ { InputArgs = [] }
+ ;
+ { Inputs = one_input(InputVars) },
+ { list__filter(
+ (pred(X::in) is semidet :- set__member(X, NonLocals)),
+ InputVars, InputArgs) }
+ ;
+ { Inputs = two_inputs(InputVars1, InputVars2) },
+ { list__filter(set__contains(NonLocals),
+ list__append(InputVars1, InputVars2),
+ InputArgs) }
+ ),
+ rl_exprn__generate_pop(reg(ArgsLoc), int_type, ArgsLocPopCode),
+ { InputCode =
+ tree(node([rl_EXP_allocate_mercury_input_args(AditiProcId)]),
+ tree(ArgsLocPopCode,
+ InputCode0
+ )) },
+
+ rl_exprn__build_top_down_procedure(InputArgs, OutputArgs, GoalList,
+ DataName, AditiProcId),
+ rl_exprn_info_lookup_const(string(DataName), DataConst),
+ { DeclareCode =
+ node([rl_EXP_declare_mercury_proc(AditiProcId, DataConst)]) },
+
+ (
+ { Inputs = no_inputs },
+ { NumParams = 0 },
+ { InputCode0 = empty }
+ ;
+ { Inputs = one_input(InputVarsB) },
+ { NumParams = 1 },
+ rl_exprn__construct_mercury_input_tuple(ArgsLoc, one, 0,
+ 0, _NumArgs, InputVarsB, NonLocals,
+ AditiProcId, InputCode0)
+ ;
+ { Inputs = two_inputs(InputVars1B, InputVars2B) },
+ { NumParams = 2 },
+ rl_exprn__construct_mercury_input_tuple(ArgsLoc, one, 0,
+ 0, NumArgs1, InputVars1B, NonLocals, AditiProcId,
+ Tuple1InputCode),
+ rl_exprn__construct_mercury_input_tuple(ArgsLoc, two, 0,
+ NumArgs1, _NumArgs, InputVars2B, NonLocals,
+ AditiProcId, Tuple2InputCode),
+ % Build the arguments in reverse order.
+ { InputCode0 = tree(Tuple2InputCode, Tuple1InputCode) }
+ ),
+
+ rl_exprn__generate_push(reg(ArgsLoc), int_type, ArgsLocPushCode),
+ { CallCode = rl_EXP_call_mercury_proc(AditiProcId) },
+ (
+ { CanFail = cannot_fail },
+ { CheckResultCode = rl_EXP_int_pop }
+ ;
+ { CanFail = can_fail },
+ { CheckResultCode = rl_EXP_fail_if_false }
+ ),
+ rl_exprn_info_get_free_reg(int_type, AllResultsReg),
+ rl_exprn__generate_pop(reg(AllResultsReg), int_type,
+ StoreResultLocnCode),
+
+ rl_exprn__cleanup_mercury_value(rl_EXP_clear_mercury_input_args,
+ ArgsLoc, empty, CleanupArgsCode),
+
+ ( { MaxSoln = at_most_many } ->
+ { SetMoreSolutionsCode =
+ node([
+ rl_EXP_int_immed(1),
+ rl_EXP_set_more_solutions
+ ]) }
+ ;
+ { SetMoreSolutionsCode = empty }
+ ),
+
+ { EvalCode0 =
+ tree(InputCode,
+ tree(ArgsLocPushCode,
+ tree(node([CallCode]),
+ tree(CleanupArgsCode,
+ tree(node([CheckResultCode]),
+ tree(StoreResultLocnCode,
+ SetMoreSolutionsCode
+ )))))) },
+
+ ( { MaybeOutputs = yes(OutputArgs) } ->
+ ( { MaxSoln = at_most_many } ->
+ rl_exprn_info_reg_is_multiple_value_location(
+ AllResultsReg),
+ rl_exprn__generate_push(reg(AllResultsReg),
+ int_type, PushNondetResultLocnCode),
+ rl_exprn_info_get_free_reg(int_type, SingleResultReg),
+ rl_exprn__generate_pop(reg(SingleResultReg), int_type,
+ PopSingleResultLocnCode),
+ rl_exprn_info_get_next_label_id(MoreSolutionsLabel),
+ rl_exprn__cleanup_mercury_value(
+ rl_EXP_cleanup_nondet_solution,
+ AllResultsReg, empty, NondetCleanupCode),
+ { RetrieveCode =
+ tree(PushNondetResultLocnCode,
+ tree(node([
+ rl_EXP_retrieve_nondet_solution(AditiProcId)
+ ]),
+ tree(PopSingleResultLocnCode,
+ tree(node([
+ rl_EXP_int_dup,
+ rl_EXP_set_more_solutions,
+ rl_EXP_bnez(MoreSolutionsLabel)
+ ]),
+ tree(NondetCleanupCode,
+ node([
+ rl_PROC_label(MoreSolutionsLabel)
+ ])
+ ))))) }
+ ;
+ { RetrieveCode = empty },
+ { SingleResultReg = AllResultsReg }
+ ),
+ rl_exprn_info_reg_is_single_value_location(SingleResultReg),
+
+ rl_exprn__deconstruct_mercury_output_tuple(SingleResultReg,
+ AditiProcId, OutputArgs, 0, OutputCode),
+
+ rl_exprn__cleanup_mercury_value(rl_EXP_cleanup_single_solution,
+ SingleResultReg, empty, CleanupSingleResultCode),
+
+ { ResultCode =
+ tree(RetrieveCode,
+ tree(OutputCode,
+ CleanupSingleResultCode
+ )) },
+ { EvalCode = EvalCode0 }
+ ;
+ rl_exprn__generate_push(reg(AllResultsReg),
+ int_type, CleanupPushStoreLocnCode),
+ { MaxSoln = at_most_many ->
+ % This probably shouldn't happen.
+ CleanupByteCode = rl_EXP_cleanup_nondet_solution
+ ;
+ CleanupByteCode = rl_EXP_cleanup_single_solution
+ },
+ rl_exprn__cleanup_mercury_value(CleanupByteCode, AllResultsReg,
+ empty, CleanupCode),
+ { EvalCode =
+ tree(EvalCode0,
+ tree(CleanupPushStoreLocnCode,
+ CleanupCode
+ )) },
+ { ResultCode = empty }
+ ),
+
+ { rl_exprn__get_exprn_mode(MaybeOutputs, MaxSoln, Mode) },
+
+ rl_exprn__generate_decls(ConstCode, InitCode, Decls),
+ rl_exprn__cleanup_mercury_values(CleanupMercuryValueCode),
+ { rl_exprn__generate_fragments(ConstCode, tree(DeclareCode, InitCode),
+ empty, EvalCode, ResultCode, CleanupMercuryValueCode, Code) }.
+
+:- pred rl_exprn__construct_mercury_input_tuple(reg_id::in,
+ tuple_num::in, int::in, int::in, int::out, list(prog_var)::in,
+ set(prog_var)::in, mercury_proc_id::in, byte_tree::out,
+ rl_exprn_info::in, rl_exprn_info::out) is det.
+
+rl_exprn__construct_mercury_input_tuple(_, _, _,
+ ArgNum, ArgNum, [], _, _, empty) --> [].
+rl_exprn__construct_mercury_input_tuple(ArgsLoc, Tuple, TupleArg,
+ ArgNum0, ArgNum, [Arg | Args], NonLocals, ProcId, Code) -->
+ rl_exprn_info_lookup_var_type(Arg, Type),
+
+ ( { set__member(Arg, NonLocals) } ->
+ % Push argument location.
+ rl_exprn__generate_push(reg(ArgsLoc), int_type,
+ ArgLocPushCode),
+
+ % Push the argument value.
+ rl_exprn__generate_push(input_field(Tuple, TupleArg),
+ Type, PushCode),
+
+ { rl_exprn__convert_mercury_input_arg_code(Type,
+ ProcId, ArgNum0, ArgCode) },
+ { ArgNum1 = ArgNum0 + 1 },
+ { Code0 = tree(ArgLocPushCode, tree(PushCode, ArgCode)) }
+ ;
+ { ArgNum1 = ArgNum0 },
+ { Code0 = empty }
+ ),
+ rl_exprn__construct_mercury_input_tuple(ArgsLoc, Tuple,
+ TupleArg + 1, ArgNum1, ArgNum, Args, NonLocals,
+ ProcId, Code1),
+ % The expression evaluator expects the arguments to be
+ % passed in reverse order.
+ { Code = tree(Code1, Code0) }.
+
+:- pred rl_exprn__convert_mercury_input_arg_code((type)::in,
+ mercury_proc_id::in, int::in, byte_tree::out) is det.
-:- pred rl_exprn__generate_2(rl_goal_inputs::in, rl_goal_outputs::in,
+rl_exprn__convert_mercury_input_arg_code(Type, ProcId, Arg, Code) :-
+ rl_exprn__type_to_aditi_type(Type, AditiType),
+ (
+ AditiType = int,
+ Bytecode = rl_EXP_convert_int_mercury_input_arg(ProcId, Arg)
+ ;
+ AditiType = string,
+ Bytecode = rl_EXP_convert_str_mercury_input_arg(ProcId, Arg)
+ ;
+ AditiType = float,
+ Bytecode = rl_EXP_convert_flt_mercury_input_arg(ProcId, Arg)
+ ;
+ AditiType = term(_),
+ Bytecode = rl_EXP_convert_term_mercury_input_arg(ProcId, Arg)
+ ),
+ Code = node([Bytecode]).
+
+:- pred rl_exprn__deconstruct_mercury_output_tuple(reg_id::in,
+ mercury_proc_id::in, list(prog_var)::in, int::in,
+ byte_tree::out, rl_exprn_info::in, rl_exprn_info::out) is det.
+
+rl_exprn__deconstruct_mercury_output_tuple(_, _, [], _, empty) --> [].
+rl_exprn__deconstruct_mercury_output_tuple(SolnLocn, ProcId, [Arg | Args],
+ ArgNum, OutputCode) -->
+ rl_exprn__generate_push(reg(SolnLocn), int_type, PushSolnCode),
+ rl_exprn_info_lookup_var_type(Arg, ArgType),
+ { rl_exprn__convert_mercury_output_arg_code(ArgType, ProcId,
+ ArgNum, ArgNum, OutputCode0) },
+ rl_exprn__deconstruct_mercury_output_tuple(SolnLocn, ProcId, Args,
+ ArgNum + 1, OutputCode1),
+ { OutputCode = tree(PushSolnCode, tree(OutputCode0, OutputCode1)) }.
+
+:- pred rl_exprn__convert_mercury_output_arg_code((type)::in,
+ mercury_proc_id::in, int::in, int::in, byte_tree::out) is det.
+
+rl_exprn__convert_mercury_output_arg_code(Type, ProcId, Arg, Attr, Code) :-
+ rl_exprn__type_to_aditi_type(Type, AditiType),
+ (
+ AditiType = int,
+ Bytecode = rl_EXP_convert_int_mercury_output_arg(ProcId,
+ Arg, Attr)
+ ;
+ AditiType = string,
+ Bytecode = rl_EXP_convert_str_mercury_output_arg(ProcId,
+ Arg, Attr)
+ ;
+ AditiType = float,
+ Bytecode = rl_EXP_convert_flt_mercury_output_arg(ProcId,
+ Arg, Attr)
+ ;
+ AditiType = term(_),
+ Bytecode = rl_EXP_convert_term_mercury_output_arg(ProcId,
+ Arg, Attr)
+ ),
+ Code = node([Bytecode]).
+
+:- pred rl_exprn__build_top_down_procedure(list(prog_var)::in,
+ list(prog_var)::in, list(hlds_goal)::in, string::out, int::out,
+ rl_exprn_info::in, rl_exprn_info::out) is det.
+
+rl_exprn__build_top_down_procedure(InputArgs, OutputArgs,
+ Goals, DataName, AditiProcId) -->
+ rl_exprn__name_top_down_procedure(AditiProcId, ProcName),
+ { init_markers(Markers) },
+ { Owner = "" },
+ { IsAddressTaken = address_is_taken },
+
+ % XXX magic.m should arrange for these to be passed in
+ % if the top-down goal has any existentially quantified
+ % type variables.
+ { varset__init(TVarSet) },
+ { varset__init(InstVarSet) },
+ { map__init(TVarMap) },
+ { map__init(TCVarMap) },
+ rl_exprn_info_get_varset(VarSet0),
+ rl_exprn_info_get_vartypes(VarTypes0),
+ rl_exprn_info_get_instmap(InstMap),
+ rl_exprn_info_get_module_info(ModuleInfo0),
+
+ { varset__new_var(VarSet0, InputTupleVar, VarSet1) },
+ { varset__new_var(VarSet1, OutputTupleVar, VarSet) },
+ { map__apply_to_list(InputArgs, VarTypes0, InputArgTypes) },
+ { map__apply_to_list(OutputArgs, VarTypes0, OutputArgTypes) },
+ { construct_type(unqualified("{}") - list__length(InputArgTypes),
+ InputArgTypes, InputTupleType) },
+ { construct_type(unqualified("{}") - list__length(InputArgTypes),
+ OutputArgTypes, OutputTupleType) },
+ { map__det_insert(VarTypes0, InputTupleVar,
+ InputTupleType, VarTypes1) },
+ { map__det_insert(VarTypes1, OutputTupleVar,
+ OutputTupleType, VarTypes) },
+
+ { deconstruct_tuple(InputTupleVar, InputArgs, InputTupleGoal) },
+ { construct_tuple(OutputTupleVar, OutputArgs, OutputTupleGoal) },
+ { AllGoals = list__append([InputTupleGoal | Goals],
+ [OutputTupleGoal]) },
+ { instmap__lookup_vars(InputArgs, InstMap, InputInsts) },
+ { goal_list_instmap_delta(Goals, InstMapDelta) },
+ { instmap__apply_instmap_delta(InstMap, InstMapDelta, FinalInstMap) },
+ { instmap__lookup_vars(OutputArgs, FinalInstMap, FinalOutputInsts) },
+
+ { InputTupleConsId = cons(unqualified("{}"),
+ list__length(InputArgs)) },
+ { InputTupleInst = bound(unique,
+ [functor(InputTupleConsId, InputInsts)]) },
+
+ { OutputTupleConsId = cons(unqualified("{}"),
+ list__length(OutputArgs)) },
+ { OutputTupleInst = bound(unique,
+ [functor(OutputTupleConsId, FinalOutputInsts)]) },
+
+ { instmap__init_reachable(InitialInstMap0) },
+ { instmap__set(InitialInstMap0, InputTupleVar, InputTupleInst,
+ InitialInstMap) },
+
+ { instmap_delta_from_assoc_list([OutputTupleVar - OutputTupleInst],
+ GoalInstMapDelta) },
+ { goal_list_determinism(Goals, Detism) },
+ { goal_info_init(list_to_set([InputTupleVar, OutputTupleVar]),
+ GoalInstMapDelta, Detism, pure, GoalInfo) },
+ { conj_list_to_goal(AllGoals, GoalInfo, Goal) },
+
+ { ClassContext = constraints([], []) },
+ { PredArgs = [InputTupleVar, OutputTupleVar] },
+ { hlds_pred__define_new_pred(Goal, _CallGoal, PredArgs, _ExtraArgs,
+ InitialInstMap, ProcName, TVarSet, VarTypes, ClassContext,
+ TVarMap, TCVarMap, VarSet, InstVarSet, Markers, Owner,
+ IsAddressTaken, ModuleInfo0, ModuleInfo1, PredProcId) },
+
+ { PredProcId = proc(PredId, ProcId) },
+ { rtti__id_to_c_identifier(
+ aditi_rtti_id(rtti__make_rtti_proc_label(ModuleInfo1,
+ PredId, ProcId)),
+ DataName0) },
+ { DataName = mercury_data_prefix ++ DataName0 },
+
+ { module_info_aditi_top_down_procs(ModuleInfo1, Procs0) },
+ { module_info_set_aditi_top_down_procs(ModuleInfo1,
+ [aditi_top_down_proc(PredProcId, DataName) | Procs0],
+ ModuleInfo) },
+ rl_exprn_info_set_module_info(ModuleInfo).
+
+:- pred rl_exprn__name_top_down_procedure(mercury_proc_id::out, string::out,
+ rl_exprn_info::in, rl_exprn_info::out) is det.
+
+rl_exprn__name_top_down_procedure(ExprnProcId, ProcName) -->
+ rl_exprn_info_get_next_mercury_proc(ModuleProcId, ExprnProcId),
+
+ rl_exprn_info_get_module_info(ModuleInfo0),
+ { module_info_name(ModuleInfo0, ModuleName) },
+ { ModuleStr = sym_name_mangle(ModuleName) },
+ { ProcName = string__append_list(
+ [ModuleStr, "__aditi_proc__", int_to_string(ModuleProcId)]) }.
+
+:- pred rl_exprn__cleanup_mercury_values(byte_tree::out,
+ rl_exprn_info::in, rl_exprn_info::out) is det.
+
+rl_exprn__cleanup_mercury_values(CleanupCode) -->
+ DetValues =^ single_value_locations,
+ NondetValues =^ multiple_value_locations,
+ ArgsValues =^ input_args_locations,
+ list__foldl2(
+ rl_exprn__cleanup_mercury_value(rl_EXP_cleanup_single_solution),
+ DetValues, empty, DetCleanupCode),
+ list__foldl2(
+ rl_exprn__cleanup_mercury_value(rl_EXP_cleanup_nondet_solution),
+ NondetValues, DetCleanupCode, DetAndNondetCleanupCode),
+ list__foldl2(
+ rl_exprn__cleanup_mercury_value(rl_EXP_clear_mercury_input_args),
+ ArgsValues, DetAndNondetCleanupCode, CleanupCode).
+
+:- pred rl_exprn__cleanup_mercury_value(bytecode::in, reg_id::in,
+ byte_tree::in, byte_tree::out,
+ rl_exprn_info::in, rl_exprn_info::out) is det.
+
+rl_exprn__cleanup_mercury_value(CleanupBytecode, Reg,
+ CleanupCode0, CleanupCode) -->
+ rl_exprn__generate_push(reg(Reg), int_type, PushCode),
+ rl_exprn__generate_pop(reg(Reg), int_type, PopCode),
+ { CleanupCode =
+ tree(CleanupCode0,
+ tree(PushCode,
+ tree(node([
+ CleanupBytecode,
+ rl_EXP_invalid_solution_location
+ ]),
+ PopCode
+ ))) }.
+
+%-----------------------------------------------------------------------------%
+
+:- pred rl_exprn__generate_simple_goal(rl_goal_inputs::in, rl_goal_outputs::in,
list(hlds_goal)::in, list(bytecode)::out, int::out, exprn_mode::out,
list(type)::out, rl_exprn_info::in, rl_exprn_info::out) is det.
-rl_exprn__generate_2(Inputs, MaybeOutputs, GoalList,
+rl_exprn__generate_simple_goal(Inputs, MaybeOutputs, GoalList,
Code, NumParams, Mode, Decls) -->
{ goal_list_determinism(GoalList, Detism) },
{ determinism_components(Detism, CanFail, _) },
@@ -643,11 +1135,9 @@
( { MaybeOutputs = yes(OutputVars) } ->
rl_exprn__construct_output_tuple(GoalList,
- OutputVars, OutputCode),
- { Mode = generate }
+ OutputVars, OutputCode)
;
- { OutputCode = empty },
- { Mode = test }
+ { OutputCode = empty }
),
{
@@ -669,6 +1159,8 @@
rl_exprn__resolve_addresses(ProjectCode0, ProjectCode)
},
+ { rl_exprn__get_exprn_mode(MaybeOutputs, at_most_one, Mode) },
+
% Need to do the init code last, since it also needs to define
% the rule constants for the other fragments.
rl_exprn__generate_decls(ConstCode, InitCode, Decls),
@@ -709,6 +1201,20 @@
tree__flatten(CodeTree, Code0),
list__condense(Code0, Code).
+:- pred rl_exprn__get_exprn_mode(rl_goal_outputs::in,
+ soln_count::in, exprn_mode::out) is det.
+
+rl_exprn__get_exprn_mode(MaybeOutputs, MaxSoln, Mode) :-
+ ( MaybeOutputs = yes(_) ->
+ ( MaxSoln = at_most_many ->
+ Mode = generate_nondet
+ ;
+ Mode = generate
+ )
+ ;
+ Mode = test
+ ).
+
:- pred rl_exprn__generate_decls(byte_tree::out, byte_tree::out,
list(type)::out, rl_exprn_info::in, rl_exprn_info::out) is det.
@@ -724,7 +1230,8 @@
{ assoc_list__reverse_members(ConstsAL, ConstsLA0) },
{ list__sort(ConstsLA0, ConstsLA) },
{ list__map(rl_exprn__generate_const_decl, ConstsLA, ConstCode) },
- rl_exprn_info_get_decls(VarTypes).
+ rl_exprn_info_get_decls(VarTypes0),
+ { list__reverse(VarTypes0, VarTypes) }.
:- pred rl_exprn__generate_const_decl(pair(int, rl_const)::in,
bytecode::out) is det.
@@ -771,7 +1278,7 @@
%-----------------------------------------------------------------------------%
- % Shift the inputs to the expression out of the input tuple.
+ % Move the inputs to the expression out of the input tuple.
:- pred rl_exprn__deconstruct_input_tuple(tuple_num::in, int::in,
list(prog_var)::in, set(prog_var)::in, byte_tree::out,
rl_exprn_info::in, rl_exprn_info::out) is det.
@@ -945,22 +1452,8 @@
ModuleInfo, PredId, ProcId,
"nondeterministic Mercury calls in Aditi procedures") }
;
- % XXX Top-down calls to imported predicates
- % are not yet implemented.
{ pred_info_is_imported(PredInfo) },
-
- % Calls to `unify/2' and `compare/3' will have been
- % transformed into the type-specific versions
- % by polymorphism.m. Polymorphic types are not allowed
- % in Aditi predicates so the types must be known.
- \+ {
- % `index/2' doesn't work in Aditi.
- is_unify_or_compare_pred(PredInfo),
- \+ pred_info_name(PredInfo, "__Index__")
- },
- { \+ pred_info_is_builtin(PredInfo) },
- { \+ rl_exprn__is_simple_extra_aditi_builtin(PredInfo,
- ProcId, _) }
+ { \+ rl_exprn__is_builtin(PredId, ProcId, PredInfo) }
->
{ goal_info_get_context(GoalInfo, Context) },
{ rl_exprn__call_not_implemented_error(Context,
@@ -979,6 +1472,28 @@
Fail, Vars, Code)
).
+:- pred rl_exprn__is_builtin(pred_id::in, proc_id::in,
+ pred_info::in) is semidet.
+
+rl_exprn__is_builtin(_PredId, ProcId, PredInfo) :-
+ % Calls to `unify/2' and `compare/3' will have been
+ % transformed into the type-specific versions
+ % by polymorphism.m. Polymorphic types are not allowed
+ % in Aditi predicates so the types must be known.
+ \+ (
+ % `index/2' doesn't work in Aditi.
+ is_unify_or_compare_pred(PredInfo),
+ \+ pred_info_name(PredInfo, "__Index__")
+ ),
+ (
+ pred_info_is_builtin(PredInfo)
+ ;
+ is_unify_or_compare_pred(PredInfo)
+ ;
+ rl_exprn__is_simple_extra_aditi_builtin(PredInfo,
+ ProcId, _)
+ ).
+
:- pred rl_exprn__call_not_implemented_error(prog_context::in, module_info::in,
pred_id::in, proc_id::in, string::in) is erroneous.
@@ -1775,15 +2290,16 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-rl_exprn__aggregate(ModuleInfo, ComputeInitial, UpdateAcc, GrpByType,
- NonGrpByType, AccType, AggCode, Decls) :-
-
+rl_exprn__aggregate(ComputeInitial, UpdateAcc, GrpByType,
+ NonGrpByType, AccType, AggCode, Decls,
+ ModuleInfo0, ModuleInfo) :-
map__init(VarTypes),
varset__init(VarSet),
instmap__init_reachable(InstMap),
- rl_exprn_info_init(ModuleInfo, InstMap, VarTypes, VarSet, Info0),
+ rl_exprn_info_init(ModuleInfo0, InstMap, VarTypes, VarSet, Info0),
rl_exprn__aggregate_2(ComputeInitial, UpdateAcc, GrpByType,
- NonGrpByType, AccType, AggCode, Decls, Info0, _).
+ NonGrpByType, AccType, AggCode, Decls, Info0, Info),
+ rl_exprn_info_get_module_info(ModuleInfo, Info, _).
:- pred rl_exprn__aggregate_2(pred_proc_id::in, pred_proc_id::in,
(type)::in, (type)::in, (type)::in, list(bytecode)::out,
@@ -2200,6 +2716,10 @@
rl_exprn_info, rl_exprn_info).
:- mode rl_exprn_info_get_module_info(out, in, out) is det.
+:- pred rl_exprn_info_set_module_info(module_info,
+ rl_exprn_info, rl_exprn_info).
+:- mode rl_exprn_info_set_module_info(in, in, out) is det.
+
:- pred rl_exprn_info_get_instmap(instmap, rl_exprn_info, rl_exprn_info).
:- mode rl_exprn_info_get_instmap(out, in, out) is det.
@@ -2233,6 +2753,15 @@
rl_exprn_info, rl_exprn_info).
:- mode rl_exprn_info_get_free_reg(in, out, in, out) is det.
+:- pred rl_exprn_info_reg_is_single_value_location(reg_id::in,
+ rl_exprn_info::in, rl_exprn_info::out) is det.
+
+:- pred rl_exprn_info_reg_is_multiple_value_location(reg_id::in,
+ rl_exprn_info::in, rl_exprn_info::out) is det.
+
+:- pred rl_exprn_info_reg_is_args_location(reg_id::in,
+ rl_exprn_info::in, rl_exprn_info::out) is det.
+
:- pred rl_exprn_info_get_next_label_id(label_id,
rl_exprn_info, rl_exprn_info).
:- mode rl_exprn_info_get_next_label_id(out, in, out) is det.
@@ -2278,19 +2807,36 @@
:- type rl_exprn_info
---> rl_exprn_info(
- module_info,
- instmap, % not yet used.
- map(prog_var, type),
- prog_varset,
- id_map(prog_var),
- label_id, % next label.
- id_map(rl_const),
- id_map(pair(rl_rule, exprn_tuple)),
- set(pred_proc_id), % parent pred_proc_ids, used
+ module_info :: module_info,
+ instmap :: instmap, % not yet used.
+ vartypes :: map(prog_var, type),
+ varset :: prog_varset,
+ vars :: id_map(prog_var),
+ label_counter :: counter, % next label.
+ consts :: id_map(rl_const),
+ rules :: id_map(pair(rl_rule, exprn_tuple)),
+ parent_proc_ids :: set(pred_proc_id),
+ % parent pred_proc_ids, used
% to abort on recursion.
- list(type) % variable declarations in reverse.
+ decls :: list(type), % variable declarations in reverse.
+ mercury_proc_counter :: counter,
+
+ % The solution for a call to a det top-down Mercury
+ % procedure is stored in one of these locations.
+ single_value_locations :: list(reg_id),
+
+ % All solutions for a call to a nondet top-down Mercury
+ % procedure are stored in one of these locations.
+ multiple_value_locations :: list(reg_id),
+
+ % The input arguments for a call to a top-down Mercury
+ % procedure are collected into a tuple stored
+ % in one of these locations.
+ input_args_locations :: list(reg_id)
).
+:- type mercury_proc_id == int.
+
:- type rl_rule
---> rl_rule(
string, % mangled type name Module__Name
@@ -2347,74 +2893,89 @@
id_map_init(ConstMap),
id_map_init(RuleMap),
set__init(Parents),
- Label = 0,
+ counter__init(0, Label),
+ counter__init(0, NextMercuryProc),
Info = rl_exprn_info(ModuleInfo, InstMap, VarTypes, VarSet,
- VarMap, Label, ConstMap, RuleMap, Parents, []).
+ VarMap, Label, ConstMap, RuleMap, Parents, [],
+ NextMercuryProc, [], [], []).
+
+rl_exprn_info_get_module_info(Info ^ module_info, Info, Info).
+rl_exprn_info_get_instmap(Info ^ instmap, Info, Info).
+rl_exprn_info_get_vartypes(Info ^ vartypes, Info, Info).
+rl_exprn_info_get_varset(Info ^ varset, Info, Info).
+rl_exprn_info_get_vars(Info ^ vars, Info, Info).
+rl_exprn_info_get_consts(Info ^ consts, Info, Info).
+rl_exprn_info_get_rules(Info ^ rules, Info, Info).
+rl_exprn_info_get_parent_pred_proc_ids(Info ^ parent_proc_ids, Info, Info).
+rl_exprn_info_get_decls(Info ^ decls, Info, Info).
+
+rl_exprn_info_set_module_info(ModuleInfo,
+ Info, Info ^ module_info := ModuleInfo).
+rl_exprn_info_set_instmap(InstMap, Info, Info ^ instmap := InstMap).
+rl_exprn_info_set_vartypes(VarTypes, Info, Info ^ vartypes := VarTypes).
+rl_exprn_info_set_varset(VarSet, Info, Info ^ varset := VarSet).
+rl_exprn_info_set_vars(Vars, Info, Info ^ vars := Vars).
+rl_exprn_info_set_parent_pred_proc_ids(ParentProcIds,
+ Info, Info ^ parent_proc_ids := ParentProcIds).
+
+:- pred rl_exprn_info_get_next_mercury_proc(int::out, mercury_proc_id::out,
+ rl_exprn_info::in, rl_exprn_info::out) is det.
+
+rl_exprn_info_get_next_mercury_proc(ModuleProcId, ExprnProcId, Info0, Info) :-
+ Counter0 = Info0 ^ mercury_proc_counter,
+ counter__allocate(ExprnProcId, Counter0, Counter),
+ module_info_next_aditi_top_down_proc(Info0 ^ module_info,
+ ModuleProcId, ModuleInfo),
+ Info = (Info0 ^ module_info := ModuleInfo)
+ ^ mercury_proc_counter := Counter.
-rl_exprn_info_get_module_info(A, Info, Info) :-
- Info = rl_exprn_info(A,_,_,_,_,_,_,_,_,_).
-rl_exprn_info_get_instmap(B, Info, Info) :-
- Info = rl_exprn_info(_,B,_,_,_,_,_,_,_,_).
-rl_exprn_info_get_vartypes(C, Info, Info) :-
- Info = rl_exprn_info(_,_,C,_,_,_,_,_,_,_).
-rl_exprn_info_get_varset(D, Info, Info) :-
- Info = rl_exprn_info(_,_,_,D,_,_,_,_,_,_).
-rl_exprn_info_get_vars(E, Info, Info) :-
- Info = rl_exprn_info(_,_,_,_,E,_,_,_,_,_).
-rl_exprn_info_get_consts(G, Info, Info) :-
- Info = rl_exprn_info(_,_,_,_,_,_,G,_,_,_).
-rl_exprn_info_get_rules(H, Info, Info) :-
- Info = rl_exprn_info(_,_,_,_,_,_,_,H,_,_).
-rl_exprn_info_get_parent_pred_proc_ids(I, Info, Info) :-
- Info = rl_exprn_info(_,_,_,_,_,_,_,_,I,_).
-rl_exprn_info_get_decls(J, Info, Info) :-
- Info = rl_exprn_info(_,_,_,_,_,_,_,_,_,J0),
- list__reverse(J0, J).
-
-rl_exprn_info_set_instmap(B, Info0, Info) :-
- Info0 = rl_exprn_info(A,_,C,D,E,F,G,H,I,J),
- Info = rl_exprn_info(A,B,C,D,E,F,G,H,I,J).
-rl_exprn_info_set_vartypes(C, Info0, Info) :-
- Info0 = rl_exprn_info(A,B,_,D,E,F,G,H,I,J),
- Info = rl_exprn_info(A,B,C,D,E,F,G,H,I,J).
-rl_exprn_info_set_varset(D, Info0, Info) :-
- Info0 = rl_exprn_info(A,B,C,_,E,F,G,H,I,J),
- Info = rl_exprn_info(A,B,C,D,E,F,G,H,I,J).
-rl_exprn_info_set_vars(E, Info0, Info) :-
- Info0 = rl_exprn_info(A,B,C,D,_,F,G,H,I,J),
- Info = rl_exprn_info(A,B,C,D,E,F,G,H,I,J).
-rl_exprn_info_set_parent_pred_proc_ids(I, Info0, Info) :-
- Info0 = rl_exprn_info(A,B,C,D,E,F,G,H,_,J),
- Info = rl_exprn_info(A,B,C,D,E,F,G,H,I,J).
rl_exprn_info_get_free_reg(Type, Loc, Info0, Info) :-
- Info0 = rl_exprn_info(A,B,C,D,VarMap0,F,G,H,I,RegTypes0),
+ VarMap0 = Info0 ^ vars,
+ RegTypes0 = Info0 ^ decls,
VarMap0 = Map - Loc,
Loc1 = Loc + 1,
VarMap = Map - Loc1,
RegTypes = [Type | RegTypes0],
- Info = rl_exprn_info(A,B,C,D,VarMap,F,G,H,I,RegTypes).
+ Info = (Info0 ^ vars := VarMap)
+ ^ decls := RegTypes.
rl_exprn_info_lookup_var(Var, Loc, Info0, Info) :-
- Info0 = rl_exprn_info(A,B,VarTypes,D,VarMap0,F,G,H,I,RegTypes0),
+ VarMap0 = Info0 ^ vars,
+ RegTypes0 = Info0 ^ decls,
id_map_lookup(Var, Loc, Added, VarMap0, VarMap),
( Added = yes ->
- map__lookup(VarTypes, Var, Type),
+ map__lookup(Info0 ^ vartypes, Var, Type),
RegTypes = [Type | RegTypes0]
;
RegTypes = RegTypes0
),
- Info = rl_exprn_info(A,B,VarTypes,D,VarMap,F,G,H,I,RegTypes).
-rl_exprn_info_get_next_label_id(Label0, Info0, Info) :-
- Info0 = rl_exprn_info(A,B,C,D,E,Label0,G,H,I,J),
- Label = Label0 + 1,
- Info = rl_exprn_info(A,B,C,D,E,Label,G,H,I,J).
+ Info = (Info0 ^ vars := VarMap)
+ ^ decls := RegTypes.
+
+rl_exprn_info_reg_is_single_value_location(Reg, Info,
+ Info ^ single_value_locations := Locs) :-
+ Locs = [Reg | Info ^ single_value_locations].
+
+rl_exprn_info_reg_is_multiple_value_location(Reg, Info,
+ Info ^ multiple_value_locations := Locs) :-
+ Locs = [Reg | Info ^ multiple_value_locations].
+
+rl_exprn_info_reg_is_args_location(Reg, Info,
+ Info ^ input_args_locations := Locs) :-
+ Locs = [Reg | Info ^ input_args_locations].
+
+rl_exprn_info_get_next_label_id(Label, Info0,
+ Info0 ^ label_counter := Counter) :-
+ counter__allocate(Label, Info0 ^ label_counter, Counter).
+
rl_exprn_info_lookup_const(Const, Loc, Info0, Info) :-
- Info0 = rl_exprn_info(A,B,C,D,E,F,Consts0,H,I,J),
+ Consts0 = Info0 ^ consts,
id_map_lookup(Const, Loc, Consts0, Consts),
- Info = rl_exprn_info(A,B,C,D,E,F,Consts,H,I,J).
+ Info = Info0 ^ consts := Consts.
+
rl_exprn_info_lookup_rule(Rule, Loc, Info0, Info) :-
- Info0 = rl_exprn_info(A,B,C,D,E,F,G,Rules0,I,J),
+ Rules0 = Info0 ^ rules,
id_map_lookup(Rule, Loc, Rules0, Rules),
- Info = rl_exprn_info(A,B,C,D,E,F,G,Rules,I,J).
+ Info = Info0 ^ rules := Rules.
rl_exprn_info_lookup_var_type(Var, Type) -->
rl_exprn_info_get_vartypes(VarTypes),
Index: compiler/rl_file.pp
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_file.pp,v
retrieving revision 1.5
diff -u -u -r1.5 rl_file.pp
--- compiler/rl_file.pp 26 May 2003 09:00:08 -0000 1.5
+++ compiler/rl_file.pp 30 Sep 2003 10:22:08 -0000
@@ -107,11 +107,13 @@
; generate % generates one output tuple
; generate2 % generates two output tuples - used for
% B-tree key ranges.
+ ; generate_nondet % generates one output tuple.
+ % The `result' expression fragment
+ % can be called multiple times to
+ % return all the solutions.
.
#else
-:- import_module std_util.
-
-:- type rl_file == unit.
+:- type rl_file ---> rl_file.
#endif
%-----------------------------------------------------------------------------%
:- implementation.
@@ -345,6 +347,9 @@
;
ExprnMode = generate2,
Mode = 3
+ ;
+ ExprnMode = generate_nondet,
+ Mode = 4
).
:- pred rl_file__output_bytecodes(writer::writer, list(bytecode)::in,
Index: compiler/rl_out.pp
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_out.pp,v
retrieving revision 1.21
diff -u -u -r1.21 rl_out.pp
--- compiler/rl_out.pp 26 May 2003 09:00:08 -0000 1.21
+++ compiler/rl_out.pp 30 Sep 2003 10:22:08 -0000
@@ -43,8 +43,9 @@
% `<module>.derived_schema' if --generate-schemas was set.
% If --aditi-only is not set, return the rl_file containing
% bytecodes to be output as constant data in the C file.
-:- pred rl_out__generate_rl_bytecode(module_info::in, list(rl_proc)::in,
- maybe(rl_file)::out, io__state::di, io__state::uo) is det.
+:- pred rl_out__generate_rl_bytecode(list(rl_proc)::in,
+ maybe(rl_file)::out, module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
#if INCLUDE_ADITI_OUTPUT % See ../Mmake.common.in.
% Given a predicate to update the labels in a bytecode, update
@@ -212,8 +213,8 @@
#if INCLUDE_ADITI_OUTPUT % See ../Mmake.common.in,
-rl_out__generate_rl_bytecode(ModuleInfo, Procs, MaybeRLFile) -->
- { module_info_name(ModuleInfo, ModuleName0) },
+rl_out__generate_rl_bytecode(Procs, MaybeRLFile, ModuleInfo0, ModuleInfo) -->
+ { module_info_name(ModuleInfo0, ModuleName0) },
module_name_to_file_name(ModuleName0, ".rlo", yes, RLOName),
module_name_to_file_name(ModuleName0, ".rla", yes, RLAName),
globals__io_lookup_bool_option(verbose, Verbose),
@@ -222,11 +223,11 @@
maybe_write_string(Verbose, "'..."),
maybe_flush_output(Verbose),
- { rl_out_info_init(ModuleInfo, RLInfo0) },
+ { rl_out_info_init(ModuleInfo0, RLInfo0) },
{ list__foldl(rl_out__generate_proc_bytecode, Procs,
RLInfo0, RLInfo1) },
- { module_info_predids(ModuleInfo, PredIds) },
+ { module_info_predids(ModuleInfo0, PredIds) },
{ list__foldl(rl_out__generate_update_procs, PredIds,
RLInfo1, RLInfo2) },
@@ -246,7 +247,8 @@
{ rl_out_info_get_consts(Consts, RLInfo7, RLInfo8) },
{ rl_out_info_get_permanent_relations(PermRelsSet,
RLInfo8, RLInfo9) },
- { rl_out_info_get_relation_variables(RelVars, RLInfo9, _) },
+ { rl_out_info_get_relation_variables(RelVars, RLInfo9, RLInfo10) },
+ { rl_out_info_get_module_info(ModuleInfo, RLInfo10, _) },
{ map__to_assoc_list(Consts, ConstsAL) },
{ assoc_list__reverse_members(ConstsAL, ConstsLA0) },
@@ -657,8 +659,8 @@
{ set__to_sorted_list(MemoedRels, MemoedList) },
( { MemoedList = [] } ->
- { CollectCode = [] },
- { NameCode = [] },
+ { CollectCode = empty },
+ { NameCode = empty },
{ GroupCode = empty }
;
% If one memoed relation is dropped, all must be
@@ -667,8 +669,16 @@
{ Name = rl_proc_name(Owner, _, _, _) },
rl_out__collect_memoed_relations(Owner, Name, MemoedList, 0,
CollectCode, NameCode),
- rl_out__get_rel_var_list(MemoedList, RelVarCodes),
- { GroupCode = tree(node([rl_PROC_grouprels]), RelVarCodes) }
+
+ % If one of the memoed relations is dropped,
+ % all others in this procedure must be dropped
+ % for correctness. In the current Aditi implementation
+ % relations are not garbage collected implicitly so
+ % nothing needs to be done.
+ %
+ % rl_out__get_rel_var_list(MemoedList, RelVarCodes),
+ % { GroupCode = tree(node([rl_PROC_grouprels]), RelVarCodes) }
+ { GroupCode = empty }
),
rl_out_info_get_relation_addrs(Addrs),
@@ -680,9 +690,9 @@
{ RLInstrCodeTree =
tree(node(PermRelCodes),
- tree(node(CollectCode),
+ tree(CollectCode,
tree(RLInstrCodeTree1,
- tree(node(NameCode),
+ tree(NameCode,
tree(GroupCode,
tree(node(PermUnsetCodes),
node([rl_PROC_ret])
@@ -721,24 +731,19 @@
%-----------------------------------------------------------------------------%
% Temporaries in Aditi are reference counted. If the count on a
- % temporary goes to zero, it may be garbage collected. For relations
+ % temporary goes to zero, it will be garbage collected. For relations
% which are memoed, we do not inhibit garbage collection by
- % holding a reference to them. Instead we just give them a name
- % by which we can retrieve the relation later. If the system does
- % not need to garbage collect the relation between calls, it
- % will be used, otherwise it will be reinitialised. If one
- % memoed relation in a procedure is dropped, all must be dropped
- % to maintain correctness. Aditi should prefer to drop unnamed
- % temporaries to named ones, since unnamed temporaries cannot
- % possibly be used later.
+ % holding a reference to them between calls. Instead we just give
+ % them a name by which we can retrieve the relation later.
:- pred rl_out__collect_memoed_relations(string::in, rl_proc_name::in,
- list(relation_id)::in, int::in, list(bytecode)::out,
- list(bytecode)::out, rl_out_info::in,
+ list(relation_id)::in, int::in, byte_tree::out,
+ byte_tree::out, rl_out_info::in,
rl_out_info::out) is det.
-rl_out__collect_memoed_relations(_, _, [], _, [], []) --> [].
+rl_out__collect_memoed_relations(_, _, [], _, empty, empty) --> [].
rl_out__collect_memoed_relations(Owner, ProcName, [Rel | Rels], Counter0,
- [GetCode | GetCodes], [NameCode, DropCode | NameCodes]) -->
+ tree(node([GetCode]), GetCodes),
+ tree(node([NameCode, DropCode]), NameCodes)) -->
rl_out_info_get_relation_addr(Rel, Addr),
rl_out_info_get_relation_schema_offset(Rel, SchemaOffset),
@@ -1065,18 +1070,10 @@
% will also add any necessary indexes.
rl_out__generate_instr(init(OutputRel) - "", InitCode),
- rl_out_info_get_next_materialise_id(Id),
- { Code =
- tree(InitCode,
- node([
- rl_PROC_materialise(Id),
- rl_PROC_stream,
- rl_PROC_var(InputAddr, 0),
- rl_PROC_stream_end,
- rl_PROC_var_list_cons(OutputAddr, 0),
- rl_PROC_var_list_nil
- ])
- ) }.
+ rl_out__generate_copy_materialise(OutputAddr, InputAddr,
+ MaterialiseCode),
+ { Code = tree(InitCode, MaterialiseCode) }.
+
rl_out__generate_instr(make_unique(OutputRel, Input) - Comment, Code) -->
% if (one_reference(InputRel)) {
% OutputRel = add_index(InputRel)
@@ -1136,6 +1133,20 @@
rl_out__generate_stream_instruction(Output, InstrCode, Code).
rl_out__generate_instr(comment - _, empty) --> [].
+:- pred rl_out__generate_copy_materialise(int::in, int::in, byte_tree::out,
+ rl_out_info::in, rl_out_info::out) is det.
+
+rl_out__generate_copy_materialise(OutputAddr, InputAddr, Code) -->
+ rl_out_info_get_next_materialise_id(Id),
+ { Code = node([
+ rl_PROC_materialise(Id),
+ rl_PROC_stream,
+ rl_PROC_var(InputAddr, 0),
+ rl_PROC_stream_end,
+ rl_PROC_var_list_cons(OutputAddr, 0),
+ rl_PROC_var_list_nil
+ ]) }.
+
%-----------------------------------------------------------------------------%
:- pred rl_out__generate_join(output_rel::in, relation_id::in,
@@ -2186,9 +2197,10 @@
rl_out__generate_exprn(RLGoal, OutputSchemaOffset, ExprnNum) -->
- rl_out_info_get_module_info(ModuleInfo),
- { rl_exprn__generate(ModuleInfo, RLGoal, ExprnCode,
- NumParams, ExprnMode, Decls) },
+ rl_out_info_get_module_info(ModuleInfo0),
+ { rl_exprn__generate(RLGoal, ExprnCode,
+ NumParams, ExprnMode, Decls, ModuleInfo0, ModuleInfo) },
+ rl_out_info_set_module_info(ModuleInfo),
rl_out__schema_to_string([], EmptySchemaOffset),
% Nothing is built on the stack, so this will be enough.
@@ -2210,9 +2222,11 @@
{ InputSchema = [GrpByType, NonGrpByType] },
{ OutputSchema = [_, AccType] }
->
- rl_out_info_get_module_info(ModuleInfo),
- { rl_exprn__aggregate(ModuleInfo, ComputeInitial, UpdateAcc,
- GrpByType, NonGrpByType, AccType, AggCode, Decls) },
+ rl_out_info_get_module_info(ModuleInfo0),
+ { rl_exprn__aggregate(ComputeInitial, UpdateAcc, GrpByType,
+ NonGrpByType, AccType, AggCode, Decls,
+ ModuleInfo0, ModuleInfo) },
+ rl_out_info_set_module_info(ModuleInfo),
rl_out__schema_to_string([], EmptySchemaOffset),
% Nothing is built on the stack, so this will be enough.
@@ -2667,6 +2681,11 @@
rl_out_info::out) is det.
rl_out_info_get_module_info(ModuleInfo) --> ModuleInfo =^ module_info.
+
+:- pred rl_out_info_set_module_info(module_info::in, rl_out_info::in,
+ rl_out_info::out) is det.
+
+rl_out_info_set_module_info(ModuleInfo) --> ^ module_info := ModuleInfo.
%-----------------------------------------------------------------------------%
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.34
diff -u -u -r1.34 rtti.m
--- compiler/rtti.m 17 Jul 2003 14:40:23 -0000 1.34
+++ compiler/rtti.m 24 Sep 2003 15:54:52 -0000
@@ -24,7 +24,6 @@
:- interface.
-:- import_module backend_libs__code_model.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_module.
:- import_module hlds__hlds_pred.
@@ -442,7 +441,8 @@
proc_headvars :: assoc_list(prog_var,
prog_var_name),
proc_arg_modes :: list(arg_mode),
- proc_interface_code_model :: code_model,
+ proc_interface_determinism :: determinism,
+
%
% The following booleans hold values computed from the
% pred_info, using procedures
@@ -490,6 +490,16 @@
% types in the instance declaration
base_typeclass_info
+ )
+
+ % A procedure to be called top-down by Aditi when
+ % evaluating a join condition. These procedures
+ % only have one input and one output argument,
+ % both of which must have a ground {}/N type.
+ ; aditi_proc_info(
+ rtti_proc_label, % The procedure to call.
+ rtti_type_info, % Type of the input argument.
+ rtti_type_info % Type of the output argument.
).
% All rtti_data data structures and all their components are identified
@@ -502,7 +512,8 @@
:- type rtti_id
---> ctor_rtti_id(rtti_type_ctor, ctor_rtti_name)
- ; tc_rtti_id(tc_rtti_name).
+ ; tc_rtti_id(tc_rtti_name)
+ ; aditi_rtti_id(rtti_proc_label).
:- type ctor_rtti_name
---> exist_locns(int) % functor ordinal
@@ -573,6 +584,9 @@
:- pred rtti__proc_label_pred_proc_id(rtti_proc_label::in,
pred_id::out, proc_id::out) is det.
+ % Construct an aditi_proc_info for a given procedure.
+:- func make_aditi_proc_info(module_info, pred_id, proc_id) = rtti_data.
+
% Return the C variable name of the RTTI data structure identified
% by the input argument.
:- pred rtti__id_to_c_identifier(rtti_id::in, string::out) is det.
@@ -667,6 +681,8 @@
:- implementation.
:- import_module backend_libs__name_mangle.
+:- import_module backend_libs__proc_label.
+:- import_module backend_libs__pseudo_type_info.
:- import_module check_hlds__mode_util.
:- import_module check_hlds__type_util.
:- import_module hlds__hlds_data.
@@ -697,6 +713,7 @@
RttiTypeCtor = pti_get_rtti_type_ctor(PseudoTypeInfo).
rtti_data_to_id(base_typeclass_info(Module, ClassId, Instance, _),
tc_rtti_id(base_typeclass_info(Module, ClassId, Instance))).
+rtti_data_to_id(aditi_proc_info(ProcLabel, _, _), aditi_rtti_id(ProcLabel)).
tcd_get_rtti_type_ctor(TypeCtorData) = RttiTypeCtor :-
ModuleName = TypeCtorData ^ tcr_module_name,
@@ -739,6 +756,7 @@
ctor_rtti_name_has_array_type(RttiName).
rtti_id_has_array_type(tc_rtti_id(TCRttiName)) =
tc_rtti_name_has_array_type(TCRttiName).
+rtti_id_has_array_type(aditi_rtti_id(_)) = no.
ctor_rtti_name_has_array_type(RttiName) = IsArray :-
ctor_rtti_name_type(RttiName, _, IsArray).
@@ -750,6 +768,8 @@
ctor_rtti_name_is_exported(RttiName).
rtti_id_is_exported(tc_rtti_id(TCRttiName)) =
tc_rtti_name_is_exported(TCRttiName).
+% MR_AditiProcInfos must be exported to be visible to dlsym().
+rtti_id_is_exported(aditi_rtti_id(_)) = yes.
ctor_rtti_name_is_exported(exist_locns(_)) = no.
ctor_rtti_name_is_exported(exist_info(_)) = no.
@@ -802,7 +822,7 @@
proc_info_varset(ProcInfo, ProcVarSet),
proc_info_headvars(ProcInfo, ProcHeadVars),
proc_info_argmodes(ProcInfo, ProcModes),
- proc_info_interface_code_model(ProcInfo, ProcCodeModel),
+ proc_info_interface_determinism(ProcInfo, ProcDetism),
modes_to_arg_modes(ModuleInfo, ProcModes, ArgTypes, ProcArgModes),
IsImported = (pred_info_is_imported(PredInfo) -> yes ; no),
IsPseudoImp = (pred_info_is_pseudo_imported(PredInfo) -> yes ; no),
@@ -813,17 +833,34 @@
), ProcHeadVars),
ProcLabel = rtti_proc_label(PredOrFunc, ThisModule, PredModule,
PredName, Arity, ArgTypes, PredId, ProcId,
- ProcHeadVarsWithNames, ProcArgModes, ProcCodeModel,
+ ProcHeadVarsWithNames, ProcArgModes, ProcDetism,
IsImported, IsPseudoImp, IsExported, MaybeSpecial).
rtti__proc_label_pred_proc_id(ProcLabel, PredId, ProcId) :-
ProcLabel = rtti_proc_label(_, _, _, _, _, _, PredId, ProcId,
_, _, _, _, _, _, _).
+make_aditi_proc_info(ModuleInfo, PredId, ProcId) =
+ aditi_proc_info(ProcLabel, InputTypeInfo, OutputTypeInfo) :-
+ ProcLabel = rtti__make_rtti_proc_label(ModuleInfo, PredId, ProcId),
+
+ % The types of the arguments must be ground.
+ ( ProcLabel ^ arg_types = [InputArgType, OutputArgType] ->
+ pseudo_type_info__construct_type_info(
+ InputArgType, InputTypeInfo),
+ pseudo_type_info__construct_type_info(
+ OutputArgType, OutputTypeInfo)
+ ;
+ error("make_aditi_proc_info: incorrect number of arguments")
+ ).
+
rtti__id_to_c_identifier(ctor_rtti_id(RttiTypeCtor, RttiName), Str) :-
rtti__name_to_string(RttiTypeCtor, RttiName, Str).
rtti__id_to_c_identifier(tc_rtti_id(TCRttiName), Str) :-
rtti__tc_name_to_string(TCRttiName, Str).
+rtti__id_to_c_identifier(aditi_rtti_id(RttiProcLabel), Str) :-
+ Str = "AditiProcInfo_For_" ++
+ proc_label_to_c_string(make_proc_label_from_rtti(RttiProcLabel), no).
:- pred rtti__name_to_string(rtti_type_ctor::in, ctor_rtti_name::in,
string::out) is det.
@@ -1233,6 +1270,7 @@
ctor_rtti_name_would_include_code_addr(RttiName).
rtti_id_would_include_code_addr(tc_rtti_id(TCRttiName)) =
tc_rtti_name_would_include_code_addr(TCRttiName).
+rtti_id_would_include_code_addr(aditi_rtti_id(_)) = yes.
ctor_rtti_name_would_include_code_addr(exist_locns(_)) = no.
ctor_rtti_name_would_include_code_addr(exist_info(_)) = no.
@@ -1274,6 +1312,7 @@
ctor_rtti_name_c_type(RttiName, CTypeName, IsArray).
rtti_id_c_type(tc_rtti_id(TCRttiName), CTypeName, IsArray) :-
tc_rtti_name_c_type(TCRttiName, CTypeName, IsArray).
+rtti_id_c_type(aditi_rtti_id(_), "MR_Aditi_Proc_Info", no).
ctor_rtti_name_c_type(RttiName, CTypeName, IsArray) :-
ctor_rtti_name_type(RttiName, GenTypeName, IsArray),
@@ -1287,6 +1326,8 @@
ctor_rtti_name_java_type(RttiName, JavaTypeName, IsArray).
rtti_id_java_type(tc_rtti_id(TCRttiName), JavaTypeName, IsArray) :-
tc_rtti_name_java_type(TCRttiName, JavaTypeName, IsArray).
+rtti_id_java_type(aditi_rtti_id(_), _, _) :-
+ error("Aditi not supported for the Java back-end").
ctor_rtti_name_java_type(RttiName, JavaTypeName, IsArray) :-
ctor_rtti_name_type(RttiName, GenTypeName0, IsArray),
Index: compiler/rtti_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_out.m,v
retrieving revision 1.38
diff -u -u -r1.38 rtti_out.m
--- compiler/rtti_out.m 14 Aug 2003 06:13:48 -0000 1.38
+++ compiler/rtti_out.m 23 Sep 2003 08:28:53 -0000
@@ -72,7 +72,9 @@
:- implementation.
:- import_module backend_libs__c_util.
+:- import_module backend_libs__code_model.
:- import_module backend_libs__name_mangle.
+:- import_module backend_libs__proc_label.
:- import_module backend_libs__pseudo_type_info.
:- import_module backend_libs__type_ctor_info.
:- import_module hlds__hlds_data.
@@ -98,6 +100,43 @@
InstanceString, BaseTypeClassInfo), !DeclSet, !IO) :-
output_base_typeclass_info_defn(InstanceModuleName, ClassId,
InstanceString, BaseTypeClassInfo, !DeclSet, !IO).
+output_rtti_data_defn(aditi_proc_info(ProcLabel, InputTypeInfo,
+ OutputTypeInfo), !DeclSet, !IO) :-
+ output_aditi_proc_info_defn(ProcLabel, InputTypeInfo, OutputTypeInfo,
+ !DeclSet, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred output_aditi_proc_info_defn(rtti_proc_label::in,
+ rtti_type_info::in, rtti_type_info::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_aditi_proc_info_defn(ProcLabel, InputTypeInfo, OutputTypeInfo,
+ !DeclSet, !IO) :-
+ output_type_info_defn(InputTypeInfo, !DeclSet, !IO),
+ output_type_info_defn(OutputTypeInfo, !DeclSet, !IO),
+ CodeAddr = make_code_addr(ProcLabel),
+ output_code_addr_decls(CodeAddr, "", "", 0, _, !DeclSet, !IO),
+
+ output_rtti_id_storage_type_name(aditi_rtti_id(ProcLabel), yes, !IO),
+ io__write_string(" = {\n\t(MR_Code *) ", !IO),
+ output_static_code_addr(CodeAddr, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_string("""", !IO),
+ c_util__output_quoted_string(
+ proc_label_to_c_string(make_proc_label_from_rtti(ProcLabel), no),
+ !IO),
+ io__write_string(""",\n\t", !IO),
+ output_cast_addr_of_rtti_data("(MR_TypeInfo) ",
+ type_info(InputTypeInfo), !IO),
+ io__write_string(",\n\t", !IO),
+ output_cast_addr_of_rtti_data("(MR_TypeInfo) ",
+ type_info(OutputTypeInfo), !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(
+ represent_determinism(ProcLabel ^ proc_interface_determinism),
+ !IO),
+ io__write_string("\n};\n", !IO).
%-----------------------------------------------------------------------------%
@@ -1073,6 +1112,16 @@
io__write_string("#endif /* MR_STATIC_CODE_ADDRESSES */\n",
!IO)
;
+ Data = aditi_proc_info(ProcLabel, _, _)
+ ->
+ io__write_string("\tMR_INIT_ADITI_PROC_INFO(", !IO),
+ rtti_data_to_id(Data, DataId),
+ rtti__id_to_c_identifier(DataId, CId),
+ io__write_string(CId, !IO),
+ io__write_string(", ", !IO),
+ output_code_addr(make_code_addr(ProcLabel), !IO),
+ io__write_string(");\n", !IO)
+ ;
true
).
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.41
diff -u -u -r1.41 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m 25 Sep 2003 07:56:30 -0000 1.41
+++ compiler/rtti_to_mlds.m 30 Sep 2003 09:45:34 -0000
@@ -28,6 +28,7 @@
:- implementation.
+:- import_module backend_libs__code_model.
:- import_module backend_libs__foreign.
:- import_module backend_libs__pseudo_type_info.
:- import_module backend_libs__type_ctor_info.
@@ -211,6 +212,38 @@
% gen_init_proc_id_from_univ(ModuleInfo, PrettyprinterProc)
]).
+gen_init_rtti_data_defn(RttiData, ModuleInfo, Init, SubDefns) :-
+ RttiData = aditi_proc_info(ProcLabel, InputTypeInfo, OutputTypeInfo),
+ ( real_rtti_data(type_info(InputTypeInfo)) ->
+ InputTypeInfoDefns = rtti_data_to_mlds(ModuleInfo,
+ type_info(InputTypeInfo))
+ ;
+ InputTypeInfoDefns = []
+ ),
+ ( real_rtti_data(type_info(OutputTypeInfo)) ->
+ OutputTypeInfoDefns = rtti_data_to_mlds(ModuleInfo,
+ type_info(OutputTypeInfo))
+ ;
+ OutputTypeInfoDefns = []
+ ),
+ prog_out__sym_name_and_arity_to_string(
+ qualified(ProcLabel ^ pred_module, ProcLabel ^ pred_name)/
+ ProcLabel ^ arity,
+ ProcNameStr),
+ module_info_name(ModuleInfo, ModuleName),
+
+ Init = init_struct([
+ gen_init_proc_id(ModuleInfo, ProcLabel),
+ gen_init_string(ProcNameStr),
+ gen_init_cast_rtti_data(mlds__type_info_type,
+ ModuleName, type_info(InputTypeInfo)),
+ gen_init_cast_rtti_data(mlds__type_info_type,
+ ModuleName, type_info(OutputTypeInfo)),
+ gen_init_int(code_model__represent_determinism(
+ ProcLabel ^ proc_interface_determinism))
+ ]),
+ SubDefns = InputTypeInfoDefns ++ OutputTypeInfoDefns.
+
%-----------------------------------------------------------------------------%
:- pred gen_type_info_defn(module_info::in, rtti_type_info::in,
@@ -876,6 +909,8 @@
gen_init_rtti_name(ModuleName, RttiTypeCtor, RttiName).
gen_init_rtti_id(ModuleName, tc_rtti_id(TCRttiName)) =
gen_init_tc_rtti_name(ModuleName, TCRttiName).
+gen_init_rtti_id(ModuleName, aditi_rtti_id(ProcLabel)) =
+ gen_init_aditi_rtti_name(ModuleName, ProcLabel).
% Generate an MLDS initializer comprising just the
% the rval for a given rtti_name
@@ -893,6 +928,14 @@
gen_init_tc_rtti_name(ModuleName, TCRttiName) =
init_obj(gen_tc_rtti_name(ModuleName, TCRttiName)).
+ % Generate an MLDS initializer comprising just the
+ % the rval for a given aditi_rtti_name
+:- func gen_init_aditi_rtti_name(module_name, rtti_proc_label) =
+ mlds__initializer.
+
+gen_init_aditi_rtti_name(ModuleName, ProcLabel) =
+ init_obj(gen_aditi_rtti_name(ModuleName, ProcLabel)).
+
% Generate the MLDS initializer comprising the rtti_name
% for a given rtti_name, converted to the given type.
:- func gen_init_cast_rtti_id(mlds__type, module_name, rtti_id)
@@ -910,6 +953,8 @@
gen_rtti_name(ThisModuleName, RttiTypeCtor, RttiName).
gen_rtti_id(ThisModuleName, tc_rtti_id(TCRttiName)) =
gen_tc_rtti_name(ThisModuleName, TCRttiName).
+gen_rtti_id(ThisModuleName, aditi_rtti_id(ProcLabel)) =
+ gen_aditi_rtti_name(ThisModuleName, ProcLabel).
:- func gen_rtti_name(module_name, rtti_type_ctor, ctor_rtti_name)
= mlds__rval.
@@ -964,6 +1009,14 @@
TCRttiName = base_typeclass_info(InstanceModuleName, _, _),
MLDS_ModuleName = mercury_module_name_to_mlds(InstanceModuleName),
MLDS_DataName = rtti(tc_rtti_id(TCRttiName)),
+ DataAddr = data_addr(MLDS_ModuleName, MLDS_DataName),
+ Rval = const(data_addr_const(DataAddr)).
+
+:- func gen_aditi_rtti_name(module_name, rtti_proc_label) = mlds__rval.
+
+gen_aditi_rtti_name(ThisModuleName, ProcLabel) = Rval :-
+ MLDS_ModuleName = mercury_module_name_to_mlds(ThisModuleName),
+ MLDS_DataName = rtti(aditi_rtti_id(ProcLabel)),
DataAddr = data_addr(MLDS_ModuleName, MLDS_DataName),
Rval = const(data_addr_const(DataAddr)).
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.83
diff -u -u -r1.83 stack_layout.m
--- compiler/stack_layout.m 29 May 2003 16:00:38 -0000 1.83
+++ compiler/stack_layout.m 23 Sep 2003 00:40:04 -0000
@@ -50,9 +50,15 @@
% integer.
:- pred stack_layout__represent_locn_as_int(layout_locn::in, int::out) is det.
+ % Construct a representation of the interface determinism of a
+ % procedure.
+:- pred stack_layout__represent_determinism_rval(determinism::in,
+ rval::out) is det.
+
:- implementation.
:- import_module backend_libs__rtti.
+:- import_module backend_libs__code_model.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_goal.
:- import_module hlds__hlds_pred.
@@ -1445,49 +1451,8 @@
%---------------------------------------------------------------------------%
- % Construct a representation of the interface determinism of a
- % procedure. The code we have chosen is not sequential; instead
- % it encodes the various properties of each determinism.
- %
- % The 8 bit is set iff the context is first_solution.
- % The 4 bit is set iff the min number of solutions is more than zero.
- % The 2 bit is set iff the max number of solutions is more than zero.
- % The 1 bit is set iff the max number of solutions is more than one.
-
-:- pred stack_layout__represent_determinism_rval(determinism::in, rval::out)
- is det.
-
-stack_layout__represent_determinism_rval(Detism, const(int_const(Code))) :-
- stack_layout__represent_determinism(Detism, Code).
-
-:- pred stack_layout__represent_determinism(determinism::in, int::out) is det.
-
-stack_layout__represent_determinism(Detism, Code) :-
- (
- Detism = det,
- Code = 6 /* 0110 */
- ;
- Detism = semidet, /* 0010 */
- Code = 2
- ;
- Detism = nondet,
- Code = 3 /* 0011 */
- ;
- Detism = multidet,
- Code = 7 /* 0111 */
- ;
- Detism = erroneous,
- Code = 4 /* 0100 */
- ;
- Detism = failure,
- Code = 0 /* 0000 */
- ;
- Detism = cc_nondet,
- Code = 10 /* 1010 */
- ;
- Detism = cc_multidet,
- Code = 14 /* 1110 */
- ).
+stack_layout__represent_determinism_rval(Detism,
+ const(int_const(code_model__represent_determinism(Detism)))).
%---------------------------------------------------------------------------%
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.375
diff -u -u -r1.375 user_guide.texi
--- doc/user_guide.texi 25 Sep 2003 07:56:44 -0000 1.375
+++ doc/user_guide.texi 30 Sep 2003 15:42:38 -0000
@@ -5411,6 +5411,23 @@
or for backtrackable destructive update.
This option is not yet supported for the IL or Java back-ends.
+ at ifset aditi
+ at sp 1
+ at item --aditi
+ at findex --aditi
+Enable Aditi compilation. You need to enable this option if you
+are making use of the Aditi deductive database interface (@pxref{Using Aditi}).
+
+ at c --aditi-calls-mercury is not fully implemented.
+ at ignore
+ at sp 1
+ at item --aditi-calls-mercury
+ at findex --aditi-calls-mercury
+Enable calling ordinary Mercury code from Aditi.
+ at end ignore
+
+ at end ifset
+
@end table
@node Developer compilation model options
@@ -6482,13 +6499,6 @@
standard input. Repeat this until EOF is reached. (This allows a program
or user to interactively compile several modules without the overhead of
process creation for each one.)
-
- at ifset aditi
- at sp 1
- at item --aditi
- at findex --aditi
-Enable Aditi compilation. You need to enable this option if you
-are making use of the Aditi deductive database interface (@pxref{Using Aditi}).
@sp 1
@item --aditi-user
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.103
diff -u -u -r1.103 Mmakefile
--- runtime/Mmakefile 13 Jul 2003 08:19:18 -0000 1.103
+++ runtime/Mmakefile 23 Sep 2003 00:40:04 -0000
@@ -12,6 +12,7 @@
HDRS = \
mercury.h \
mercury_accurate_gc.h \
+ mercury_aditi.h \
mercury_agc_debug.h \
mercury_array_macros.h \
mercury_bootstrap.h \
Index: runtime/mercury.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.h,v
retrieving revision 1.65
diff -u -u -r1.65 mercury.h
--- runtime/mercury.h 29 Sep 2002 09:38:41 -0000 1.65
+++ runtime/mercury.h 24 Sep 2003 11:46:44 -0000
@@ -31,6 +31,7 @@
#include "mercury_type_info.h"
#include "mercury_builtin_types.h"
#include "mercury_ho_call.h" /* for the `MR_Closure' type */
+#include "mercury_aditi.h" /* for the `MR_Aditi_Proc_Info' type */
#include "mercury_bootstrap.h"
#include "mercury_memory.h" /* for memory allocation routines */
#include "mercury_type_tables.h" /* for MR_register_type_ctor_info */
Index: runtime/mercury_imp.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_imp.h,v
retrieving revision 1.20
diff -u -u -r1.20 mercury_imp.h
--- runtime/mercury_imp.h 18 Mar 2003 16:38:10 -0000 1.20
+++ runtime/mercury_imp.h 23 Sep 2003 00:40:04 -0000
@@ -58,6 +58,8 @@
#include "mercury_tags.h"
#include "mercury_goto.h"
#include "mercury_calls.h"
+#include "mercury_ho_call.h"
+#include "mercury_aditi.h"
#include "mercury_engine.h"
#include "mercury_memory.h"
Index: runtime/mercury_stack_layout.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stack_layout.h,v
retrieving revision 1.73
diff -u -u -r1.73 mercury_stack_layout.h
--- runtime/mercury_stack_layout.h 24 Jun 2003 01:21:21 -0000 1.73
+++ runtime/mercury_stack_layout.h 30 Sep 2003 09:22:32 -0000
@@ -57,6 +57,9 @@
** MR_DETISM_AT_MOST_MANY could also be defined as ((d) & 3) == 3),
** but this would be less efficient, since the C compiler does not know
** that we do not set the 1 bit unless we also set the 2 bit.
+**
+** NOTE: this must match the encoding specified by represent_determinism/1
+** in compiler/code_model.m.
*/
typedef MR_int_least16_t MR_Determinism;
Index: tests/valid/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mercury.options,v
retrieving revision 1.9
diff -u -u -r1.9 Mercury.options
--- tests/valid/Mercury.options 26 Jul 2003 07:19:08 -0000 1.9
+++ tests/valid/Mercury.options 24 Sep 2003 07:26:30 -0000
@@ -22,6 +22,7 @@
GRADEFLAGS-foreign_type_spec = --grade il
GRADEFLAGS-foreign_type_spec.foreign = --grade il
+MCFLAGS-aditi_calls_mercury = --aditi --aditi-calls-mercury
MCFLAGS-aditi_error_bug = --aditi
MCFLAGS-aditi_error_bug2 = --aditi
MCFLAGS-aditi_error_bug3 = --aditi
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.130
diff -u -u -r1.130 Mmakefile
--- tests/valid/Mmakefile 25 Jul 2003 02:27:37 -0000 1.130
+++ tests/valid/Mmakefile 30 Sep 2003 09:21:26 -0000
@@ -29,6 +29,7 @@
typeclass_det_warning
ADITI_PROGS= \
+ aditi_calls_mercury \
aditi_error_bug \
aditi_update \
base_relation \
@@ -240,10 +241,9 @@
PROGS2=$(PROGS1) $(TRAIL_PROGS)
endif
-# Aditi is not yet implemented for the MLDS back-end
-# (i.e. grades hl* java* il*).
-# It will never be implemented for deep profiling grades.
-ifneq "$(filter hl% java% il%,$(GRADE))$(findstring profdeep,$(GRADE))" ""
+# Aditi is not yet implemented for the non-C back-ends
+# (i.e. grades java* il*).
+ifneq "$(filter java% il%,$(GRADE))" ""
# We currently don't do any testing in grade java on this directory.
ifneq "$(findstring java,$(GRADE))$" ""
OBJ_PROGS=
@@ -254,7 +254,7 @@
OBJ_PROGS=$(PROGS2) $(ADITI_PROGS)
endif
-ifneq "$(findstring profdeep,$(GRADE))$(findstring java,$(GRADE))" ""
+ifneq "$(findstring java,$(GRADE))" ""
ALL_RLO_PROGS =
else
ALL_RLO_PROGS = $(RLO_PROGS)
Index: tests/valid/aditi_calls_mercury.m
===================================================================
RCS file: tests/valid/aditi_calls_mercury.m
diff -N tests/valid/aditi_calls_mercury.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/valid/aditi_calls_mercury.m 24 Sep 2003 07:33:18 -0000
@@ -0,0 +1,24 @@
+:- module aditi_calls_mercury.
+
+:- interface.
+
+:- import_module aditi, list.
+:- pred query(aditi.state, list(int)) is nondet.
+:- mode query(aditi.aditi_mui ,out) is nondet.
+:- pragma aditi(query/2).
+
+:- implementation.
+
+:- pragma aditi_no_memo(query/2).
+
+:- import_module int.
+:- import_module float.
+
+query(DB,X ++ X) :-
+ p(DB, X).
+
+:- pred p(aditi__state, list(int)).
+:- mode p(aditi_mui, out) is nondet.
+
+:- pragma base_relation(p/2).
+
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list