for review: Aditi [2]

Simon Taylor stayl at cs.mu.OZ.AU
Tue Jul 7 13:43:31 AEST 1998


Index: compiler/hlds_module.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_module.m,v
retrieving revision 1.34
diff -u -t -u -r1.34 hlds_module.m
--- hlds_module.m	1998/05/07 06:41:03	1.34
+++ hlds_module.m	1998/06/02 05:14:24
@@ -178,6 +178,9 @@
 :- pred module_info_globals(module_info, globals).
 :- mode module_info_globals(in, out) is det.
 
+:- pred module_info_set_globals(module_info, globals, module_info).
+:- mode module_info_set_globals(in, in, out) is det.
+
 :- pred module_info_get_c_header(module_info, c_header_info).
 :- mode module_info_get_c_header(in, out) is det.
 
@@ -255,6 +258,10 @@
         pred_info, proc_info).
 :- mode module_info_pred_proc_info(in, in, in, out, out) is det.
 
+:- pred module_info_pred_proc_info(module_info, pred_proc_id,
+        pred_info, proc_info).
+:- mode module_info_pred_proc_info(in, in, out, out) is det.
+
         % Return a list of the pred_ids of all the "valid" predicates.
         % (Predicates whose definition contains a type error, etc.
         % get removed from this list, so that later passes can rely
@@ -289,6 +296,10 @@
         pred_id, proc_id, pred_info, proc_info, module_info).
 :- mode module_info_set_pred_proc_info(in, in, in, in, in, out) is det.
 
+:- pred module_info_set_pred_proc_info(module_info,
+        pred_proc_id, pred_info, proc_info, module_info).
+:- mode module_info_set_pred_proc_info(in, in, in, in, out) is det.
+
 :- pred module_info_typeids(module_info, list(type_id)).
 :- mode module_info_typeids(in, out) is det.
 
@@ -304,6 +315,10 @@
 :- pred module_info_dependency_info(module_info, dependency_info).
 :- mode module_info_dependency_info(in, out) is det.
 
+:- pred module_info_aditi_dependency_ordering(module_info, 
+                aditi_dependency_ordering).
+:- mode module_info_aditi_dependency_ordering(in, out) is det.
+
 :- pred module_info_set_dependency_info(module_info, dependency_info,
         module_info).
 :- mode module_info_set_dependency_info(in, in, out) is det.
@@ -366,6 +381,9 @@
 :- pred module_sub_get_globals(module_sub_info, globals).
 :- mode module_sub_get_globals(in, out) is det.
 
+:- pred module_sub_set_globals(module_sub_info, globals, module_sub_info).
+:- mode module_sub_set_globals(in, in, out) is det.
+
 :- pred module_sub_get_c_header_info(module_sub_info, c_header_info).
 :- mode module_sub_get_c_header_info(in, out) is det.
 
@@ -588,6 +606,10 @@
 
         % Various predicates which modify the module_sub_info data structure.
 
+module_sub_set_globals(MI0, B, MI) :-
+        MI0 = module_sub(A, _, C, D, E, F, G, H, I, J, K, L, M),
+        MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M).
+
 module_sub_set_c_header_info(MI0, C, MI) :-
         MI0 = module_sub(A, B, _, D, E, F, G, H, I, J, K, L, M),
         MI  = module_sub(A, B, C, D, E, F, G, H, I, J, K, L, M).
@@ -815,6 +837,11 @@
         % Various predicates which modify the module_sub_info data structure
         % via the module_info structure.
 
+module_info_set_globals(MI0, B, MI) :-
+        module_info_get_sub_info(MI0, MS0),
+        module_sub_set_globals(MS0, B, MS),
+        module_info_set_sub_info(MI0, MS, MI).
+
 module_info_set_c_header(MI0, C, MI) :-
         module_info_get_sub_info(MI0, MS0),
         module_sub_set_c_header_info(MS0, C, MS),
@@ -895,6 +922,9 @@
         pred_info_procedures(PredInfo, Procs),
         map__lookup(Procs, ProcId, ProcInfo).
 
+module_info_pred_proc_info(MI, proc(PredId, ProcId), PredInfo, ProcInfo) :-
+        module_info_pred_proc_info(MI, PredId, ProcId, PredInfo, ProcInfo).
+
 module_info_predids(MI, PredIds) :-
         module_info_get_predicate_table(MI, PredTable),
         predicate_table_get_predids(PredTable, PredIds).
@@ -924,6 +954,11 @@
         map__set(Preds0, PredId, PredInfo, Preds),
         module_info_set_preds(MI0, Preds, MI).
 
+module_info_set_pred_proc_info(MI0, proc(PredId, ProcId),
+                PredInfo, ProcInfo, MI) :-
+        module_info_set_pred_proc_info(MI0, PredId, ProcId,
+                PredInfo, ProcInfo, MI).
+
 module_info_set_pred_proc_info(MI0, PredId, ProcId, PredInfo0, ProcInfo, MI) :-
         pred_info_procedures(PredInfo0, Procs0),
         map__set(Procs0, ProcId, ProcInfo, Procs),
@@ -955,6 +990,16 @@
                 error("Attempted to access invalid dependency_info")
         ).
 
+module_info_aditi_dependency_ordering(MI, AditiOrdering) :-
+        module_info_dependency_info(MI, DepInfo),
+        hlds_dependency_info_get_maybe_aditi_dependency_ordering(DepInfo,
+                MaybeOrdering),
+        ( MaybeOrdering = yes(OrderingPrime) ->
+                AditiOrdering = OrderingPrime
+        ;
+                error("Attempted to access invalid aditi_dependency_ordering")
+        ).
+
 module_info_set_dependency_info(MI0, DependencyInfo, MI) :-
         module_info_set_maybe_dependency_info(MI0, yes(DependencyInfo), MI).
 
@@ -1011,8 +1056,16 @@
 
 :- interface.
 
-:- type dependency_ordering     == list(list(pred_proc_id)).
-:- type dependency_graph        == relation(pred_proc_id).
+:- type dependency_ordering             == list(list(pred_proc_id)).
+
+:- type aditi_dependency_ordering       == list(aditi_sub_module).
+
+        % Each Aditi SCC contains one or more SCCs from the original 
+        % dependency ordering and the entry points of the SCC.
+:- type aditi_sub_module
+        --->    aditi_sub_module(dependency_ordering, list(pred_proc_id)).
+
+:- type dependency_graph                == relation(pred_proc_id).
 :- type dependency_info.
 
 :- pred hlds_dependency_info_init(dependency_info).
@@ -1026,6 +1079,11 @@
         dependency_ordering).
 :- mode hlds_dependency_info_get_dependency_ordering(in, out) is det.
 
+:- pred hlds_dependency_info_get_maybe_aditi_dependency_ordering(
+                dependency_info, maybe(aditi_dependency_ordering)).
+:- mode hlds_dependency_info_get_maybe_aditi_dependency_ordering(in, 
+                out) is det.
+
 :- pred hlds_dependency_info_set_dependency_graph(dependency_info,
         dependency_graph, dependency_info).
 :- mode hlds_dependency_info_set_dependency_graph(in, in, out) is det.
@@ -1034,6 +1092,10 @@
         dependency_ordering, dependency_info).
 :- mode hlds_dependency_info_set_dependency_ordering(in, in, out) is det.
 
+:- pred hlds_dependency_info_set_aditi_dependency_ordering(dependency_info,
+        aditi_dependency_ordering, dependency_info).
+:- mode hlds_dependency_info_set_aditi_dependency_ordering(in, in, out) is det.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -1041,27 +1103,38 @@
 :- type dependency_info --->
                 dependency_info(
                         dependency_graph,       % Dependency graph
-                        dependency_ordering     % Dependency ordering
+                        dependency_ordering,    % Dependency ordering
+                        maybe(aditi_dependency_ordering)
+                                                % Dependency ordering of Aditi
+                                                % SCCs with some merged
                 ).
 
 hlds_dependency_info_init(DepInfo) :-
         relation__init(DepRel),
         DepOrd = [],
-        DepInfo = dependency_info(DepRel, DepOrd).
+        DepInfo = dependency_info(DepRel, DepOrd, no).
 
 hlds_dependency_info_get_dependency_graph(DepInfo, A) :-
-        DepInfo = dependency_info(A, _).
+        DepInfo = dependency_info(A, _, _).
 
 hlds_dependency_info_get_dependency_ordering(DepInfo, B) :-
-        DepInfo = dependency_info(_, B).
+        DepInfo = dependency_info(_, B, _).
+
+hlds_dependency_info_get_maybe_aditi_dependency_ordering(DepInfo, C) :-
+        DepInfo = dependency_info(_, _, C).
 
-hlds_dependency_info_set_dependency_graph(DepInfo0, A, DepInfo) :-
-        DepInfo0 = dependency_info(_, B),
-        DepInfo  = dependency_info(A, B).
-
-hlds_dependency_info_set_dependency_ordering(DepInfo0, B, DepInfo) :-
-        DepInfo0 = dependency_info(A, _),
-        DepInfo  = dependency_info(A, B).
+hlds_dependency_info_set_dependency_graph(DepInfo0, DepRel, DepInfo) :-
+        DepInfo0 = dependency_info(_, B, C),
+        DepInfo = dependency_info(DepRel, B, C).
+
+hlds_dependency_info_set_dependency_ordering(DepInfo0, DepRel, DepInfo) :-
+        DepInfo0 = dependency_info(A, _, C),
+        DepInfo = dependency_info(A, DepRel, C).
+
+hlds_dependency_info_set_aditi_dependency_ordering(DepInfo0, 
+                DepOrd, DepInfo) :-
+        DepInfo0 = dependency_info(A, B, _),
+        DepInfo = dependency_info(A, B, yes(DepOrd)).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_out.m,v
retrieving revision 1.196
diff -u -t -u -r1.196 hlds_out.m
--- hlds_out.m	1998/06/19 03:16:14	1.196
+++ hlds_out.m	1998/07/06 23:57:16
@@ -537,7 +537,8 @@
         ;
                 { AppendVarnums = no }
         ),
