[m-rev.] for review: calling Mercury from Aditi
Simon Taylor
stayl at cs.mu.OZ.AU
Wed Oct 20 00:01:19 AEST 2004
On 01-Oct-2003, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> On 01-Oct-2003, Simon Taylor <stayl at cs.mu.OZ.AU> wrote:
> >
> > Allow Aditi to call Mercury. At the moment, this involves Aditi
> > loading a shared library containing the user's code.
> ...
> > +++ 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;
> > + % }
>
> s/}/} MR_Aditi_Proc_Info;/
Done.
> > + build_struct_type("MR_Aditi_Proc_Info",
> > + ['MR_Code*' - "MR_aditi_proc_addr",
> > + 'MR_ConstString' - "MR_aditi_proc_name",
>
> The code doesn't match the comment: MR_String vs MR_ConstString.
>
> Also, `MR_Code*' is for pointers to LLDS entry labels;
> it should not be used for pointers to MLDS procedures.
> `MR_ProcAddr' is the type which should be used for
> procedure addresses.
Fixed.
> > Index: compiler/options.m
> ...
> > @@ -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."
> > + ]),
>
> If it is not fully implemented, then it should be listed in the
> WORK_IN_PROGRESS file.
Aditi is already in WORK_IN_PROGRESS.
> > +++ 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),
>
> This looks like the ordering of data structures will be different
> for Mercury than for Aditi... are you sure that's what you want?
I've backed out this change; this issue will have to be fixed
on the Aditi side. By the way, what was the rationale for
numbering constructors passed to `construct.construct' using
lexicographic order (which has no semantic meaning in Mercury)
rather than declaration order, which affects comparison order.
There is no simple way to get the lexicographic order index of a
constructor given the declaration order index, but we do provide
construct.get_functor_ordinal, which produces the declaration order
index of a constructor given the lexicographic order index.
> > Index: compiler/rl_exprn.m
> ...
> > +:- 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.
>
> That function appears to be unused.
> Probably it ought to be called from the procedure above.
Fixed.
> > +%-----------------------------------------------------------------------------%
> > +
> > +:- 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.
> > + %
>
> Is this comment intended to describe the whole of what
> generate_top_down_call does? If so, then it should go
> above the pred declaration, rather than in the clause body.
>
> More comments explaining in more detail what this procedure
> is supposed to do would be helpful.
>
> In particular, I think it would be helpful to say a bit
> about the kinds of input code (HLDS?) and output code
> (Aditi bytecode... that will call Mercury code which has
> been compiled (possibly via C) to native code).
>
> Also, since the details of the generated code are complicated,
> I think it would be worth having a comment showing the general
> form that the generated code is supposed to take.
>
> Perhaps also comments with each section of the code
> saying which bit of the generated code it is generating.
Mostly done, although all of the above would be major overkill.
> > +:- 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.
>
> A comment or two here would also be a good idea, IMHO.
Done.
> > Index: tests/valid/Mmakefile
> > +# Aditi is not yet implemented for the non-C back-ends
> > +# (i.e. grades java* il*).
>
> s/non-C/non-C, non-asm/
>
> Or better, say "Aditi is only implemented for the C and asm back-ends"
> (i.e. not for grades java* il*)
Done.
Sorry, interdiff barfed (OK, it's been a year since this was reviewed),
so here's the full diff again.
Simon.
Index: compiler/code_model.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_model.m,v
retrieving revision 1.5
diff -u -u -r1.5 code_model.m
--- compiler/code_model.m 5 Apr 2004 05:06:45 -0000 1.5
+++ compiler/code_model.m 22 May 2004 15:05:24 -0000
@@ -38,10 +38,24 @@
:- pred goal_info_get_code_model(hlds_goal_info::in, code_model::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).
@@ -58,5 +72,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.103
diff -u -u -r1.103 hlds_module.m
--- compiler/hlds_module.m 16 Oct 2004 15:05:50 -0000 1.103
+++ compiler/hlds_module.m 17 Oct 2004 10:06:43 -0000
@@ -122,6 +122,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
@@ -357,6 +368,15 @@
:- pred module_info_set_analysis_info(analysis_info::in,
module_info::in, module_info::out) is det.
+:- pred module_info_aditi_top_down_procs(module_info::in,
+ list(aditi_top_down_proc)::out) is det.
+
+:- pred module_info_set_aditi_top_down_procs(module_info::in,
+ list(aditi_top_down_proc)::in, module_info::out) is det.
+
+:- pred module_info_next_aditi_top_down_proc(module_info::in, int::out,
+ module_info::out) is det.
+
%-----------------------------------------------------------------------------%
:- pred module_info_preds(module_info::in, pred_table::out) is det.
@@ -575,10 +595,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
@@ -621,7 +647,7 @@
[], [], StratPreds, UnusedArgInfo, ExceptionInfo,
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,
@@ -703,6 +729,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.
%-----------------------------------------------------------------------------%
@@ -755,6 +787,8 @@
MI ^ sub_info ^ no_tag_type_table := NewVal).
module_info_set_analysis_info(NewVal, MI,
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.315
diff -u -u -r1.315 mercury_compile.m
--- compiler/mercury_compile.m 16 Oct 2004 15:07:29 -0000 1.315
+++ compiler/mercury_compile.m 17 Oct 2004 09:32:47 -0000
@@ -133,6 +133,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__arg_info.
:- import_module hlds__hlds_data.
@@ -1522,8 +1523,8 @@
;
true
),
- mercury_compile__maybe_generate_rl_bytecode(HLDS50,
- Verbose, MaybeRLFile, !IO),
+ mercury_compile__maybe_generate_rl_bytecode(Verbose,
+ MaybeRLFile, HLDS50, HLDS51, !IO),
(
( Target = c
; Target = asm
@@ -1541,10 +1542,10 @@
true
),
( AditiOnly = yes ->
- HLDS = HLDS50,
+ HLDS = HLDS51,
FactTableBaseFiles = []
; Target = il ->
- HLDS = HLDS50,
+ HLDS = HLDS51,
mercury_compile__mlds_backend(HLDS, _, MLDS, !IO),
( TargetCodeOnly = yes ->
mercury_compile__mlds_to_il_assembler(MLDS,
@@ -1561,7 +1562,7 @@
),
FactTableBaseFiles = []
; Target = java ->
- HLDS = HLDS50,
+ HLDS = HLDS51,
mercury_compile__mlds_backend(HLDS, _, MLDS, !IO),
mercury_compile__mlds_to_java(MLDS, !IO),
( TargetCodeOnly = yes ->
@@ -1577,7 +1578,7 @@
FactTableBaseFiles = []
; Target = asm ->
% compile directly to assembler using the gcc back-end
- HLDS = HLDS50,
+ HLDS = HLDS51,
mercury_compile__mlds_backend(HLDS, _, MLDS, !IO),
mercury_compile__maybe_mlds_to_gcc(MLDS,
MaybeRLFile, ContainsCCode, !IO),
@@ -1602,7 +1603,7 @@
),
FactTableBaseFiles = []
; HighLevelCode = yes ->
- HLDS = HLDS50,
+ HLDS = HLDS51,
mercury_compile__mlds_backend(HLDS, _, MLDS, !IO),
mercury_compile__mlds_to_high_level_c(MLDS,
MaybeRLFile, !IO),
@@ -1624,7 +1625,7 @@
),
FactTableBaseFiles = []
;
- mercury_compile__backend_pass(HLDS50, HLDS,
+ mercury_compile__backend_pass(HLDS51, HLDS,
GlobalData, LLDS, !IO),
mercury_compile__output_pass(HLDS, GlobalData, LLDS,
MaybeRLFile, ModuleName, _CompileErrors,
@@ -2385,15 +2386,16 @@
%-----------------------------------------------------------------------------%
-:- pred mercury_compile__maybe_generate_rl_bytecode(module_info::in, bool::in,
- maybe(rl_file)::out, io::di, io::uo) is det.
+:- pred mercury_compile__maybe_generate_rl_bytecode(bool::in,
+ maybe(rl_file)::out, module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
-mercury_compile__maybe_generate_rl_bytecode(ModuleInfo,
- Verbose, MaybeRLFile, !IO) :-
+mercury_compile__maybe_generate_rl_bytecode(Verbose, MaybeRLFile,
+ !ModuleInfo, !IO) :-
globals__io_lookup_bool_option(aditi, Aditi, !IO),
(
Aditi = yes,
- module_info_get_do_aditi_compilation(ModuleInfo,
+ module_info_get_do_aditi_compilation(!.ModuleInfo,
AditiCompile),
(
AditiCompile = do_aditi_compilation,
@@ -2404,26 +2406,24 @@
maybe_write_string(Verbose,
"% Generating RL...\n", !IO),
maybe_flush_output(Verbose, !IO),
- rl_gen__module(ModuleInfo, RLProcs0, !IO),
+ rl_gen__module(!.ModuleInfo, RLProcs0, !IO),
mercury_compile__maybe_dump_rl(RLProcs0,
- ModuleInfo, "", "", !IO),
+ !.ModuleInfo, "", "", !IO),
%
% Optimize the RL procedures.
%
- rl_opt__procs(ModuleInfo, RLProcs0, RLProcs, !IO),
+ rl_opt__procs(!.ModuleInfo, RLProcs0, RLProcs, !IO),
mercury_compile__maybe_dump_rl(RLProcs,
- ModuleInfo, "", ".opt", !IO),
+ !.ModuleInfo, "", ".opt", !IO),
%
% Convert the RL procedures to bytecode.
%
- rl_out__generate_rl_bytecode(ModuleInfo,
- RLProcs, MaybeRLFile, !IO)
+ rl_out__generate_rl_bytecode(RLProcs, MaybeRLFile,
+ !ModuleInfo, !IO)
;
AditiCompile = no_aditi_compilation,
- MaybeRLFile = no,
-
globals__io_lookup_bool_option(aditi_only, AditiOnly,
!IO),
(
@@ -2432,10 +2432,11 @@
% Always generate a `.rlo' file if compiling
% with `--aditi-only'.
RLProcs = [],
- rl_out__generate_rl_bytecode(ModuleInfo,
- RLProcs, _, !IO)
+ rl_out__generate_rl_bytecode(RLProcs,
+ MaybeRLFile, !ModuleInfo, !IO)
;
- AditiOnly = no
+ AditiOnly = no,
+ MaybeRLFile = no
)
)
;
@@ -2443,6 +2444,17 @@
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::in, module_info::out,
@@ -3776,6 +3788,7 @@
%
type_ctor_info__generate_rtti(HLDS, TypeCtorRttiData),
base_typeclass_info__generate_rtti(HLDS, OldTypeClassInfoRttiData),
+ generate_aditi_proc_info(HLDS, AditiProcInfoRttiData),
globals__io_lookup_bool_option(new_type_class_rtti, NewTypeClassRtti,
!IO),
type_class_info__generate_rtti(HLDS, NewTypeClassRtti,
@@ -3785,6 +3798,8 @@
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),
%
@@ -3803,7 +3818,8 @@
% Next we put it all together and output it to one or more C files.
%
list__condense([StaticCells, ClosureLayouts, StackLayouts,
- TypeCtorTables, TypeClassInfos], AllData),
+ TypeCtorTables, TypeClassInfos, AditiProcInfos],
+ AllData),
mercury_compile__construct_c_file(HLDS, C_InterfaceInfo,
Procs, GlobalVars, AllData, CFile, NumChunks, !IO),
mercury_compile__output_llds(ModuleName, CFile, LayoutLabels,
@@ -4174,13 +4190,15 @@
mercury_compile__mlds_gen_rtti_data(HLDS, MLDS0, MLDS) :-
type_ctor_info__generate_rtti(HLDS, TypeCtorRtti),
base_typeclass_info__generate_rtti(HLDS, TypeClassInfoRtti),
+
+ generate_aditi_proc_info(HLDS, AditiProcInfoRtti),
module_info_globals(HLDS, Globals),
globals__lookup_bool_option(Globals, new_type_class_rtti,
NewTypeClassRtti),
type_class_info__generate_rtti(HLDS, NewTypeClassRtti,
NewTypeClassInfoRttiData),
list__condense([TypeCtorRtti, TypeClassInfoRtti,
- NewTypeClassInfoRttiData], RttiData),
+ NewTypeClassInfoRttiData, AditiProcInfoRtti], RttiData),
RttiDefns = rtti_data_list_to_mlds(HLDS, RttiData),
MLDS0 = mlds(ModuleName, ForeignCode, Imports, Defns0),
list__append(RttiDefns, Defns0, Defns),
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.98
diff -u -u -r1.98 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 2 Aug 2004 08:30:07 -0000 1.98
+++ compiler/mlds_to_gcc.m 3 Oct 2004 07:24:13 -0000
@@ -1979,6 +1979,9 @@
;
RttiId = tc_rtti_id(_, TCRttiName),
build_rtti_type_tc_name(TCRttiName, BaseType, !IO)
+ ;
+ RttiId = aditi_rtti_id(_),
+ build_rtti_type_aditi_name(BaseType, !IO)
),
IsArray = rtti_id_has_array_type(RttiId),
(
@@ -2150,7 +2153,6 @@
% MR_TypeLayout MR_type_ctor_layout;
% MR_int_least32_t MR_type_ctor_num_functors;
% MR_int_least16_t MR_type_ctor_flags;
- MR_ProcAddr = gcc__ptr_type_node,
build_rtti_type_name(type_functors, MR_TypeFunctors, !IO),
build_rtti_type_name(type_layout, MR_TypeLayout, !IO),
build_struct_type("MR_TypeCtorInfo_Struct",
@@ -2159,8 +2161,8 @@
'MR_int_least8_t' - "MR_type_ctor_num_ptags",
% MR_TypeCtorRepInt is typedef'd to be MR_int_least16_t
'MR_int_least16_t' - "MR_type_ctor_rep_CAST_ME",
- MR_ProcAddr - "MR_type_ctor_unify_pred",
- MR_ProcAddr - "MR_type_ctor_compare_pred",
+ 'MR_ProcAddr' - "MR_type_ctor_unify_pred",
+ 'MR_ProcAddr' - "MR_type_ctor_compare_pred",
'MR_ConstString' - "MR_type_ctor_module_name",
'MR_ConstString' - "MR_type_ctor_name",
MR_TypeFunctors - "MR_type_ctor_functors",
@@ -2204,6 +2206,25 @@
sorry(this_file,
"build_rtti_type_tc_name: type_class_instance_methods").
+:- pred build_rtti_type_aditi_name(gcc__type::out,
+ io__state::di, io__state::uo) is det.
+
+build_rtti_type_aditi_name(GCC_Type, !IO) :-
+ % typedef struct {
+ % MR_ProcAddr 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;
+ % } MR_Aditi_Proc_Info;
+ build_struct_type("MR_Aditi_Proc_Info",
+ ['MR_ProcAddr' - "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"],
+ GCC_Type, !IO).
+
:- pred build_type_info_type(rtti_type_info::in,
gcc__type::out, io__state::di, io__state::uo) is det.
@@ -2593,6 +2614,7 @@
RttiTypeCtor = fixup_rtti_type_ctor(RttiTypeCtor0),
RttiName = fixup_rtti_name(RttiName0).
fixup_rtti_id(tc_rtti_id(TCName, TCRttiName)) = tc_rtti_id(TCName, 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;
@@ -3730,11 +3752,13 @@
:- func 'MR_ConstString' = gcc__type.
:- func 'MR_Word' = gcc__type.
:- func 'MR_bool' = gcc__type.
+:- func 'MR_ProcAddr' = gcc__type.
:- func 'MR_TypeInfo' = gcc__type.
:- func 'MR_TypeCtorInfo' = 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_PredFunc' = gcc__type.
:- func 'MR_int_least8_t' = gcc__type.
@@ -3753,17 +3777,19 @@
% 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_ProcAddr' = gcc__ptr_type_node.
'MR_TypeInfo' = gcc__ptr_type_node.
'MR_TypeCtorInfo' = gcc__ptr_type_node.
'MR_PseudoTypeInfo' = gcc__ptr_type_node.
- % XXX MR_Sectag_Locn, MR_TypeCtorRep, and MR_PredFunc 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
+ % XXX MR_Sectag_Locn, MR_TypeCtorRep, MR_Determinism and MR_PredFunc
+ % 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_PredFunc' = gcc__integer_type_node.
'MR_int_least8_t' = gcc__int8_type_node.
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.144
diff -u -u -r1.144 opt_debug.m
--- compiler/opt_debug.m 16 Aug 2004 03:51:02 -0000 1.144
+++ compiler/opt_debug.m 20 Sep 2004 14:49:18 -0000
@@ -327,6 +327,13 @@
string__append_list(
["tc_rtti_addr(", TCNameStr, ", ", TCDataName_str, ")"],
Str).
+dump_data_addr(rtti_addr(aditi_rtti_id(ProcLabel)), Str) :-
+ string__append_list(
+ ["aditi_rtti_addr(",
+ sym_name_to_string(qualified(ProcLabel ^ proc_module,
+ ProcLabel ^ proc_name)),
+ ")"],
+ Str).
dump_data_addr(layout_addr(LayoutName), Str) :-
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.433
diff -u -u -r1.433 options.m
--- compiler/options.m 16 Oct 2004 15:07:31 -0000 1.433
+++ compiler/options.m 17 Oct 2004 09:32:48 -0000
@@ -229,7 +229,11 @@
; record_term_sizes_as_words
; record_term_sizes_as_cells
- % (c) Miscellaneous
+ % (c) Aditi
+ ; aditi
+ ; aditi_calls_mercury
+
+ % (d) Miscellaneous
; gc
; parallel
; use_trail
@@ -677,9 +681,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
; version
@@ -898,6 +899,8 @@
use_minimal_model_own_stacks - bool(no),
minimal_model_debug - 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),
@@ -1313,7 +1316,6 @@
option_defaults_2(miscellaneous_option, [
% Miscellaneous Options
filenames_from_stdin - bool(no),
- aditi - bool(no),
aditi_user - string(""),
help - bool(no),
version - bool(no),
@@ -1543,6 +1545,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-stack_copy", use_minimal_model_stack_copy).
@@ -1982,7 +1986,6 @@
long_option("help", help).
long_option("version", version).
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).
@@ -3101,6 +3104,17 @@
% "\tAugment each heap cells with its size in cells.",
********************/
]),
+ 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."
+ % XXX --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, boehm, mps, accurate, automatic}",
@@ -4140,10 +4154,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_exprn.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.42
diff -u -u -r1.42 rl_exprn.m
--- compiler/rl_exprn.m 14 Jun 2004 04:16:33 -0000 1.42
+++ compiler/rl_exprn.m 3 Oct 2004 08:56:22 -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.
%-----------------------------------------------------------------------------%
@@ -133,6 +134,7 @@
:- import_module aditi_backend__rl_out.
:- import_module backend_libs.
:- 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.
@@ -140,15 +142,19 @@
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_error_util.
:- 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 libs__tree.
+:- import_module libs__globals.
+:- import_module libs__options.
:- import_module parse_tree__prog_out.
:- import_module parse_tree__prog_util.
:- 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
@@ -594,18 +600,573 @@
%-----------------------------------------------------------------------------%
-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, _).
+ Inputs, MaybeOutputs, Goals, _),
+ 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, _, _, _, _, _),
+ rl_exprn__cons_id_is_complex(ConsId) = yes
+ ).
+
+:- 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(table_io_decl(_)) = yes.
+rl_exprn__cons_id_is_complex(deep_profiling_proc_layout(_)) = yes.
+
+%-----------------------------------------------------------------------------%
+
+ %
+ % Produce a procedure to evaluate a join condition,
+ % and expression bytecodes to call it.
+ % The join condition may contain arbitrary Mercury goals.
+ %
+:- 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) -->
+ { 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.
+
+ %
+ % Work out the set of input arguments for the top-down code.
+ %
+ (
+ { 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) }
+ ),
+
+ %
+ % Build the Mercury procedure to be called.
+ %
+ 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)]) },
+
+ %
+ % Allocate the Mercury tuple to store the input arguments
+ % to the top-down call.
+ %
+ rl_exprn_info_get_free_reg(int_type, ArgsLoc),
+ rl_exprn_info_reg_is_args_location(ArgsLoc),
+ rl_exprn__generate_pop(reg(ArgsLoc), int_type, ArgsLocPopCode),
+ { InputCode =
+ tree(node([rl_EXP_allocate_mercury_input_args(AditiProcId)]),
+ tree(ArgsLocPopCode,
+ InputCode0
+ )) },
+
+ %
+ % Convert the input arguments from Aditi to Mercury,
+ % and pack them into the tuple allocated above.
+ %
+ (
+ { 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) }
+ ),
+
+ %
+ % Call the procedure, passing in the tuple containing
+ % the input arguments.
+ %
+ 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 }
+ ),
+
+ %
+ % Find out where the output arguments are stored.
+ %
+ rl_exprn_info_get_free_reg(int_type, AllResultsReg),
+ rl_exprn__generate_pop(reg(AllResultsReg), int_type,
+ StoreResultLocnCode),
+
+ %
+ % Deallocate the tuple of input arguments.
+ %
+ rl_exprn__cleanup_mercury_value(rl_EXP_clear_mercury_input_args,
+ ArgsLoc, empty, CleanupArgsCode),
+
+ ( { MaxSoln = at_most_many } ->
+ %
+ % Tell Aditi that this join condition may
+ % have more solutions.
+ %
+ { 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
+ )))))) },
+
+ %
+ % Convert the output arguments from Mercury to Aditi.
+ %
+ (
+ { MaybeOutputs = yes(_) },
+ ( { MaxSoln = at_most_many } ->
+ %
+ % For a nondet procedure, Aditi collects
+ % all solutions in a list, and returns
+ % one solution for each call to the
+ % `result' expression fragment.
+ % When there are no more solutions,
+ % the list of solutions is deallocated.
+ %
+ 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),
+
+ %
+ % Extract the output arguments from the tuple,
+ % and convert them from Mercury to Aditi.
+ %
+ 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 }
+ ;
+ { MaybeOutputs = no },
+ %
+ % We aren't expecting any outputs, but just for consistency
+ % an output tuple will be generated, so deallocate it here.
+ %
+ 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),
+
+ %
+ % Clear the references to any Mercury values (e.g. input arguments,
+ % result tuples) so they can be garbage collected.
+ %
+ 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.
+
+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]).
+
+ % Build a new Mercury procedure for the given list of goals.
+ % The input arguments will be passed as a tuple.
+ % The output arguments will be returned as a tuple.
+ % (Passing all arguments in a single tuple simplifies
+ % the data conversion code in the Aditi).
+:- 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),
+
+ %
+ % Wrap the given goals with goals to deconstruct the
+ % input tuple and construct the output tuple.
+ %
+ { 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__generate_2(rl_goal_inputs::in, rl_goal_outputs::in,
+:- 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)]) }.
+
+ % Aditi keeps pointers to all Mercury values it uses
+ % in an array stored in a global variable to avoid them
+ % being garbage collected. When we're finished with the
+ % values used by an expression, we need to clear the array.
+:- 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).
+
+ % Aditi keeps pointers to all Mercury values it uses
+ % in an array stored in a global variable to avoid them
+ % being garbage collected. This predicate generates
+ % bytecode to clear the entry in the array for one of
+ % those values.
+:- 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, _) },
@@ -645,11 +1206,9 @@
( { MaybeOutputs = yes(OutputVars) } ->
rl_exprn__construct_output_tuple(GoalList,
- OutputVars, OutputCode),
- { Mode = generate }
+ OutputVars, OutputCode)
;
- { OutputCode = empty },
- { Mode = test }
+ { OutputCode = empty }
),
{
@@ -671,6 +1230,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),
@@ -711,6 +1272,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.
@@ -726,7 +1301,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.
@@ -773,8 +1349,8 @@
%-----------------------------------------------------------------------------%
- % Shift the inputs to the expression out of the input tuple.
-:- pred rl_exprn__deconstruct_input_tuple(tuple_num::in, int::in,
+ % 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.
@@ -939,7 +1515,8 @@
{ proc_info_inferred_determinism(ProcInfo, Detism) },
rl_exprn_info_get_parent_pred_proc_ids(Parents0),
(
- % XXX Nondet top-down calls are not yet implemented.
+ % Nondet top-down calls are not simple goals,
+ % and are only supported with `--aditi-calls-mercury'.
{ determinism_components(Detism, _, at_most_many) }
->
{ goal_info_get_context(GoalInfo, Context) },
@@ -947,29 +1524,19 @@
ModuleInfo, PredId, ProcId,
"nondeterministic Mercury calls in Aditi procedures") }
;
- % XXX Top-down calls to imported predicates
- % are not yet implemented.
+ % Calls to imported non-builtin predicates are not
+ % simple goals, and are only supported with
+ % `--aditi-calls-mercury'.
{ 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,
ModuleInfo, PredId, ProcId,
"calls to imported Mercury procedures from Aditi") }
;
- % XXX Recursive top-down calls are not yet implemented.
+ % Recursive calls are not % simple goals, and are only
+ % supported with `--aditi-calls-mercury'.
{ set__member(proc(PredId, ProcId), Parents0) }
->
{ goal_info_get_context(GoalInfo, Context) },
@@ -981,6 +1548,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.
@@ -992,7 +1581,7 @@
string__append_list(
[
ContextStr, "in call to ", ProcName, ":\n",
- "sorry, not yet implemented - ", ErrorDescr
+ ErrorDescr, " require `--aditi-calls-mercury'."
],
Msg),
error(Msg).
@@ -1782,15 +2371,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,
@@ -2206,6 +2796,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.
@@ -2239,6 +2833,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.
@@ -2284,19 +2887,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
@@ -2353,74 +2973,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),
- id_map_lookup(Const, Loc, Consts0, Consts),
- Info = rl_exprn_info(A,B,C,D,E,F,Consts,H,I,J).
+ Consts0 = Info0 ^ consts,
+ id_map_lookup(Const, Loc, Consts0, Consts),
+ 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.6
diff -u -u -r1.6 rl_file.pp
--- compiler/rl_file.pp 5 Nov 2003 03:17:43 -0000 1.6
+++ compiler/rl_file.pp 17 Oct 2004 12:00:47 -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.
@@ -344,6 +346,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.23
diff -u -u -r1.23 rl_out.pp
--- compiler/rl_out.pp 5 Nov 2003 03:17:43 -0000 1.23
+++ compiler/rl_out.pp 17 Oct 2004 12:00:47 -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.50
diff -u -u -r1.50 rtti.m
--- compiler/rtti.m 28 Jun 2004 04:49:47 -0000 1.50
+++ compiler/rtti.m 20 Sep 2004 13:52:31 -0000
@@ -538,6 +538,16 @@
)
; type_class_instance(
tc_instance
+ )
+
+ % 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
@@ -550,7 +560,8 @@
:- type rtti_id
---> ctor_rtti_id(rtti_type_ctor, ctor_rtti_name)
- ; tc_rtti_id(tc_name, tc_rtti_name).
+ ; tc_rtti_id(tc_name, tc_rtti_name)
+ ; aditi_rtti_id(rtti_proc_label).
:- type ctor_rtti_name
---> exist_locns(int) % functor ordinal
@@ -652,6 +663,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.
@@ -769,6 +783,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.
@@ -805,6 +821,7 @@
TCId = tc_id(TCName, _, _).
rtti_data_to_id(type_class_instance(tc_instance(TCName, TCTypes, _, _, _)),
tc_rtti_id(TCName, type_class_instance(TCTypes))).
+rtti_data_to_id(aditi_proc_info(ProcLabel, _, _), aditi_rtti_id(ProcLabel)).
tcd_get_rtti_type_ctor(TypeCtorData) = RttiTypeCtor :-
ModuleName = TypeCtorData ^ tcr_module_name,
@@ -861,6 +878,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).
@@ -872,6 +890,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_locn) = no.
@@ -974,10 +994,27 @@
PredId = ProcLabel ^ pred_id,
ProcId = ProcLabel ^ proc_id.
+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 ^ proc_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(TCName, TCRttiName), Str) :-
rtti__tc_name_to_string(TCName, 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.
@@ -1574,6 +1611,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_locn) = no.
@@ -1647,6 +1685,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),
@@ -1672,6 +1711,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),
@@ -1842,6 +1883,9 @@
RttiId = tc_rtti_id(_, TCRttiName),
ShouldModuleQualify =
module_qualify_name_of_tc_rtti_name(TCRttiName)
+ ;
+ RttiId = aditi_rtti_id(_),
+ ShouldModuleQualify = yes
).
module_qualify_name_of_ctor_rtti_name(_) = yes.
Index: compiler/rtti_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_out.m,v
retrieving revision 1.48
diff -u -u -r1.48 rtti_out.m
--- compiler/rtti_out.m 30 Jun 2004 02:48:11 -0000 1.48
+++ compiler/rtti_out.m 20 Sep 2004 13:52:31 -0000
@@ -82,8 +82,10 @@
:- import_module backend_libs__c_util.
:- 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__code_model.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_pred.
:- import_module libs__globals.
@@ -114,6 +116,44 @@
output_type_class_decl_defn(TCDecl, !DeclSet, !IO).
output_rtti_data_defn(type_class_instance(InstanceDecl), !DeclSet, !IO) :-
output_type_class_instance_defn(InstanceDecl, !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, !DeclSet, !IO),
+
+ output_rtti_id_storage_type_name(aditi_rtti_id(ProcLabel), yes,
+ !DeclSet, !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_detism),
+ !IO),
+ io__write_string("\n};\n", !IO).
%-----------------------------------------------------------------------------%
@@ -1537,6 +1577,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.55
diff -u -u -r1.55 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m 2 Aug 2004 08:30:08 -0000 1.55
+++ compiler/rtti_to_mlds.m 20 Sep 2004 13:52:32 -0000
@@ -52,6 +52,7 @@
:- import_module backend_libs__pseudo_type_info.
:- import_module backend_libs__type_ctor_info.
:- import_module check_hlds__type_util.
+:- import_module hlds__code_model.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_pred.
:- import_module ml_backend__ml_closure_gen.
@@ -267,6 +268,38 @@
% gen_init_proc_id_from_univ(ModuleInfo, PrettyprinterProc)
]).
+gen_init_rtti_data_defn(RttiData, RttiId, 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 ^ proc_module, ProcLabel ^ proc_name)/
+ ProcLabel ^ proc_arity,
+ ProcNameStr),
+ module_info_name(ModuleInfo, ModuleName),
+
+ Init = init_struct(mlds__rtti_type(item_type(RttiId)), [
+ 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_detism))
+ ]),
+ SubDefns = InputTypeInfoDefns ++ OutputTypeInfoDefns.
+
%-----------------------------------------------------------------------------%
:- pred gen_type_class_decl_defn(tc_decl::in, rtti_id::in, module_info::in,
@@ -1164,6 +1197,8 @@
gen_init_rtti_name(ModuleName, RttiTypeCtor, RttiName).
gen_init_rtti_id(ModuleName, tc_rtti_id(TCName, TCRttiName)) =
gen_init_tc_rtti_name(ModuleName, TCName, 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
@@ -1181,6 +1216,14 @@
gen_init_tc_rtti_name(ModuleName, TCName, TCRttiName) =
init_obj(gen_tc_rtti_name(ModuleName, TCName, 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)
@@ -1198,6 +1241,8 @@
gen_rtti_name(ThisModuleName, RttiTypeCtor, RttiName).
gen_rtti_id(ThisModuleName, tc_rtti_id(TCName, TCRttiName)) =
gen_tc_rtti_name(ThisModuleName, TCName, 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.
@@ -1289,6 +1334,14 @@
MLDS_ModuleName = mlds_module_name_from_tc_name(TCName)
),
MLDS_DataName = rtti(tc_rtti_id(TCName, 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.94
diff -u -u -r1.94 stack_layout.m
--- compiler/stack_layout.m 16 Aug 2004 03:51:02 -0000 1.94
+++ compiler/stack_layout.m 20 Sep 2004 13:52:32 -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 hlds__code_model.
:- import_module hlds__goal_util.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_goal.
@@ -1585,49 +1591,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.393
diff -u -u -r1.393 user_guide.texi
--- doc/user_guide.texi 16 Oct 2004 15:08:09 -0000 1.393
+++ doc/user_guide.texi 17 Oct 2004 09:32:50 -0000
@@ -5652,6 +5652,24 @@
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
+ at c aditi
+
@end table
@node Developer compilation model options
@@ -6732,12 +6750,6 @@
process creation for each one.)
@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
@findex --aditi-user
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.113
diff -u -u -r1.113 Mmakefile
--- runtime/Mmakefile 20 Jul 2004 04:41:20 -0000 1.113
+++ runtime/Mmakefile 20 Sep 2004 13:52:42 -0000
@@ -23,6 +23,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.67
diff -u -u -r1.67 mercury.h
--- runtime/mercury.h 3 Dec 2003 05:58:47 -0000 1.67
+++ runtime/mercury.h 10 Jan 2004 06:28:24 -0000
@@ -34,6 +34,7 @@
/* the type in io.m whose foreign_type is */
/* MercuryFilePtr XXX */
#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_aditi.h
===================================================================
RCS file: runtime/mercury_aditi.h
diff -N runtime/mercury_aditi.h
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ runtime/mercury_aditi.h 2 Apr 2004 11:40:01 -0000
@@ -0,0 +1,43 @@
+/*
+** Copyright (C) 2003 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** mercury_aditi.h - definitions for interfacing with Aditi.
+*/
+
+#ifndef MERCURY_ADITI_H
+#define MERCURY_ADITI_H
+
+#include "mercury_stack_layout.h" /* for MR_Determinism */
+#include "mercury_type_info.h" /* for MR_TypeInfo */
+
+/*
+** MR_Aditi_Proc_Info_Struct describes the top-down procedures created
+** for complex join conditions in bottom-up Aditi procedures.
+** These procedures will only ever have two arguments -- an
+** input and an output, both of which will be tuples.
+*/
+typedef struct MR_Aditi_Proc_Info_Struct {
+ MR_ProcAddr 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;
+} MR_Aditi_Proc_Info;
+
+#ifndef MR_STATIC_CODE_ADDRESSES
+
+ #define MR_INIT_ADITI_PROC_INFO(api, addr) \
+ do { (api).MR_aditi_proc_addr = (addr); } while (0)
+
+#else /* MR_STATIC_CODE_ADDRESSES */
+
+ #define MR_INIT_ADITI_PROC_INFO(api, addr) \
+ do { } while (0)
+
+#endif /* MR_STATIC_CODE_ADDRESSES */
+
+#endif /* not MERCURY_ADITI_H */
Index: runtime/mercury_imp.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_imp.h,v
retrieving revision 1.23
diff -u -u -r1.23 mercury_imp.h
--- runtime/mercury_imp.h 20 Jul 2004 04:41:22 -0000 1.23
+++ runtime/mercury_imp.h 20 Sep 2004 13:52:43 -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.85
diff -u -u -r1.85 mercury_stack_layout.h
--- runtime/mercury_stack_layout.h 16 Aug 2004 03:51:09 -0000 1.85
+++ runtime/mercury_stack_layout.h 20 Sep 2004 13:52:44 -0000
@@ -49,6 +49,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.13
diff -u -u -r1.13 Mercury.options
--- tests/valid/Mercury.options 9 Aug 2004 07:16:14 -0000 1.13
+++ tests/valid/Mercury.options 20 Sep 2004 13:57:42 -0000
@@ -22,9 +22,10 @@
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
-MCFLAGS-aditi_error_bug = --aditi
MCFLAGS-aditi_private_builtin = --allow-stubs
MCFLAGS-aditi_query = --aditi-only
MCFLAGS-aditi_update = --aditi
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.143
diff -u -u -r1.143 Mmakefile
--- tests/valid/Mmakefile 5 Jul 2004 04:02:59 -0000 1.143
+++ tests/valid/Mmakefile 3 Oct 2004 07:23:17 -0000
@@ -29,6 +29,7 @@
typeclass_det_warning
ADITI_PROGS= \
+ aditi_calls_mercury \
aditi_error_bug \
aditi_update \
base_relation \
@@ -255,11 +256,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 and
-# term size profiling grades.
-ifneq "$(filter hl% java% il%,$(GRADE))$(findstring profdeep,$(GRADE))" ""
+# Aditi is only implemented for the C and asm back-ends
+# (i.e. not grades java* il*).
+ifneq "$(filter java% il%,$(GRADE))$(findstring profdeep,$(GRADE))" ""
# We currently don't do any testing in grade java on this directory.
ifneq "$(findstring java,$(GRADE))$" ""
PROGS3 =
@@ -282,7 +281,7 @@
OBJ_PROGS = $(PROGS4)
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 10 Jan 2004 06:28:24 -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