-        ( { string__contains_char(Verbose, 'C') } ->
+
+        ( { string__contains_char(Verbose, 'C'), Clauses \= [] } ->
                 hlds_out__write_var_types(Indent, VarSet, AppendVarnums,
                         VarTypes, TVarSet),
 
@@ -566,7 +567,6 @@
 hlds_out__marker_name(inline, "inline").
 hlds_out__marker_name(no_inline, "no_inline").
 hlds_out__marker_name(dnf, "dnf").
-hlds_out__marker_name(magic, "magic").
 hlds_out__marker_name(obsolete, "obsolete").
 hlds_out__marker_name(class_method, "class_method").
 hlds_out__marker_name((impure), "impure").
@@ -575,6 +575,16 @@
 hlds_out__marker_name(terminates, "terminates").
 hlds_out__marker_name(check_termination, "check_termination").
 hlds_out__marker_name(does_not_terminate, "does_not_terminate").
+hlds_out__marker_name(aditi, "aditi").
+hlds_out__marker_name(aditi_interface, "aditi_interface").
+hlds_out__marker_name(base_relation, "base_relation").
+hlds_out__marker_name(generate_inline, "generate_inline").
+hlds_out__marker_name(memo, "memo").
+hlds_out__marker_name(no_memo, "no_memo").
+hlds_out__marker_name(naive, "naive").
+hlds_out__marker_name(psn, "psn").
+hlds_out__marker_name(supp_magic, "supp_magic").
+hlds_out__marker_name(context, "context").
 
 hlds_out__write_marker(Marker) -->
         { hlds_out__marker_name(Marker, Name) },
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_pred.m,v
retrieving revision 1.48
diff -u -t -u -r1.48 hlds_pred.m
--- hlds_pred.m	1998/05/15 07:07:10	1.48
+++ hlds_pred.m	1998/06/04 06:29:24
@@ -204,10 +204,47 @@
                                 % Conflicts with `inline' marker.
         ;       dnf             % Requests that this predicate be transformed
                                 % into disjunctive normal form.
-        ;       magic           % Requests that this predicate be transformed
-                                % using the magic set transformation
-                                % Used for pragma(memo).
-                                % Used for pragma(memo).
+        ;       memo            % Requests that this predicate be evaluated
+                                % using memoing.
+        ;       no_memo         % Ensure that this procedure is not memoed.
+        
+        ;       aditi           % Generate Aditi-RL for this predicate.
+        ;       base_relation   % This predicate is an Aditi base relation.
+
+                        % `naive' and `psn' are mutually exclusive.
+        ;       naive           % Use naive evaluation.
+        ;       psn             % Use predicate semi-naive evaluation.
+
+                        % `context' and `supp_magic' are mutually
+                        % exclusive. One of them must be performed
+                        % on all Aditi procedures. `supp_magic'
+                        % is the default
+
+        ;       supp_magic      % Perform the supplementary magic sets
+                                % transformation on this predicate. 
+        ;       context         % Perform the context transformation on
+                                % the predicate. 
+
+        ;       generate_inline % Used for small procedures which project
+                                % a relation to be used as input to a call.
+                                % The goal should consist of fail, true
+                                % or a single rule.
+                                % These relations are never memoed.
+                                % The reason these must be generated inline
+                                % is to ensure that the relation used for
+                                % input is a projection of the current 
+                                % value of the projected relation for all
+                                % orderings of the SCC.
+
+        ;       aditi_interface % No code is actually generated for this
+                                % procedure type. A call to a procedure with
+                                % this marker is generated as a call to
+                                % do_call_aditi_*, which is defined in hand
+                                % coded C in extras/aditi/aditi.m.
+
+                                % The default flags for Aditi procedures are
+                                % aditi, dnf, supp_magic, psn and memo.
+
         ;       class_method    % Requests that this predicate be transformed
                                 % into the appropriate call to a class method
         ;       (impure)        % Requests that no transformation that would
@@ -267,9 +304,9 @@
 :- pred hlds_pred__define_new_pred(hlds_goal, hlds_goal, list(var),
                 instmap, string, tvarset, map(var, type),
                 list(class_constraint), map(tvar, type_info_locn),
-                map(class_constraint, var), varset, pred_markers, 
+                map(class_constraint, var), varset, pred_markers, string,
                 module_info, module_info, pred_proc_id).
-:- mode hlds_pred__define_new_pred(in, out, in, in, in, in, in,
+:- mode hlds_pred__define_new_pred(in, out, in, in, in, in, in, in,
                 in, in, in, in, in, in, out, out) is det.
 
         % Various predicates for accessing the information stored in the
@@ -278,23 +315,24 @@
 :- pred pred_info_init(module_name, sym_name, arity, tvarset, list(type),
         condition, term__context, clauses_info, import_status,
         pred_markers, goal_type, pred_or_func, list(class_constraint), 
-        map(class_constraint, constraint_proof), pred_info).
+        map(class_constraint, constraint_proof), string, pred_info).
 :- mode pred_info_init(in, in, in, in, in, in, in, in, in, in, in, in, in, in,
-        out) is det.
+        in, out) is det.
 
 :- pred pred_info_create(module_name, sym_name, tvarset, list(type),
         condition, term__context, import_status, pred_markers,
-        pred_or_func, list(class_constraint), proc_info, proc_id, pred_info).
-:- mode pred_info_create(in, in, in, in, in, in, in, in, in, in, in, out, out)
-        is det.
+        pred_or_func, list(class_constraint), string, proc_info,
+        proc_id, pred_info).
+:- mode pred_info_create(in, in, in, in, in, in, in, in, in, in, in, in,
+        out, out) is det.
 
 :- pred pred_info_set(tvarset, list(type), condition, clauses_info, proc_table,
         term__context, module_name, string, arity, import_status,
         tvarset, goal_type, pred_markers, pred_or_func, 
         list(class_constraint), map(class_constraint, constraint_proof),
-        pred_info).
+        string, pred_info).
 :- mode pred_info_set(in, in, in, in, in, in, in, in, in, in, in, in, in, in, 
-        in, in, out) is det.
+        in, in, in, out) is det.
 
 :- pred pred_info_module(pred_info, module_name).
 :- mode pred_info_module(in, out) is det.
@@ -405,6 +443,12 @@
         map(class_constraint, constraint_proof), pred_info).
 :- mode pred_info_set_constraint_proofs(in, in, out) is det.
 
+:- pred pred_info_get_aditi_owner(pred_info, string).
+:- mode pred_info_get_aditi_owner(in, out) is det.
+
+:- pred pred_info_set_aditi_owner(pred_info, string, pred_info).
+:- mode pred_info_set_aditi_owner(in, in, out) is det.
+
 :- pred pred_info_get_purity(pred_info, purity).
 :- mode pred_info_get_purity(in, out) is det.
 
@@ -434,6 +478,10 @@
 :- pred add_marker(pred_markers, marker, pred_markers).
 :- mode add_marker(in, in, out) is det.
 
+        % remove a marker from the set
+:- pred remove_marker(pred_markers, marker, pred_markers).
+:- mode remove_marker(in, in, out) is det.
+
         % convert the set to a list
 :- pred markers_to_marker_list(pred_markers, list(marker)).
 :- mode markers_to_marker_list(in, out) is det.
@@ -505,27 +553,33 @@
                         list(class_constraint),
                                         % the class constraints on the 
                                         % predicate
-                        map(class_constraint, constraint_proof)
+                        map(class_constraint, constraint_proof),
                                         % explanations of how redundant
                                         % constraints were eliminated. These
                                         % are needed by polymorphism.m to
                                         % work out where to get the
                                         % typeclass_infos from.
+                        string
+                                        % The owner of this predicate if
+                                        % it is an Aditi predicate. Set to
+                                        % the value of --aditi-user if no
+                                        % `:- pragma owner' declaration exists.
                 ).
 
 pred_info_init(ModuleName, SymName, Arity, TypeVarSet, Types, Cond, Context,
                 ClausesInfo, Status, Markers, GoalType, PredOrFunc, 
-                ClassContext, ClassProofs, PredInfo) :-
+                ClassContext, ClassProofs, User, PredInfo) :-
         map__init(Procs),
         unqualify_name(SymName, PredName),
         sym_name_get_module_name(SymName, ModuleName, PredModuleName),
         PredInfo = predicate(TypeVarSet, Types, Cond, ClausesInfo, Procs,
                 Context, PredModuleName, PredName, Arity, Status, TypeVarSet, 
-                GoalType, Markers, PredOrFunc, ClassContext, ClassProofs).
+                GoalType, Markers, PredOrFunc, ClassContext, ClassProofs,
+                User).
 
 pred_info_create(ModuleName, SymName, TypeVarSet, Types, Cond, Context,
-                Status, Markers, PredOrFunc, ClassContext, ProcInfo, ProcId,
-                PredInfo) :-
+                Status, Markers, PredOrFunc, ClassContext, User,
+                ProcInfo, ProcId, PredInfo) :-
         map__init(Procs0),
         proc_info_declared_determinism(ProcInfo, MaybeDetism),
         next_mode_id(Procs0, MaybeDetism, ProcId),
@@ -540,19 +594,21 @@
         map__init(ClassProofs),
         PredInfo = predicate(TypeVarSet, Types, Cond, ClausesInfo, Procs,
                 Context, ModuleName, PredName, Arity, Status, TypeVarSet, 
-                clauses, Markers, PredOrFunc, ClassContext, ClassProofs).
+                clauses, Markers, PredOrFunc, ClassContext, ClassProofs,
+                User).
 
 pred_info_set(HeadTVarSet, Types, Cond, ClausesInfo, Procs, Context,
                 PredModuleName, PredName, Arity, Status, AllTVarSet,
                 GoalType, Markers, PredOrFunc, ClassContext, ClassProofs,
-                PredInfo) :-
+                User, PredInfo) :-
         PredInfo = predicate(HeadTVarSet, Types, Cond, ClausesInfo, Procs,
                 Context, PredModuleName, PredName, Arity, Status, AllTVarSet, 
-                GoalType, Markers, PredOrFunc, ClassContext, ClassProofs).
+                GoalType, Markers, PredOrFunc, ClassContext, ClassProofs,
+                User).
 
 pred_info_procids(PredInfo, ProcIds) :-
         PredInfo = predicate(_, _, _, _, Procs, _, _, _, _, _, _, _, 
-                _, _, _, _),
+                _, _, _, _, _),
         map__keys(Procs, ProcIds).
 
 pred_info_non_imported_procids(PredInfo, ProcIds) :-
@@ -579,50 +635,53 @@
 
 pred_info_clauses_info(PredInfo, Clauses) :-
         PredInfo = predicate(_, _, _, Clauses, _, _, _, _, _, _, _, _,
-                _, _, _, _).
+                _, _, _, _, _).
 
 pred_info_set_clauses_info(PredInfo0, Clauses, PredInfo) :-
-        PredInfo0 = predicate(A, B, C, _, E, F, G, H, I, J, K, L, M, N, O, P),
+        PredInfo0 = predicate(A, B, C, _, E, F, G, H, I, J, K,
+                L, M, N, O, P, Q),
         PredInfo = predicate(A, B, C, Clauses, E, F, G, H, I, J, K, 
-                L, M, N, O, P).
+                L, M, N, O, P, Q).
 
 pred_info_arg_types(PredInfo, TypeVars, ArgTypes) :-
         PredInfo = predicate(TypeVars, ArgTypes, 
-                _, _, _, _, _, _, _, _, _, _, _, _, _, _).
+                _, _, _, _, _, _, _, _, _, _, _, _, _, _, _).
 
 pred_info_set_arg_types(PredInfo0, TypeVarSet, ArgTypes, PredInfo) :-
-        PredInfo0 = predicate(_, _, C, D, E, F, G, H, I, J, K, L, M, N, O, P),
+        PredInfo0 = predicate(_, _,
+                        C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q),
         PredInfo = predicate(TypeVarSet, ArgTypes, 
-                        C, D, E, F, G, H, I, J, K, L, M, N, O, P).
+                        C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q).
 
 pred_info_procedures(PredInfo, Procs) :-
         PredInfo = predicate(_, _, _, _, Procs, _, _, _, _, _, _, 
-                _, _, _, _, _).
+                _, _, _, _, _, _).
 
 pred_info_set_procedures(PredInfo0, Procedures, PredInfo) :-
-        PredInfo0 = predicate(A, B, C, D, _, F, G, H, I, J, K, L, M, N, O, P),
+        PredInfo0 = predicate(A, B, C, D, _, F, G, H, I, J, K, L, M,
+                N, O, P, Q),
         PredInfo = predicate(A, B, C, D, Procedures, F, G, H, I, J, K, L, M, 
-                N, O, P).
+                N, O, P, Q).
 
 pred_info_context(PredInfo, Context) :-
         PredInfo = predicate(_, _, _, _, _, Context, _, _, _, 
-                _, _, _, _, _, _, _).
+                _, _, _, _, _, _, _, _).
 
 pred_info_module(PredInfo, Module) :-
         PredInfo = predicate(_, _, _, _, _, _, Module, _, _, _, _, 
-                _, _, _, _, _).
+                _, _, _, _, _, _).
 
 pred_info_name(PredInfo, PredName) :-
         PredInfo = predicate(_, _, _, _, _, _, _, PredName, _, _, _, 
-                _, _, _, _, _).
+                _, _, _, _, _, _).
 
 pred_info_arity(PredInfo, Arity) :-
         PredInfo = predicate(_, _, _, _, _, _, _, _, Arity, _, _, 
-                _, _, _, _, _).
+                _, _, _, _, _, _).
 
 pred_info_import_status(PredInfo, ImportStatus) :-
         PredInfo = predicate(_, _, _, _, _, _, _, _, _, ImportStatus, _, _, _,
-                                _, _, _).
+                                _, _, _, _).
 
 pred_info_is_imported(PredInfo) :-
         pred_info_import_status(PredInfo, imported).
@@ -640,32 +699,36 @@
         ImportStatus = pseudo_exported.
 
 pred_info_mark_as_external(PredInfo0, PredInfo) :-
-        PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, _, K, L, M, N, O, P),
+        PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, _, K, L, M,
+                N, O, P, Q),
         PredInfo  = predicate(A, B, C, D, E, F, G, H, I, imported, K, L, M, 
-                N, O, P).
+                N, O, P, Q).
 
 pred_info_set_import_status(PredInfo0, Status, PredInfo) :-
-        PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, _, K, L, M, N, O, P),
+        PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, _, K,
+                L, M, N, O, P, Q),
         PredInfo  = predicate(A, B, C, D, E, F, G, H, I, Status, K, 
-                L, M, N, O, P).
+                L, M, N, O, P, Q).
 
 pred_info_typevarset(PredInfo, TypeVarSet) :-
         PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, TypeVarSet, _, _, 
-                _, _, _).
+                _, _, _, _).
 
 pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo) :-
-        PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, _, L, M, N, O, P),
+        PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, _, L, M,
+                                N, O, P, Q),
         PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, TypeVarSet, L, M,
-                                N, O, P).
+                                N, O, P, Q).
 
 pred_info_get_goal_type(PredInfo, GoalType) :-
         PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, GoalType, _, 
-                _, _, _).
+                _, _, _, _).
 
 pred_info_set_goal_type(PredInfo0, GoalType, PredInfo) :-
-        PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, _, M, N, O, P),
+        PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, _, M,
+                N, O, P, Q),
         PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, K, GoalType, M, 
-                N, O, P).
+                N, O, P, Q).
 
 pred_info_requested_inlining(PredInfo0) :-
         pred_info_get_markers(PredInfo0, Markers),
@@ -699,34 +762,47 @@
 
 pred_info_get_markers(PredInfo, Markers) :-
         PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, _, Markers, 
-                _, _, _).
+                _, _, _, _).
 
 pred_info_set_markers(PredInfo0, Markers, PredInfo) :-
-        PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, _, N, O, P),
+        PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, _,
+                N, O, P, Q),
         PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, K, L, Markers, 
-                N, O, P).
+                N, O, P, Q).
 
 pred_info_get_is_pred_or_func(PredInfo, IsPredOrFunc) :-
         PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, _, _,
-                        IsPredOrFunc, _, _).
+                        IsPredOrFunc, _, _, _).
 
 pred_info_set_class_context(PredInfo0, ClassContext, PredInfo) :-
-        PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, M, N, _, P),
+        PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, M, N,
+                _, P, Q),
         PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, K, L, M, N, 
-                ClassContext, P).
+                ClassContext, P, Q).
 
 pred_info_get_class_context(PredInfo, ClassContext) :-
         PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, _, _, _, 
-                ClassContext, _).
+                ClassContext, _, _).
 
 pred_info_set_constraint_proofs(PredInfo0, Proofs, PredInfo) :-
-        PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, _),
+        PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, M, N,
+                O, _, Q),
         PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, K, L, M, N, 
-                O, Proofs).
+                O, Proofs, Q).
 
 pred_info_get_constraint_proofs(PredInfo, ConstraintProofs) :-
         PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
-                ConstraintProofs).
+                ConstraintProofs, _).
+
+pred_info_set_aditi_owner(PredInfo0, Owner, PredInfo) :-
+        PredInfo0 = predicate(A, B, C, D, E, F, G, H, I, J, K, L, M, N,
+                O, P, _),
+        PredInfo  = predicate(A, B, C, D, E, F, G, H, I, J, K, L, M, N, 
+                O, P, Owner).
+
+pred_info_get_aditi_owner(PredInfo, User) :-
+        PredInfo = predicate(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
+                _, User).
 
 %-----------------------------------------------------------------------------%
 
@@ -746,13 +822,16 @@
 
 add_marker(Markers, Marker, [Marker | Markers]).
 
+remove_marker(Markers0, Marker, Markers) :-
+        list__delete_all(Markers0, Marker, Markers).
+
 markers_to_marker_list(Markers, Markers).
 
 %-----------------------------------------------------------------------------%
 
 hlds_pred__define_new_pred(Goal0, Goal, ArgVars0, InstMap0, PredName, TVarSet, 
                 VarTypes0, ClassContext, TVarMap, TCVarMap, VarSet0, 
-                Markers, ModuleInfo0, ModuleInfo, PredProcId) :-
+                Markers, User, ModuleInfo0, ModuleInfo, PredProcId) :-
         Goal0 = _GoalExpr - GoalInfo,
         goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
         instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap),
@@ -802,7 +881,7 @@
 
         pred_info_create(ModuleName, SymName, TVarSet, ArgTypes, true,
                 Context, local, Markers, predicate, ClassContext, 
-                ProcInfo, ProcId, PredInfo),
+                User, ProcInfo, ProcId, PredInfo),
 
         module_info_get_predicate_table(ModuleInfo0, PredTable0),
         predicate_table_insert(PredTable0, PredInfo, PredId,
@@ -1559,6 +1638,108 @@
 
 %-----------------------------------------------------------------------------%
 
+        % Predicates to check whether a given predicate 
+        % is an Aditi query.
+
+:- interface.
+
+:- pred hlds_pred__is_base_relation(module_info, pred_id).
+:- mode hlds_pred__is_base_relation(in, in) is semidet.
+
+:- pred hlds_pred__is_derived_relation(module_info, pred_id).
+:- mode hlds_pred__is_derived_relation(in, in) is semidet.
+
+        % Is the given predicate a base or derived Aditi relation.
+:- pred hlds_pred__is_aditi_relation(module_info, pred_id).
+:- mode hlds_pred__is_aditi_relation(in, in) is semidet.
+
+:- pred hlds_pred__is_aditi_aggregate(module_info, pred_id).
+:- mode hlds_pred__is_aditi_aggregate(in, in) is semidet.
+
+:- pred hlds_pred__pred_info_is_aditi_relation(pred_info).
+:- mode hlds_pred__pred_info_is_aditi_relation(in) is semidet.
+
+:- pred hlds_pred__pred_info_is_aditi_aggregate(pred_info).
+:- mode hlds_pred__pred_info_is_aditi_aggregate(in) is semidet.
+
+:- pred hlds_pred__pred_info_is_base_relation(pred_info).
+:- mode hlds_pred__pred_info_is_base_relation(in) is semidet.
+
+:- pred hlds_pred__is_memoed(module_info, pred_id).
+:- mode hlds_pred__is_memoed(in, in) is semidet.
+
+:- pred hlds_pred__is_differential(module_info, pred_id).
+:- mode hlds_pred__is_differential(in, in) is semidet.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+hlds_pred__is_base_relation(ModuleInfo, PredId) :-
+        module_info_pred_info(ModuleInfo, PredId, PredInfo),
+        hlds_pred__pred_info_is_base_relation(PredInfo).
+
+hlds_pred__pred_info_is_base_relation(PredInfo) :-
+        pred_info_get_markers(PredInfo, Markers),
+        check_marker(Markers, base_relation).
+
+hlds_pred__is_derived_relation(ModuleInfo, PredId) :-
+        module_info_pred_info(ModuleInfo, PredId, PredInfo),
+        pred_info_get_markers(PredInfo, Markers),
+        check_marker(Markers, aditi),
+        \+ hlds_pred__pred_info_is_base_relation(PredInfo),
+        \+ hlds_pred__pred_info_is_aditi_aggregate(PredInfo).
+
+hlds_pred__is_aditi_relation(ModuleInfo, PredId) :-
+        module_info_pred_info(ModuleInfo, PredId, PredInfo),
+        hlds_pred__pred_info_is_aditi_relation(PredInfo).
+
+hlds_pred__pred_info_is_aditi_relation(PredInfo) :-
+        pred_info_get_markers(PredInfo, Markers),
+        check_marker(Markers, aditi).
+
+hlds_pred__is_aditi_aggregate(ModuleInfo, PredId) :-
+        module_info_pred_info(ModuleInfo, PredId, PredInfo),
+        hlds_pred__pred_info_is_aditi_aggregate(PredInfo).
+
+hlds_pred__pred_info_is_aditi_aggregate(PredInfo) :-
+        pred_info_module(PredInfo, Module),
+        pred_info_name(PredInfo, Name),
+        pred_info_arity(PredInfo, Arity),
+        hlds_pred__aditi_aggregate(Module, Name, Arity).
+
+:- pred hlds_pred__aditi_aggregate(sym_name, string, int).
+:- mode hlds_pred__aditi_aggregate(in, in, in) is semidet.
+
+hlds_pred__aditi_aggregate(unqualified("aditi"),
+                "aggregate_compute_initial", 5).
+
+hlds_pred__is_memoed(ModuleInfo, PredId) :-
+        module_info_pred_info(ModuleInfo, PredId, PredInfo),
+        pred_info_get_markers(PredInfo, Markers),
+        (
+                check_marker(Markers, memo)
+        ;
+                % Memoing is the default for Aditi procedures.
+                semidet_fail,   % XXXXXXXX
+                check_marker(Markers, aditi),
+                \+ check_marker(Markers, no_memo)
+        ).
+
+hlds_pred__is_differential(ModuleInfo, PredId) :-
+        module_info_pred_info(ModuleInfo, PredId, PredInfo),
+        pred_info_get_markers(PredInfo, Markers),
+        (
+                check_marker(Markers, psn)
+        ;
+                % Predicate semi-naive evaluation is the default. 
+                check_marker(Markers, aditi),
+                \+ check_marker(Markers, naive)
+        ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
 :- interface.
 
         % Check if the given evaluation method is allowed with
@@ -1611,3 +1792,5 @@
 eval_method_change_determinism(eval_minimal, Det0, Det) :-
         det_conjunction_detism(semidet, Det0, Det).
 
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: compiler/inlining.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inlining.m,v
retrieving revision 1.77
diff -u -t -u -r1.77 inlining.m
--- inlining.m	1998/06/09 02:12:58	1.77
+++ inlining.m	1998/07/01 03:56:42
@@ -81,6 +81,7 @@
 %-----------------------------------------------------------------------------%
 
 :- interface.
+
 :- import_module hlds_goal, hlds_module, hlds_pred, prog_data.
 :- import_module io, list, map, term, varset.
 
@@ -180,7 +181,11 @@
         { list__condense(SCCs, PredProcs) },
         { set__init(InlinedProcs0) },
         inlining__do_inlining(PredProcs, NeededMap, Params, InlinedProcs0,
-                ModuleInfo1, ModuleInfo).
+                ModuleInfo1, ModuleInfo2),
+
+                % The dependency graph is now out of date and 
+                % needs to be rebuilt.
+        { module_info_clobber_dependency_info(ModuleInfo2, ModuleInfo) }.
 
 :- pred inlining__do_inlining(list(pred_proc_id), needed_map, inline_params,
                 set(pred_proc_id), module_info, module_info,
@@ -240,7 +245,11 @@
                 \+ {
                         CalledGoal = pragma_c_code(_,_,_,_,_,_,_) - _,
                         proc_info_interface_code_model(ProcInfo, model_non)
-                }
+                },
+
+                % Don't inline memoed predicates.
+                { pred_info_get_markers(PredInfo, Markers) },
+                { \+ check_marker(Markers, memo) }
         ->
                 inlining__mark_proc_as_inlined(PredProcId, ModuleInfo,
                         InlinedProcs0, InlinedProcs)
@@ -309,9 +318,8 @@
                 % It also stores some necessary information that is not
                 % updated.
 
-:- type inline_info     --->
-
-        inline_info(
+:- type inline_info     
+        ---> inline_info(
                 int,                    % variable threshold for inlining
                 set(pred_proc_id),      % inlined procs
                 module_info,            % module_info
@@ -325,9 +333,10 @@
                                         % type variables to variables
                                         % where their type_info is
                                         % stored.
-                bool                    % Did we change the determinism
+                bool,                   % Did we change the determinism
                                         % of any subgoal?
-                ).
+                pred_markers            % Markers for the current predicate.
+        ).
 
 :- pred inlining__in_predproc(pred_proc_id, set(pred_proc_id), inline_params,
                 module_info, module_info, io__state, io__state).
@@ -345,6 +354,7 @@
         map__lookup(ProcTable0, ProcId, ProcInfo0),
 
         pred_info_typevarset(PredInfo0, TypeVarSet0),
+        pred_info_get_markers(PredInfo0, Markers),
 
         proc_info_goal(ProcInfo0, Goal0),
         proc_info_varset(ProcInfo0, VarSet0),
@@ -354,12 +364,13 @@
         DetChanged0 = no,
 
         InlineInfo0 = inline_info(VarThresh, InlinedProcs, ModuleInfo0,
-                VarSet0, VarTypes0, TypeVarSet0, TypeInfoVarMap0, DetChanged0),
+                VarSet0, VarTypes0, TypeVarSet0, TypeInfoVarMap0, 
+                DetChanged0, Markers),
 
         inlining__inlining_in_goal(Goal0, Goal, InlineInfo0, InlineInfo),
 
         InlineInfo = inline_info(_, _, _, VarSet, VarTypes, TypeVarSet, 
-                TypeInfoVarMap, DetChanged),
+                TypeInfoVarMap, DetChanged, _),
 
         pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo1),
 
@@ -426,12 +437,12 @@
 
         InlineInfo0 = inline_info(VarThresh, InlinedProcs, ModuleInfo,
                 VarSet0, VarTypes0, TypeVarSet0, TypeInfoVarMap0,
-                DetChanged0),
+                DetChanged0, Markers),
 
         % should we inline this call?
         (
                 inlining__should_inline_proc(PredId, ProcId, Builtin,
-                                InlinedProcs, ModuleInfo),
+                                InlinedProcs, Markers, ModuleInfo),
                         % okay, but will we exceed the number-of-variables
                         % threshold?
                 varset__vars(VarSet0, ListOfVars),
@@ -471,8 +482,8 @@
                 TypeInfoVarMap = TypeInfoVarMap0,
                 DetChanged = DetChanged0
         ),
-        InlineInfo = inline_info(VarThresh, InlinedProcs, ModuleInfo,
-                VarSet, VarTypes, TypeVarSet, TypeInfoVarMap, DetChanged).
+        InlineInfo = inline_info(VarThresh, InlinedProcs, ModuleInfo, VarSet, 
+                VarTypes, TypeVarSet, TypeInfoVarMap, DetChanged, Markers).
 
 inlining__inlining_in_goal(higher_order_call(A, B, C, D, E, F) - GoalInfo,
                 higher_order_call(A, B, C, D, E, F) - GoalInfo) --> [].
@@ -608,11 +619,11 @@
         % is a conjunction of builtins.
 
 :- pred inlining__should_inline_proc(pred_id, proc_id, builtin_state,
-        set(pred_proc_id), module_info).
-:- mode inlining__should_inline_proc(in, in, in, in, in) is semidet.
+        set(pred_proc_id), pred_markers, module_info).
+:- mode inlining__should_inline_proc(in, in, in, in, in, in) is semidet.
 
 inlining__should_inline_proc(PredId, ProcId, BuiltinState, InlinedProcs,
-                ModuleInfo) :-
+                CallingPredMarkers, ModuleInfo) :-
 
         % don't inline builtins, the code generator will handle them
 
@@ -643,6 +654,17 @@
         % not to inline.
 
         \+ pred_info_requested_no_inlining(PredInfo),
+
+        % Don't inline Aditi procedures into non-Aditi procedures,
+        % since this could result in joins being performed by
+        % backtracking rather than by more efficient methods in
+        % the database.
+
+        pred_info_get_markers(PredInfo, CalledPredMarkers),
+        \+ (
+                \+ check_marker(CallingPredMarkers, aditi),
+                check_marker(CalledPredMarkers, aditi)
+        ),
 
         % OK, we could inline it - but should we?  Apply our heuristic.
 
Index: compiler/lambda.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/lambda.m,v
retrieving revision 1.43
diff -u -t -u -r1.43 lambda.m
--- lambda.m	1998/06/09 02:13:05	1.43
+++ lambda.m	1998/06/11 01:04:48
@@ -49,10 +49,11 @@
 :- pred lambda__transform_lambda(pred_or_func, string, list(var), list(mode), 
                 determinism, list(var), set(var), hlds_goal, unification,
                 varset, map(var, type), list(class_constraint), tvarset,
-                map(tvar, type_info_locn), map(class_constraint, var),
-                module_info, unify_rhs, unification, module_info).
+                map(tvar, type_info_locn), pred_markers,
+                map(class_constraint, var), string, module_info,
+                unify_rhs, unification, module_info).
 :- mode lambda__transform_lambda(in, in, in, in, in, in, in, in, in, in, in,
-                in, in, in, in, in, out, out, out) is det.
+                in, in, in, in, in, in, in, out, out, out) is det.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -68,16 +69,18 @@
                 lambda_info(
                         varset,                 % from the proc_info
                         map(var, type),         % from the proc_info
-                        list(class_constraint), % from the pred_info
-                        tvarset,                % from the proc_info
+                        list(class_constraint), % from the pred_info
+                        tvarset,                % from the pred_info
                         map(tvar, type_info_locn),      
                                                 % from the proc_info 
                                                 % (typeinfos)
+                        pred_markers,           % from the pred_info
                         map(class_constraint, var),
                                                 % from the proc_info
                                                 % (typeclass_infos)
                         pred_or_func,
                         string,                 % pred/func name
+                        string,                 % Aditi owner
                         module_info
                 ).
 
@@ -127,7 +130,9 @@
         pred_info_name(PredInfo0, PredName),
         pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc),
         pred_info_typevarset(PredInfo0, TypeVarSet0),
+        pred_info_get_markers(PredInfo0, Markers),
         pred_info_get_class_context(PredInfo0, Constraints0),
+        pred_info_get_aditi_owner(PredInfo0, Owner),
         proc_info_varset(ProcInfo0, VarSet0),
         proc_info_vartypes(ProcInfo0, VarTypes0),
         proc_info_goal(ProcInfo0, Goal0),
@@ -136,10 +141,11 @@
 
         % process the goal
         Info0 = lambda_info(VarSet0, VarTypes0, Constraints0, TypeVarSet0,
-                TVarMap0, TCVarMap0, PredOrFunc, PredName, ModuleInfo0),
+                TVarMap0, Markers, TCVarMap0, PredOrFunc, 
+                PredName, Owner, ModuleInfo0),
         lambda__process_goal(Goal0, Goal, Info0, Info),
         Info = lambda_info(VarSet, VarTypes, Constraints, TypeVarSet, 
-                TVarMap, TCVarMap, _, _, ModuleInfo),
+                TVarMap, _, TCVarMap, _, _, _, ModuleInfo),
 
         % set the new values of the fields in proc_info and pred_info
         proc_info_set_goal(ProcInfo0, Goal, ProcInfo1),
@@ -240,20 +246,21 @@
 lambda__process_lambda(PredOrFunc, Vars, Modes, Det, OrigNonLocals0, LambdaGoal,
                 Unification0, Functor, Unification, LambdaInfo0, LambdaInfo) :-
         LambdaInfo0 = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
-                        TVarMap, TCVarMap, POF, PredName, ModuleInfo0),
+                TVarMap, Markers, TCVarMap, POF, PredName, Owner, ModuleInfo0),
         goal_util__extra_nonlocal_typeinfos(TVarMap, VarTypes,
                 LambdaGoal, ExtraTypeInfos),
         lambda__transform_lambda(PredOrFunc, PredName, Vars, Modes, Det,
                 OrigNonLocals0, ExtraTypeInfos, LambdaGoal, Unification0,
-                VarSet, VarTypes, Constraints, TVarSet, TVarMap, TCVarMap,
-                ModuleInfo0, Functor, Unification, ModuleInfo),
+                VarSet, VarTypes, Constraints, TVarSet, TVarMap, Markers,
+                TCVarMap, Owner, ModuleInfo0, Functor, Unification, ModuleInfo),
         LambdaInfo = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
-                        TVarMap, TCVarMap, POF, PredName, ModuleInfo).
+                TVarMap, Markers, TCVarMap, POF, PredName, Owner, ModuleInfo).
 
 lambda__transform_lambda(PredOrFunc, OrigPredName, Vars, Modes, Detism,
                 OrigVars, ExtraTypeInfos, LambdaGoal, Unification0,
-                VarSet, VarTypes, Constraints, TVarSet, TVarMap, TCVarMap,
-                ModuleInfo0, Functor, Unification, ModuleInfo) :-
+                VarSet, VarTypes, Constraints, TVarSet, TVarMap, Markers,
+                TCVarMap, Owner, ModuleInfo0, Functor,
+                Unification, ModuleInfo) :-
         (
                 Unification0 = construct(Var0, _, _, UniModes0)
         ->
@@ -385,6 +392,17 @@
                 list__append(ArgModes1, Modes, AllArgModes),
                 map__apply_to_list(AllArgVars, VarTypes, ArgTypes),
 
+                ( 
+                        % Pass through the aditi markers for 
+                        % aggregate query closures.
+                        Detism = nondet,
+                        check_marker(Markers, aditi)
+                ->
+                        LambdaMarkers = Markers
+                ;
+                        init_markers(LambdaMarkers)
+                ),
+
                 % Choose an args_method which is always directly callable
                 % from do_call_*_closure even if the inputs don't preceed
                 % the outputs in the declaration. mercury_ho_call.c requires
@@ -404,10 +422,9 @@
                         AllArgModes, Detism, LambdaGoal, LambdaContext,
                         TVarMap, TCVarMap, ArgsMethod, ProcInfo),
 
-                init_markers(Markers),
                 pred_info_create(ModuleName, PredName, TVarSet, ArgTypes,
-                        true, LambdaContext, local, Markers, PredOrFunc,
-                        Constraints, ProcInfo, ProcId, PredInfo),
+                        true, LambdaContext, local, LambdaMarkers, PredOrFunc, 
+                        Constraints, Owner, ProcInfo, ProcId, PredInfo),
 
                 % save the new predicate in the predicate table
 
Index: compiler/livemap.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/livemap.m,v
retrieving revision 1.35
diff -u -t -u -r1.35 livemap.m
--- livemap.m	1998/06/09 02:13:13	1.35
+++ livemap.m	1998/06/19 01:48:01
@@ -406,6 +406,9 @@
 livemap__special_code_addr(do_det_class_method, no).
 livemap__special_code_addr(do_semidet_class_method, no).
 livemap__special_code_addr(do_nondet_class_method, no).
+livemap__special_code_addr(do_det_aditi_call, no).
+livemap__special_code_addr(do_semidet_aditi_call, no).
+livemap__special_code_addr(do_nondet_aditi_call, no).
 livemap__special_code_addr(do_not_reached, no).
 
 %-----------------------------------------------------------------------------%
Index: compiler/llds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds.m,v
retrieving revision 1.225
diff -u -t -u -r1.225 llds.m
--- llds.m	1998/06/09 02:13:21	1.225
+++ llds.m	1998/06/19 01:41:22
@@ -689,6 +689,9 @@
         ;       do_det_class_method
         ;       do_semidet_class_method
         ;       do_nondet_class_method
+        ;       do_det_aditi_call
+        ;       do_semidet_aditi_call
+        ;       do_nondet_aditi_call
         ;       do_not_reached.         % we should never jump to this address
 
         % A proc_label is a label used for the entry point to a procedure.
Index: compiler/llds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds_out.m,v
retrieving revision 1.84
diff -u -t -u -r1.84 llds_out.m
--- llds_out.m	1998/06/18 06:06:32	1.84
+++ llds_out.m	1998/07/07 01:25:18
@@ -17,8 +17,8 @@
 
 :- interface.
 
-:- import_module llds, prog_data, hlds_data.
-:- import_module set_bbbtree, bool, io.
+:- import_module llds, prog_data, hlds_data, rl_file.
+:- import_module set_bbbtree, bool, io, std_util.
 
         % Given a 'c_file' structure, open the appropriate .c file
         % and output the code into that file. The bool says whether
@@ -26,8 +26,9 @@
         % tracing; the third argument gives the set of labels that have
         % layout structures.
 
-:- pred output_c_file(c_file, set_bbbtree(label), io__state, io__state).
-:- mode output_c_file(in, in, di, uo) is det.
+:- pred output_c_file(c_file, set_bbbtree(label), maybe(rl_file),
+                io__state, io__state).
+:- mode output_c_file(in, in, in, di, uo) is det.
 
         % Convert an lval to a string description of that lval.
 
@@ -112,6 +113,12 @@
 :- pred llds_out__make_init_name(module_name, string).
 :- mode llds_out__make_init_name(in, out) is det.
 
+        % Returns the name of the Aditi-RL code constant
+        % for a given module.
+
+:- pred llds_out__make_rl_data_name(module_name, string).
+:- mode llds_out__make_rl_data_name(in, out) is det.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -120,7 +127,7 @@
 :- import_module exprn_aux, prog_util, prog_out, hlds_pred.
 :- import_module export, mercury_to_mercury, modules.
 
-:- import_module int, list, char, string, std_util, term, varset.
+:- import_module int, list, char, string, term, varset.
 :- import_module set, bintree_set, assoc_list, require.
 :- import_module library.       % for the version number.
 
@@ -138,17 +145,19 @@
                 ;       data_addr(data_addr)
                 ;       pragma_c_struct(string).
 
-output_c_file(C_File, StackLayoutLabels) -->
+output_c_file(C_File, StackLayoutLabels, MaybeRLFile) -->
         globals__io_lookup_bool_option(split_c_files, SplitFiles),
         ( { SplitFiles = yes } ->
                 { C_File = c_file(ModuleName, C_HeaderInfo, C_Modules) },
                 module_name_to_file_name(ModuleName, ".dir", yes, ObjDirName),
                 make_directory(ObjDirName),
-                output_c_file_init(ModuleName, C_Modules),
+                output_c_file_init(ModuleName, C_Modules, MaybeRLFile),
                 output_c_file_list(C_Modules, 1, ModuleName,
-                        C_HeaderInfo, StackLayoutLabels)
+                        C_HeaderInfo, StackLayoutLabels),
+                output_rl_file(ModuleName, MaybeRLFile)
         ;
-                output_single_c_file(C_File, no, StackLayoutLabels)
+                output_single_c_file(C_File, no,
+                        StackLayoutLabels, MaybeRLFile)
         ).
 
 :- pred make_directory(string, io__state, io__state).
@@ -167,15 +176,16 @@
 output_c_file_list([Module|Modules], Num, ModuleName, C_HeaderLines,
                 StackLayoutLabels) -->
         output_single_c_file(c_file(ModuleName, C_HeaderLines, [Module]),
-                yes(Num), StackLayoutLabels),
+                yes(Num), StackLayoutLabels, no),
         { Num1 is Num + 1 },
         output_c_file_list(Modules, Num1, ModuleName, C_HeaderLines,
                 StackLayoutLabels).
 
-:- pred output_c_file_init(module_name, list(c_module), io__state, io__state).
-:- mode output_c_file_init(in, in, di, uo) is det.
+:- pred output_c_file_init(module_name, list(c_module), maybe(rl_file),
+                io__state, io__state).
+:- mode output_c_file_init(in, in, in, di, uo) is det.
 
-output_c_file_init(ModuleName, C_Modules) -->
+output_c_file_init(ModuleName, C_Modules, MaybeRLFile) -->
         module_name_to_file_name(ModuleName, ".m", no, SourceFileName),
         module_name_to_split_c_file_name(ModuleName, 0, ".c", FileName),
 
@@ -191,15 +201,12 @@
                         "** version ", Version, ".\n",
                         "** Do not edit.\n",
                         "*/\n"]),
-                io__write_string("/*\n"),
-                io__write_string("INIT "),
-                output_init_name(ModuleName),
-                io__write_string("\n"),
-                io__write_string("ENDINIT\n"),
-                io__write_string("*/\n\n"),
+
+                output_init_comment(ModuleName),
                 output_c_file_mercury_headers,
                 io__write_string("\n"),
                 output_c_module_init_list(ModuleName, C_Modules),
+                output_rl_file(ModuleName, MaybeRLFile),
                 io__told
         ;
                 io__progname_base("llds.m", ProgName),
@@ -225,11 +232,11 @@
         ).
 
 :- pred output_single_c_file(c_file, maybe(int), set_bbbtree(label),
-        io__state, io__state).
-:- mode output_single_c_file(in, in, in, di, uo) is det.
+        maybe(rl_file), io__state, io__state).
+:- mode output_single_c_file(in, in, in, in, di, uo) is det.
 
 output_single_c_file(c_file(ModuleName, C_HeaderLines, Modules), SplitFiles,
-                StackLayoutLabels) -->
+                StackLayoutLabels, MaybeRLFile) -->
         ( { SplitFiles = yes(Num) } ->
                 module_name_to_split_c_file_name(ModuleName, Num, ".c",
                         FileName)
@@ -252,12 +259,7 @@
                 ( { SplitFiles = yes(_) } ->
                         []
                 ;
-                        io__write_string("/*\n"),
-                        io__write_string("INIT "),
-                        output_init_name(ModuleName),
-                        io__write_string("\n"),
-                        io__write_string("ENDINIT\n"),
-                        io__write_string("*/\n\n")
+                        output_init_comment(ModuleName)
                 ),
                 output_c_file_mercury_headers,
                 output_c_header_include_lines(C_HeaderLines),
@@ -270,7 +272,8 @@
                         []
                 ;
                         io__write_string("\n"),
-                        output_c_module_init_list(ModuleName, Modules)
+                        output_c_module_init_list(ModuleName, Modules),
+                        output_rl_file(ModuleName, MaybeRLFile)
                 ),
                 io__told
         ;
@@ -422,6 +425,28 @@
         ),
         output_c_data_init_list(Ms).
 
+        % Output a comment to tell mkinit what functions to
+        % call from <module>_init.c.
+:- pred output_init_comment(module_name, io__state, io__state).
+:- mode output_init_comment(in, di, uo) is det.
+
+output_init_comment(ModuleName) -->
+        io__write_string("/*\n"),
+        io__write_string("INIT "),
+        output_init_name(ModuleName),
+        io__write_string("\n"),
+        globals__io_lookup_bool_option(aditi, Aditi),
+        ( { Aditi = yes } ->
+                { llds_out__make_rl_data_name(ModuleName, RLName) },
+                io__write_string("ADITI_DATA "),
+                io__write_string(RLName),
+                io__write_string("\n")
+        ;
+                []
+        ),
+        io__write_string("ENDINIT\n"),
+        io__write_string("*/\n\n").
+
 :- pred output_init_name(module_name, io__state, io__state).
 :- mode output_init_name(in, di, uo) is det.
 
@@ -434,6 +459,11 @@
         string__append_list(["mercury__", MangledModuleName, "__init"],
                 InitName).
 
+llds_out__make_rl_data_name(ModuleName, RLDataConstName) :-
+        llds_out__sym_name_mangle(ModuleName, MangledModuleName),
+        string__append("mercury__aditi_rl_data__", MangledModuleName,
+                RLDataConstName).
+
 :- pred output_bunch_name(module_name, int, io__state, io__state).
 :- mode output_bunch_name(in, in, di, uo) is det.
 
@@ -2035,6 +2065,9 @@
 need_code_addr_decls(do_det_class_method, yes) --> [].
 need_code_addr_decls(do_semidet_class_method, yes) --> [].
 need_code_addr_decls(do_nondet_class_method, yes) --> [].
+need_code_addr_decls(do_det_aditi_call, yes) --> [].
+need_code_addr_decls(do_semidet_aditi_call, yes) --> [].
+need_code_addr_decls(do_nondet_aditi_call, yes) --> [].
 need_code_addr_decls(do_not_reached, yes) --> [].
 
 :- pred output_code_addr_decls(code_addr, io__state, io__state).
@@ -2080,6 +2113,12 @@
         io__write_string("Declare_entry(do_call_semidet_class_method);\n").
 output_code_addr_decls(do_nondet_class_method) -->
         io__write_string("Declare_entry(do_call_nondet_class_method);\n").
+output_code_addr_decls(do_det_aditi_call) -->
+        io__write_string("Declare_entry(do_det_aditi_call);\n").
+output_code_addr_decls(do_semidet_aditi_call) -->
+        io__write_string("Declare_entry(do_semidet_aditi_call);\n").
+output_code_addr_decls(do_nondet_aditi_call) -->
+        io__write_string("Declare_entry(do_nondet_aditi_call);\n").
 output_code_addr_decls(do_not_reached) -->
         io__write_string("Declare_entry(do_not_reached);\n").
 
@@ -2255,6 +2294,18 @@
         io__write_string("tailcall(ENTRY(do_call_nondet_class_method),\n\t\t"),
         output_label_as_code_addr(CallerLabel),
         io__write_string(");\n").
+output_goto(do_det_aditi_call, CallerLabel) -->
+        io__write_string("tailcall(ENTRY(do_det_aditi_call),\n\t\t"),
+        output_label_as_code_addr(CallerLabel),
+        io__write_string(");\n").
+output_goto(do_semidet_aditi_call, CallerLabel) -->
+        io__write_string("tailcall(ENTRY(do_semidet_aditi_call),\n\t\t"),
+        output_label_as_code_addr(CallerLabel),
+        io__write_string(");\n").
+output_goto(do_nondet_aditi_call, CallerLabel) -->
+        io__write_string("tailcall(ENTRY(do_nondet_aditi_call),\n\t\t"),
+        output_label_as_code_addr(CallerLabel),
+        io__write_string(");\n").
 output_goto(do_not_reached, CallerLabel) -->
         io__write_string("tailcall(ENTRY(do_not_reached),\n\t\t"),
         output_label_as_code_addr(CallerLabel),
@@ -2332,6 +2383,12 @@
         io__write_string("ENTRY(do_call_semidet_class_method)").
 output_code_addr(do_nondet_class_method) -->
         io__write_string("ENTRY(do_call_nondet_class_method)").
+output_code_addr(do_det_aditi_call) -->
+        io__write_string("ENTRY(do_det_aditi_call)").
+output_code_addr(do_semidet_aditi_call) -->
+        io__write_string("ENTRY(do_semidet_aditi_call)").
+output_code_addr(do_nondet_aditi_call) -->
+        io__write_string("ENTRY(do_nondet_aditi_call)").
 output_code_addr(do_not_reached) -->
         io__write_string("ENTRY(do_not_reached)").
 
@@ -3377,5 +3434,52 @@
                 Labels1 = Labels0
         ),
         gather_labels_from_instrs(Instrs, Labels1, Labels).
+
+%-----------------------------------------------------------------------------%
+
+        % Currently the `.rlo' files are stored as static data in the
+        % executable. It may be better to store them in separate files
+        % in a known location and load them at runtime.
+:- pred output_rl_file(module_name, maybe(rl_file), io__state, io__state).
+:- mode output_rl_file(in, in, di, uo) is det.
+
+output_rl_file(ModuleName, MaybeRLFile) -->
+        globals__io_lookup_bool_option(aditi, Aditi),
+        ( { Aditi = no } ->
+                []
+        ;
+                io__write_string("\n\n/* Aditi-RL code for this module. */\n"),
+                { llds_out__make_rl_data_name(ModuleName, RLDataConstName) },
+                io__write_string("const char "),
+                io__write_string(RLDataConstName),
+                io__write_string("[] = {"),
+                (
+                        { MaybeRLFile = yes(RLFile) },
+                        rl_file__write_binary(output_rl_byte, RLFile, Length),
+                        io__write_string("0};\n")
+                ;
+                        { MaybeRLFile = no },
+                        io__write_string("};\n"),
+                        { Length = 0 }
+                ),
+
+                % Store the length of the data in 
+                % mercury__aditi_rl_data__<module>__length.
+
+                { string__append(RLDataConstName, "__length",
+                        RLDataConstLength) },
+                io__write_string("const int "),
+                io__write_string(RLDataConstLength),
+                io__write_string(" = "),
+                io__write_int(Length),
+                io__write_string(";\n\n")
+        ).
+
+:- pred output_rl_byte(int, io__state, io__state).
+:- mode output_rl_byte(in, di, uo) is det.
+
+output_rl_byte(Byte) -->
+        io__write_int(Byte),
+        io__write_string(", ").
 
 %-----------------------------------------------------------------------------%
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.268
diff -u -t -u -r1.268 make_hlds.m
--- make_hlds.m	1998/06/21 08:24:02	1.268
+++ make_hlds.m	1998/07/07 01:23:19
@@ -206,14 +206,16 @@
 
 add_item_decl_pass_1(pred_mode(VarSet, PredName, Modes, MaybeDet, Cond),
                 Context, Status, Module0, Status, Module) -->
+        { Status = item_status(ImportStatus, _) },
         module_add_mode(Module0, VarSet, PredName, Modes, MaybeDet, Cond,
-                Context, predicate, _, Module).
+                ImportStatus, Context, predicate, _, Module).
 
 add_item_decl_pass_1(func_mode(VarSet, FuncName, Modes, RetMode, MaybeDet,
                 Cond), Context, Status, Module0, Status, Module) -->
         { list__append(Modes, [RetMode], Modes1) },
+        { Status = item_status(ImportStatus, _) },
         module_add_mode(Module0, VarSet, FuncName, Modes1,
-                MaybeDet, Cond, Context, function, _, Module).
+                MaybeDet, Cond, ImportStatus, Context, function, _, Module).
 
 add_item_decl_pass_1(pragma(_), _, Status, Module, Status, Module) --> [].
 
@@ -323,6 +325,14 @@
                 % clauses).
                 { Pragma = c_code(_, _, _, _, _, _) },
                 { Module = Module0 }
+        ;
+                { Pragma = memo(Name, Arity) },
+                add_pred_marker(Module0, "memo", Name, Arity, ImportStatus,
+                        Context, memo, [], Module)
+        ;
+                { Pragma = no_memo(PredName, Arity) },
+                add_pred_marker(Module0, "no_memo", PredName, Arity,
+                        ImportStatus, Context, no_memo, [memo], Module)
         ;       
                 % Handle pragma tabled decls later on (when we process
                 % clauses).
@@ -330,16 +340,16 @@
                 { Module = Module0 }
         ;
                 { Pragma = inline(Name, Arity) },
-                add_pred_marker(Module0, "inline", Name, Arity, Context,
-                        inline, [no_inline], Module)
+                add_pred_marker(Module0, "inline", Name, Arity, ImportStatus,
+                        Context, inline, [no_inline], Module)
         ;
                 { Pragma = no_inline(Name, Arity) },
-                add_pred_marker(Module0, "no_inline", Name, Arity, Context,
-                        no_inline, [inline], Module)
+                add_pred_marker(Module0, "no_inline", Name, Arity,
+                        ImportStatus, Context, no_inline, [inline], Module)
         ;
                 { Pragma = obsolete(Name, Arity) },
-                add_pred_marker(Module0, "obsolete", Name, Arity, Context,
-                        obsolete, [], Module)
+                add_pred_marker(Module0, "obsolete", Name, Arity, ImportStatus,
+                        Context, obsolete, [], Module)
         ;
                 % Handle pragma import decls later on (when we process
                 % clauses and pragma c_code).
@@ -370,9 +380,47 @@
                 { Pragma = fact_table(_, _, _) },
                 { Module = Module0 }
         ;
+                { Pragma = aditi(PredName, Arity) },
+                maybe_enable_aditi_compilation(Status, Context,
+                        Module0, Module1),
+                add_pred_marker(Module1, "aditi", PredName, Arity,
+                        ImportStatus, Context, aditi, [], Module2),
+                add_stratified_pred(Module2, "aditi", PredName, Arity, Context, 
+                        Module)
+        ;
+                { Pragma = base_relation(PredName, Arity) },
+                maybe_enable_aditi_compilation(Status, Context,
+                        Module0, Module1),
+                add_pred_marker(Module1, "aditi", PredName, Arity,
+                        ImportStatus, Context, aditi, [], Module2),
+                add_pred_marker(Module2, "base_relation", PredName, Arity,
+                        ImportStatus, Context, base_relation, [], Module3),
+                module_mark_as_external(PredName, Arity, Context,
+                        Module3, Module)
+        ;
+                { Pragma = naive(PredName, Arity) },
+                add_pred_marker(Module0, "naive", PredName, Arity,
+                        ImportStatus, Context, naive, [psn], Module)
+        ;
+                { Pragma = psn(PredName, Arity) },
+                add_pred_marker(Module0, "psn", PredName, Arity,
+                        ImportStatus, Context, psn, [naive], Module)
+        ;
+                { Pragma = supp_magic(PredName, Arity) },
+                add_pred_marker(Module0, "supp_magic", PredName, Arity, 
+                        ImportStatus, Context, supp_magic, [context], Module)
+        ;
+                { Pragma = context(PredName, Arity) },
+                add_pred_marker(Module0, "context", PredName, Arity, 
+                        ImportStatus, Context, context, [supp_magic], Module)
+        ;
+                { Pragma = owner(PredName, Arity, Owner) },
+                set_pred_owner(Module0, PredName, Arity, Owner, ImportStatus,
+                        Context, Module)
+        ;
                 { Pragma = promise_pure(Name, Arity) },
-                add_pred_marker(Module0, "promise_pure", Name, Arity, Context,
-                                promised_pure, [], Module)
+                add_pred_marker(Module0, "promise_pure", Name, Arity,
+                        ImportStatus, Context, promised_pure, [], Module)
         ;
                 { Pragma = termination_info(PredOrFunc, SymName, ModeList, 
                         MaybeArgSizeInfo, MaybeTerminationInfo) },
@@ -382,17 +430,17 @@
         ;
                 { Pragma = terminates(Name, Arity) },
                 add_pred_marker(Module0, "terminates", Name, Arity,
-                        Context, terminates,
+                        ImportStatus, Context, terminates,
                         [check_termination, does_not_terminate], Module)
         ;
                 { Pragma = does_not_terminate(Name, Arity) },
                 add_pred_marker(Module0, "does_not_terminate", Name, Arity,
-                        Context, does_not_terminate,
+                        ImportStatus, Context, does_not_terminate,
                         [check_termination, terminates], Module)
         ;
                 { Pragma = check_termination(Name, Arity) },
                 add_pred_marker(Module0, "check_termination", Name, Arity, 
-                        Context, check_termination, 
+                        ImportStatus, Context, check_termination, 
                         [terminates, does_not_terminate], 
                         Module)
         ).
@@ -461,6 +509,40 @@
 
 %-----------------------------------------------------------------------------%
 
+        % If there are local Aditi procedures enable Aditi compilation.
+:- pred maybe_enable_aditi_compilation(item_status, term__context,
+                module_info, module_info, io__state, io__state) is det.
+:- mode maybe_enable_aditi_compilation(in, in, in, out, di, uo) is det.
+
+maybe_enable_aditi_compilation(Status, Context, Module0, Module) -->
+        { Status = item_status(ItemStatus, _) },
+        ( { ItemStatus \= imported } ->
+                globals__io_lookup_bool_option(aditi, Aditi),
+                ( { Aditi = no } ->
+                        prog_out__write_context(Context),
+                        io__write_string("Error: compilation of Aditi procedures\n"),
+                        prog_out__write_context(Context),
+                        io__write_string("  requires the --aditi option.\n"),
+                        io__set_exit_status(1),
+                        { module_info_incr_errors(Module0, Module) }
+                ;
+                        % There are local Aditi procedures - enable Aditi
+                        % code generation.
+                        globals__io_set_do_aditi_compilation,
+
+                        % Set the option in the module_info's
+                        % version of the globals. 
+                        { module_info_globals(Module0, Globals0) },
+                        { globals__set_do_aditi_compilation(Globals0,
+                                Globals) },
+                        { module_info_set_globals(Module0, Globals, Module) }
+                )
+        ;
+                { Module = Module0 }
+        ).
+
+%-----------------------------------------------------------------------------%
+
         % dispatch on the different types of items
 
 :- pred add_item_clause(item, import_status, import_status, term__context, 
@@ -532,7 +614,7 @@
                         { TypeLayout = yes }
                 ->
                         module_add_pragma_tabled(Type, Name, Arity, PredOrFunc,
-                                Mode, Context, Module0, Module)
+                                Mode, Status, Context, Module0, Module)
                 ;
                         { module_info_incr_errors(Module0, Module) },
                         prog_out__write_context(Context),
@@ -719,53 +801,129 @@
 
 %-----------------------------------------------------------------------------%
 
-        % add_pred_marker(ModuleInfo0, PragmaName, Name, Arity, Context, 
-        %       Marker, ConflictMarkers, ModuleInfo, IO0, IO)
+:- pred add_stratified_pred(module_info, string, sym_name, arity,
+        term__context, module_info, io__state, io__state).
+:- mode add_stratified_pred(in, in, in, in, in, out, di, uo) is det.
+
+add_stratified_pred(Module0, PragmaName, Name, Arity, Context, Module) -->
+        { module_info_get_predicate_table(Module0, PredTable0) },
+        (
+                { predicate_table_search_sym_arity(PredTable0, Name, 
+                        Arity, PredIds) }
+        ->
+                { module_info_stratified_preds(Module0, StratPredIds0) },
+                { set__insert_list(StratPredIds0, PredIds, StratPredIds) },
+                { module_info_set_stratified_preds(Module0, StratPredIds, 
+                        Module) }
+        ;
+                { string__append_list(
+                        ["`:- pragma ", PragmaName, "' declaration"],
+                        Description) },
+                undefined_pred_or_func_error(Name, Arity, Context,
+                        Description),
+                { module_info_incr_errors(Module0, Module) }
+        ).
+
+%-----------------------------------------------------------------------------%
+
+        % add_pred_marker(ModuleInfo0, PragmaName, Name, Arity, Status,
+        %       Context, Marker, ConflictMarkers, ModuleInfo, IO0, IO)
+        %
         % Adds Marker to the marker list of the pred(s) with give Name and
         % Arity, updating the ModuleInfo. If the named pred does not exist,
         % or the pred already has a marker in ConflictMarkers, report
         % an error.
 :- pred add_pred_marker(module_info, string, sym_name, arity,
-        term__context, marker, list(marker), module_info,
+        import_status, term__context, marker, list(marker), module_info,
         io__state, io__state).
-:- mode add_pred_marker(in, in, in, in, in, in, in, out, di, uo) is det.
+:- mode add_pred_marker(in, in, in, in, in, in, in, in, out, di, uo) is det.
 
-add_pred_marker(Module0, PragmaName, Name, Arity, Context, Marker,
+add_pred_marker(Module0, PragmaName, Name, Arity, Status, Context, Marker,
                 ConflictMarkers, Module) --> 
-        { module_info_get_predicate_table(Module0, PredTable0) },
-        % check that the pragma is module qualified.
-        (
-                { Name = unqualified(_) }
-        ->
-                { error("add_pred_marker: unqualified name") }
-        ; % else if
-                { predicate_table_search_sym_arity(PredTable0, Name, 
-                        Arity, PredIds) }
-        ->
+        ( { marker_must_be_exported(Marker) } ->
+                { MustBeExported = yes }
+        ;
+                { MustBeExported = no }
+        ),      
+        do_add_pred_marker(Module0, PragmaName, Name, Arity, Status,
+                MustBeExported, Context, add_marker_pred_info(Marker),
+                Module1, PredIds),
+        { module_info_preds(Module1, Preds) },
+        { pragma_check_markers(Preds, PredIds, ConflictMarkers, Conflict) },
+        ( { Conflict = yes } ->
+                pragma_conflict_error(Name, Arity, Context,
+                        PragmaName),
+                { module_info_incr_errors(Module1, Module) }
+        ;
+                { Module = Module1 }
+        ).
+
+:- pred set_pred_owner(module_info, sym_name, arity, string, import_status,
+                term__context, module_info, io__state, io__state).
+:- mode set_pred_owner(in, in, in, in, in, in, out, di, uo) is det.
+
+set_pred_owner(Module0, Name, Arity, Owner, Status, Context, Module) -->
+        { SetOwner =
+            lambda([PredInfo0::in, PredInfo::out] is det, (
+                pred_info_set_aditi_owner(PredInfo0, Owner, PredInfo)
+        )) },
+        do_add_pred_marker(Module0, "owner", Name, Arity, Status, yes, Context,
+                SetOwner, Module, _).
+
+:- type add_marker_pred_info == pred(pred_info, pred_info).
+:- inst add_marker_pred_info = (pred(in, out) is det).
+
+:- pred do_add_pred_marker(module_info, string, sym_name, arity,
+        import_status, bool, term__context, add_marker_pred_info,
+        module_info, list(pred_id), io__state, io__state).
+:- mode do_add_pred_marker(in, in, in, in, in, in, in,
+        in(add_marker_pred_info), out, out, di, uo) is det.
+
+do_add_pred_marker(Module0, PragmaName, Name, Arity, Status,
+                MustBeExported, Context, UpdatePredInfo, Module, PredIds) --> 
+        ( { get_matching_pred_ids(Module0, Name, Arity, PredIds0) } ->
+                { PredIds = PredIds0 },
+                { module_info_get_predicate_table(Module0, PredTable0) },
                 { predicate_table_get_preds(PredTable0, Preds0) },
-                { pragma_add_marker(Preds0, PredIds, Marker, Preds) },
-                { predicate_table_set_preds(PredTable0, Preds, 
-                        PredTable) },
-                { module_info_set_predicate_table(Module0, PredTable, 
-                        Module1) },
-                { pragma_check_markers(Preds, PredIds, ConflictMarkers, 
-                        Conflict) },
+
+                { pragma_add_marker(Preds0, PredIds, UpdatePredInfo,
+                        Status, MustBeExported, Preds, WrongStatus) },
                 (
-                        { Conflict = yes }
+                        { WrongStatus = yes }
                 ->
-                        pragma_conflict_error(Name, Arity, Context,
-                                PragmaName),
-                        { module_info_incr_errors(Module1, Module) }
+                        pragma_status_error(Name, Arity, Context, PragmaName),
+                        { module_info_incr_errors(Module0, Module1) }
                 ;
-                        { Module = Module1 }
-                )
+                        { Module1 = Module0 }
+                ),
+                        
+                { predicate_table_set_preds(PredTable0, Preds, 
+                        PredTable) },
+                { module_info_set_predicate_table(Module1, PredTable, 
+                        Module) }
         ;
+                { PredIds = [] },
                 { string__append_list(["`", PragmaName, "' pragma"],
                                       Description) },
                 undefined_pred_or_func_error(Name, Arity, Context,
                         Description),
                 { module_info_incr_errors(Module0, Module) }
         ).
+        
+:- pred get_matching_pred_ids(module_info, sym_name, arity, list(pred_id)).
+:- mode get_matching_pred_ids(in, in, in, out) is semidet.
+                
+get_matching_pred_ids(Module0, Name, Arity, PredIds) :-
+        module_info_get_predicate_table(Module0, PredTable0),
+        % check that the pragma is module qualified.
+        (
+                Name = unqualified(_)
+        ->
+                error("get_matching_pred_ids: unqualified name")
+        ;
+                predicate_table_search_sym_arity(PredTable0, Name, 
+                        Arity, PredIds)
+        ).      
 
 %-----------------------------------------------------------------------------%
 
@@ -1232,7 +1390,7 @@
                 { MaybeModes = yes(Modes) }
         ->
                 module_add_mode(Module1, VarSet, PredName, Modes, MaybeDet,
-                        Cond, Context, predicate, PredProcId, Module),
+                        Cond, Status, Context, predicate, PredProcId, Module),
                 { MaybePredProcId = yes(PredProcId) }
         ;
                 { Module = Module1 },
@@ -1268,7 +1426,8 @@
         ->
                 { list__append(Modes, [RetMode], Modes1) },
                 module_add_mode(Module1, VarSet, FuncName, Modes1,
-                        MaybeDet, Cond, Context, function, PredProcId, Module),
+                        MaybeDet, Cond, Status, Context, function,
+                        PredProcId, Module),
                 { MaybePredProcId = yes(PredProcId) }
         ;
                 { Module = Module1 },
@@ -1392,16 +1551,19 @@
         ;
                 { Method = pred_mode(VarSet, PredName, Modes, MaybeDet, 
                         Cond, Context) },
+                { Status = item_status(ImportStatus, _) },
                 module_add_mode(Module0, VarSet, PredName, Modes, MaybeDet, 
-                        Cond, Context, predicate, PredIdProcId, Module),
+                        Cond, ImportStatus, Context, predicate,
+                        PredIdProcId, Module),
                 { MaybePredIdProcId = yes(PredIdProcId) }
         ;
                 { Method = func_mode(VarSet, FuncName, Modes, RetMode, MaybeDet,
                         Cond, Context) },
                 { list__append(Modes, [RetMode], Modes1) },
+                { Status = item_status(ImportStatus, _) },
                 module_add_mode(Module0, VarSet, FuncName, Modes1,
-                        MaybeDet, Cond, Context, function, PredIdProcId, 
-                        Module),
+                        MaybeDet, Cond, ImportStatus, Context, function,
+                        PredIdProcId, Module),
                 { MaybePredIdProcId = yes(PredIdProcId) }
         ).
 
@@ -1532,10 +1694,11 @@
                                 add_marker(TheMarkers0, M, TheMarkers)
                         )) },
                 { list__foldl(AddMarker, MarkersList, Markers0, Markers) },
+                globals__io_lookup_string_option(aditi_user, Owner),
                 { pred_info_init(ModuleName, PredName, Arity, TVarSet, Types,
                                 Cond, Context, ClausesInfo, Status, Markers,
                                 none, PredOrFunc, ClassContext, Proofs,
-                                PredInfo0) },
+                                Owner, PredInfo0) },
                 (
                         { predicate_table_search_pf_m_n_a(PredicateTable0,
                                 PredOrFunc, MNameOfPred, PName, Arity,
@@ -1718,11 +1881,12 @@
                 % XXX If/when we have "comparable" or "unifiable" typeclasses, 
                 % XXX this context might not be empty
         ClassContext = [],
+        module_info_globals(Module0, Globals),
+        globals__lookup_string_option(Globals, aditi_user, Owner),
         pred_info_init(ModuleName, PredName, Arity, TVarSet, ArgTypes, Cond,
                 Context, ClausesInfo0, Status, Markers, none, predicate, 
-                ClassContext, Proofs, PredInfo0),
+                ClassContext, Proofs, Owner, PredInfo0),
         ArgLives = no,
-        module_info_globals(Module0, Globals),
         globals__get_args_method(Globals, ArgsMethod),
         add_new_proc(PredInfo0, Arity, ArgModes, yes(ArgModes),
                 ArgLives, yes(Det), Context, ArgsMethod, PredInfo, _),
@@ -1778,17 +1942,17 @@
         % Add a mode declaration for a predicate.
 
 :- pred module_add_mode(module_info, varset, sym_name, list(mode),
-                maybe(determinism), condition, term__context, pred_or_func,
-                pair(pred_id, proc_id), module_info, 
+                maybe(determinism), condition, import_status, term__context,
+                pred_or_func, pair(pred_id, proc_id), module_info, 
                 io__state, io__state).
-:- mode module_add_mode(in, in, in, in, in, in, in, in, out, out, 
+:- mode module_add_mode(in, in, in, in, in, in, in, in, in, out, out, 
                 di, uo) is det.
 
         % We should store the mode varset and the mode condition
         % in the hlds - at the moment we just ignore those two arguments.
 
 module_add_mode(ModuleInfo0, _VarSet, PredName, Modes, MaybeDet, _Cond,
-                        MContext, PredOrFunc, PredProcId, ModuleInfo) -->
+                Status, MContext, PredOrFunc, PredProcId, ModuleInfo) -->
 
                 % Lookup the pred or func declaration in the predicate table.
                 % If it's not there (or if it is ambiguous), optionally print a
@@ -1810,9 +1974,9 @@
         ;
                 maybe_undefined_pred_error(PredName, Arity, PredOrFunc,
                         MContext, "mode declaration"),
-                { preds_add_implicit(PredicateTable0,
-                                ModuleName, PredName, Arity, MContext,
-                                PredOrFunc,
+                { preds_add_implicit(ModuleInfo0, PredicateTable0,
+                                ModuleName, PredName, Arity, Status,
+                                MContext, PredOrFunc,
                                 PredId, PredicateTable1) }
         ),
 
@@ -1859,14 +2023,13 @@
         % for that predicate; the real types will be inferred by
         % type inference.
 
-:- pred preds_add_implicit(predicate_table, module_name, sym_name, arity,
-                                term__context, pred_or_func,
-                                pred_id, predicate_table).
-:- mode preds_add_implicit(in, in, in, in, in, in, out, out) is det.
-
-preds_add_implicit(PredicateTable0,
-                        ModuleName, PredName, Arity, Context, PredOrFunc,
-                        PredId, PredicateTable) :-
+:- pred preds_add_implicit(module_info, predicate_table, module_name,
+                sym_name, arity, import_status, term__context,
+                pred_or_func, pred_id, predicate_table).
+:- mode preds_add_implicit(in, in, in, in, in, in, in, in, out, out) is det.
+
+preds_add_implicit(ModuleInfo, PredicateTable0, ModuleName, PredName, Arity,
+                Status, Context, PredOrFunc, PredId, PredicateTable) :-
         varset__init(TVarSet0),
         make_n_fresh_vars("T", Arity, TVarSet0, TypeVars, TVarSet),
         term__var_list_to_term_list(TypeVars, Types),
@@ -1877,9 +2040,11 @@
                 % definition. Inference will fill it in.
         ClassContext = [],
         init_markers(Markers0),
+        module_info_globals(ModuleInfo, Globals),
+        globals__lookup_string_option(Globals, aditi_user, Owner),
         pred_info_init(ModuleName, PredName, Arity, TVarSet, Types, Cond,
-                Context, ClausesInfo, local, Markers0, none, PredOrFunc, 
-                ClassContext, Proofs, PredInfo0),
+                Context, ClausesInfo, Status, Markers0, none, PredOrFunc, 
+                ClassContext, Proofs, Owner, PredInfo0),
         add_marker(Markers0, infer_type, Markers),
         pred_info_set_markers(PredInfo0, Markers, PredInfo),
         (
@@ -1971,8 +2136,8 @@
 
                 maybe_undefined_pred_error(PredName, Arity, PredOrFunc,
                         Context, "clause"),
-                { preds_add_implicit(PredicateTable0,
-                                ModuleName, PredName, Arity, Context,
+                { preds_add_implicit(ModuleInfo0, PredicateTable0,
+                                ModuleName, PredName, Arity, Status, Context,
                                 PredOrFunc,
                                 PredId, PredicateTable1) }
         ),
@@ -2127,8 +2292,8 @@
         ;
                 maybe_undefined_pred_error(PredName, Arity, PredOrFunc,
                         Context, "`:- pragma import' declaration"),
-                { preds_add_implicit(PredicateTable0,
-                                ModuleName, PredName, Arity, Context,
+                { preds_add_implicit(ModuleInfo0, PredicateTable0,
+                                ModuleName, PredName, Arity, Status, Context,
                                 PredOrFunc, PredId, PredicateTable1) }
         ),
                 %
@@ -2431,8 +2596,8 @@
         ;
                 maybe_undefined_pred_error(PredName, Arity, PredOrFunc,
                         Context, "`:- pragma c_code' declaration"),
-                { preds_add_implicit(PredicateTable0,
-                        ModuleName, PredName, Arity, Context,
+                { preds_add_implicit(ModuleInfo0, PredicateTable0,
+                        ModuleName, PredName, Arity, Status, Context,
                         PredOrFunc, PredId, PredicateTable1) }
         ),
                 % Lookup the pred_info for this pred,
@@ -2518,13 +2683,13 @@
 
 :- pred module_add_pragma_tabled(eval_method, sym_name, int, 
                 maybe(pred_or_func), maybe(list(mode)), 
-                term__context, module_info, module_info, 
+                import_status, term__context, module_info, module_info, 
                 io__state, io__state).
-:- mode module_add_pragma_tabled(in, in, in, in, in, in, in, out, 
+:- mode module_add_pragma_tabled(in, in, in, in, in, in, in, in, out, 
         di, uo) is det. 
         
 module_add_pragma_tabled(EvalMethod, PredName, Arity, MaybePredOrFunc, 
-                MaybeModes,  Context, ModuleInfo0, ModuleInfo) --> 
+                MaybeModes, Status, Context, ModuleInfo0, ModuleInfo) --> 
         { module_info_get_predicate_table(ModuleInfo0, PredicateTable0) }, 
         { eval_method_to_string(EvalMethod, EvalMethodS) },
                 
@@ -2549,8 +2714,8 @@
                                 Message1) },
                         maybe_undefined_pred_error(PredName, Arity, 
                                 PredOrFunc, Context, Message1),
-                        { preds_add_implicit(PredicateTable0,
-                                ModuleName, PredName, Arity, Context,
+                        { preds_add_implicit(ModuleInfo0, PredicateTable0,
+                                ModuleName, PredName, Arity, Status, Context,
                                 PredOrFunc, PredId, PredicateTable1) },
                         { module_info_set_predicate_table(ModuleInfo0,
                                 PredicateTable1, ModuleInfo1) },
@@ -2569,8 +2734,8 @@
                                 Message1) },
                         maybe_undefined_pred_error(PredName, Arity, 
                                 predicate, Context, Message1),
-                        { preds_add_implicit(PredicateTable0,
-                                ModuleName, PredName, Arity, Context,
+                        { preds_add_implicit(ModuleInfo0, PredicateTable0,
+                                ModuleName, PredName, Arity, Status, Context,
                                 predicate, PredId, PredicateTable1) },
                         { module_info_set_predicate_table(ModuleInfo0,
                                 PredicateTable1, ModuleInfo1) },
@@ -2766,17 +2931,45 @@
         % For each pred_id in the list, add the given markers to the
         % list of markers in the corresponding pred_info.
 
-:- pred pragma_add_marker(pred_table, list(pred_id), marker, pred_table).
-:- mode pragma_add_marker(in, in, in, out) is det.
-
-pragma_add_marker(PredTable, [], _, PredTable).
-pragma_add_marker(PredTable0, [PredId | PredIds], Marker, PredTable) :-
+:- pred pragma_add_marker(pred_table, list(pred_id), add_marker_pred_info,
+                import_status, bool, pred_table, bool).
+:- mode pragma_add_marker(in, in, in(add_marker_pred_info),
+                in, in, out, out) is det.
+
+pragma_add_marker(PredTable, [], _, _, _, PredTable, no). 
+pragma_add_marker(PredTable0, [PredId | PredIds], UpdatePredInfo, Status,
+                MustBeExported, PredTable, WrongStatus) :-
         map__lookup(PredTable0, PredId, PredInfo0),
+        call(UpdatePredInfo, PredInfo0, PredInfo),
+        (
+                pred_info_is_exported(PredInfo),
+                MustBeExported = yes,
+                Status \= exported
+        ->
+                WrongStatus0 = yes
+        ;
+                WrongStatus0 = no
+        ),
+        map__det_update(PredTable0, PredId, PredInfo, PredTable1),
+        pragma_add_marker(PredTable1, PredIds, UpdatePredInfo, Status,
+                MustBeExported, PredTable, WrongStatus1),
+        bool__or(WrongStatus0, WrongStatus1, WrongStatus).
+
+:- pred add_marker_pred_info(marker, pred_info, pred_info).
+:- mode add_marker_pred_info(in, in, out) is det.
+
+add_marker_pred_info(Marker, PredInfo0, PredInfo) :-
         pred_info_get_markers(PredInfo0, Markers0),
         add_marker(Markers0, Marker, Markers),
-        pred_info_set_markers(PredInfo0, Markers, PredInfo),
-        map__det_update(PredTable0, PredId, PredInfo, PredTable1),
-        pragma_add_marker(PredTable1, PredIds, Marker, PredTable).
+        pred_info_set_markers(PredInfo0, Markers, PredInfo).
+
+        % Succeed if a marker for an exported procedure must also
+        % be exported.
+:- pred marker_must_be_exported(marker).
+:- mode marker_must_be_exported(in) is semidet.
+
+marker_must_be_exported(aditi).
+marker_must_be_exported(base_relation).
 
 %---------------------------------------------------------------------------%
 
@@ -4561,6 +4754,21 @@
         io__write_string("'.\n"),
         prog_out__write_context(Context),
         io__write_string("  should have been qualified by prog_io.m.\n").
+
+:- pred pragma_status_error(sym_name, int, term__context, string,
+                                io__state, io__state).
+:- mode pragma_status_error(in, in, in, in, di, uo) is det.
+
+pragma_status_error(Name, Arity, Context, PragmaName) -->
+        io__set_exit_status(1),
+        prog_out__write_context(Context),
+        io__write_string("Error: `:- pragma "),
+        io__write_string(PragmaName),
+        io__write_string("' declaration for exported\n"),
+        prog_out__write_context(Context),
+        io__write_string("predicate or function "),
+        hlds_out__write_pred_call_id(Name/Arity),
+        io__write_string(" must also be exported.\n").
 
 :- pred pragma_conflict_error(sym_name, int, term__context, string,
                                 io__state, io__state).



More information about the developers mailing list