for review: Aditi [1]
Simon Taylor
stayl at cs.mu.OZ.AU
Tue Jul 7 13:42:40 AEST 1998
Hi,
Tom, since you were working Aditi compilation before me, could you please
review these changes.
The first parts are the diff from the other parts of the compiler
and the magic sets transformation. The whole thing is in
/home/mercury1/stayl/mercury.
Thanks,
Simon.
Estimated hours taken: 1000
Aditi compilation.
compiler/options.m:
--aditi: enable Aditi compilation.
--dump-rl: write the intermediate RL to `<module>.rl_dump'.
--dump-rl-bytecode: write a text version of the bytecodes
to `<module>.rla'
--aditi-only: don't produce a `.c' file.
--filenames-from-stdin: accept a list of filenames to compile
from stdin. This is used by the query shell.
--rl-optimize, --rl-optimize-liveness,
--rl-optimize-cse, --rl-optimize-invariants,
--detect-rl-streams:
Options to control RL optimization passes which are not
implemented or are not ready to commit yet.
--aditi-user:
Default owner of any Aditi procedures, defaults to $USER.
--generate-schemas:
write schemas for base relations to `<module>'.base_schema
and schemas for derived relations to `<module>'.derived_schema.
This is used by the query shell.
compiler/handle_options.m:
Set --aditi-user to $USER if it is not already set.
compiler/globals.m:
Add a field to record whether there are any local Aditi procedures
in the current module.
compiler/hlds_pred.m:
compiler/prog_data.m:
compiler/prog_io_pragma.m:
compiler/make_hlds.m:
Add some Aditi pragma declarations - `aditi', `supp_magic', `naive',
`psn' (predicate semi-naive), `base_relation' and `owner'.
compiler/hlds_pred.m:
Add predicates to identify Aditi procedures.
Added markers `generate_inline' and `aditi_interface', which
are used internally for Aditi code generation.
Add an `owner' field to pred_infos, which is used for database
security checks.
compiler/make_hlds.m:
Some pragmas must be exported if the corresponding predicates
are exported, check this.
Make sure stratification of Aditi procedures is checked.
Set the `do_aditi_compilation' field of the globals if there
are any local Aditi procedures or base relations.
Check that --aditi is set if Aditi compilation is required.
compiler/post_typecheck.m:
Check that every Aditi predicate has an `aditi:state' argument,
which is used to ensure sequencing of updates and that Aditi
procedures are only called within transactions.
compiler/dnf.m:
Changed the definition of disjunctive normal form slightly
so that a call followed by some atomic goals not including
any database calls is considered atomic. magic.m can handle
this kind of goal, and it results in more efficient RL code.
compiler/hlds_module.m:
compiler/dependency_graph.m:
Added dependency_graph__get_scc_entry_points which finds
the procedures in an SCC which could be called from outside.
Added a new field to the dependency_info, the
aditi_dependency_ordering. This contains all Aditi SCCs of
the original program, with multiple SCCs merged where
possible to improve the effectiveness of differential evaluation
and the low level RL optimizations.
compiler/hlds_module.m:
Added versions of module_info_pred_proc_info and
module_info_set_pred_proc_info which take a pred_proc_id,
not a separate pred_id and proc_id.
compiler/polymorphism.m:
compiler/lambda.m:
Make sure that predicates created for closures in Aditi procedures
have the correct markers.
compiler/goal_util.m:
Added goal_util__switch_to_disjunction,
goal_util__case_to_disjunct (factored out from simplify.m)
and goal_util__if_then_else_to_disjunction. These are
require because supplementary magic sets can't handle
if-then-elses or switches.
compiler/type_util.m:
Added type_is_aditi_state/1.
compiler/mode_util.m:
Added partition_args/5 which partitions a list of arguments
into inputs and outputs.
compiler/inlining.m:
Don't inline memoed procedures.
Don't inline Aditi procedures into non-Aditi procedures.
compiler/simplify.m:
Export a slightly different interface for use by magic.m.
Remove explicit quantifications where possible.
Merge multiple nested quantifications.
Don't report infinite recursion warnings for Aditi procedures.
compiler/prog_out.m:
Generalised the code to output a module list to write any list.
compiler/code_gen.m:
compiler/arg_info.m:
Don't process Aditi procedures.
compiler/mercury_compile.m:
Call magic.m and rl_gen.m.
Don't perform some low-level annotation passes on Aditi procedures.
compiler/passes_aux.m:
Add predicates to process only non-Aditi procedures.
compiler/llds.m:
compiler/llds_out.m:
Added new `code_addr' enum members, do_{det,semidet,nondet}_aditi_call,
which are defined in extras/aditi/aditi.m.
compiler/call_gen.m:
Handle generation of do_*_aditi_call.
compiler/llds_out.m:
Write the RL code for the module as a constant char array
in the `.c' file.
compiler/term_errors.m:
compiler/error_util.m:
Move code to describe predicates into error_util.m
Allow the caller to explicitly add line breaks.
Added error_util:list_to_pieces to format a list of
strings.
Reordered some arguments for currying.
compiler/hlds_out.m:
Don't try to print clauses if there are none.
NEWS:
library/eqvclass.m:
Added eqvclass__same_eqvclass_list which tests whether a list
of elements are in the same equivalence class.
library/io.nu.nl:
library/sp_lib.nl:
Add Prolog implementations of io__getenv, io__make_temp
and io__make_err_msg.
library/map.m:
Print out the key on a map__lookup failure if it is simple.
runtime/mercury_init.h:
util/mkinit.c:
scripts/c2init.in:
Added a function `mercury__load_aditi_rl_code()' which
throws all the RL code for the program at the database.
This should be called at connection time by `aditi__connect'.
Added an option `--aditi' which controls the output
`mercury__load_aditi_rl_code()'.
New files:
compiler/magic.m:
compiler/magic_util.m:
Supplementary magic sets transformation. Report errors
for constructs that Aditi can't handle.
compiler/context.m:
Supplementary context transformation.
compiler/rl_gen.m:
Aditi code generation.
compiler/rl_exprn.m:
Generate join conditions.
compiler/rl_info.m:
Code generator state.
compiler/rl.m:
Intermediate RL representation.
compiler/rl_dump.m:
Print out the representation in rl.m.
compiler/rl_opt.m:
compiler/rl_block.m:
compiler/rl_analyse.m:
compiler/rl_liveness.m:
Make sure all relations are initialised before used, clear
references to relations that are no longer required.
compiler/rl_code.m:
RL bytecode definitions. Automatically generated from the Aditi
header files.
compiler/rl_out.m:
compiler/rl_file.m:
Output the RL bytecodes in binary to <module>.rlo (for use by Aditi)
and in text to <module>.rla (for use by the RL interpreter).
Also output the schema information if --generate-schemas is set.
extras/aditi/aditi.m:
Definitions of some Aditi library predicates and the
interfacing and transaction processing code.
Index: NEWS
===================================================================
RCS file: /home/staff/zs/imp/mercury/NEWS,v
retrieving revision 1.107
diff -u -t -u -r1.107 NEWS
--- NEWS 1998/07/03 10:34:50 1.107
+++ NEWS 1998/07/07 00:26:39
@@ -306,8 +306,8 @@
bag__least_upper_bound/3, bag__remove_list/3, bag__det_remove_list/3,
det_univ_to_type/2, list__take_upto/3, set__count/2, set_ordlist__count/2,
store__new_cyclic_mutvar/4, relation__add_values/4,
- relation__from_assoc_list/2, relation__compose/3,
- and varset__select/3.
+ relation__from_assoc_list/2, relation__compose/3, varset__select/3
+ and eqvclass__same_eqvclass_list/2.
Also the old relation__to_assoc_list/2 predicate has been renamed as
relation__to_key_assoc_list/2; there is a new relation__to_assoc_list/2
Index: compiler/arg_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/arg_info.m,v
retrieving revision 1.28
diff -u -t -u -r1.28 arg_info.m
--- arg_info.m 1998/04/08 11:31:07 1.28
+++ arg_info.m 1998/07/01 03:40:15
@@ -88,18 +88,21 @@
ModuleInfo0, ModuleInfo) :-
module_info_preds(ModuleInfo0, PredTable0),
map__lookup(PredTable0, PredId, PredInfo0),
- pred_info_procedures(PredInfo0, ProcTable0),
- pred_info_arg_types(PredInfo0, _TVarSet, ArgTypes),
- map__lookup(ProcTable0, ProcId, ProcInfo0),
+ ( hlds_pred__pred_info_is_aditi_relation(PredInfo0) ->
+ ModuleInfo1 = ModuleInfo0
+ ;
+ pred_info_procedures(PredInfo0, ProcTable0),
+ pred_info_arg_types(PredInfo0, _TVarSet, ArgTypes),
+ map__lookup(ProcTable0, ProcId, ProcInfo0),
- generate_proc_arg_info(ProcInfo0, ArgTypes, ModuleInfo0,
- ProcInfo),
-
- map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
- pred_info_set_procedures(PredInfo0, ProcTable, PredInfo),
- map__det_update(PredTable0, PredId, PredInfo, PredTable),
- module_info_set_preds(ModuleInfo0, PredTable, ModuleInfo1),
+ generate_proc_arg_info(ProcInfo0, ArgTypes,
+ ModuleInfo0, ProcInfo),
+ map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
+ pred_info_set_procedures(PredInfo0, ProcTable, PredInfo),
+ map__det_update(PredTable0, PredId, PredInfo, PredTable),
+ module_info_set_preds(ModuleInfo0, PredTable, ModuleInfo1)
+ ),
generate_proc_list_arg_info(PredId, ProcIds, ModuleInfo1, ModuleInfo).
:- pred generate_proc_arg_info(proc_info, list(type), module_info, proc_info).
Index: compiler/call_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/call_gen.m,v
retrieving revision 1.122
diff -u -t -u -r1.122 call_gen.m
--- call_gen.m 1998/05/16 07:29:43 1.122
+++ call_gen.m 1998/07/01 03:40:58
@@ -129,7 +129,27 @@
% make the call
code_info__get_module_info(ModuleInfo),
- code_info__make_entry_label(ModuleInfo, PredId, ModeId, yes, Address),
+
+ { module_info_pred_info(ModuleInfo, PredId, PredInfo) },
+ { pred_info_get_markers(PredInfo, Markers) },
+ ( { check_marker(Markers, aditi_interface) } ->
+ % For a call to an Aditi procedure, just pass all the
+ % arguments to do_*_aditi_call, which is defined in
+ % extras/aditi/aditi.m.
+ {
+ CodeModel = model_det,
+ Address = do_det_aditi_call
+ ;
+ CodeModel = model_semi,
+ Address = do_semidet_aditi_call
+ ;
+ CodeModel = model_non,
+ Address = do_nondet_aditi_call
+ }
+ ;
+ code_info__make_entry_label(ModuleInfo,
+ PredId, ModeId, yes, Address)
+ ),
code_info__get_next_label(ReturnLabel),
{ call_gen__call_comment(CodeModel, CallComment) },
{ CallCode = node([
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/check_typeclass.m,v
retrieving revision 1.11
diff -u -t -u -r1.11 check_typeclass.m
--- check_typeclass.m 1998/06/23 05:41:47 1.11
+++ check_typeclass.m 1998/06/29 00:45:59
@@ -59,7 +59,7 @@
:- import_module map, list, std_util, hlds_pred, hlds_data, prog_data, require.
:- import_module type_util, assoc_list, mode_util, inst_match, hlds_module.
-:- import_module term, varset, typecheck, int, globals, make_hlds.
+:- import_module term, varset, typecheck, int, globals, options, make_hlds.
:- import_module base_typeclass_info, string, hlds_goal, set, prog_out.
check_typeclass__check_instance_decls(ModuleInfo0, ModuleInfo, FoundError,
@@ -414,6 +414,8 @@
Cond = true,
map__init(Proofs),
init_markers(Markers),
+ module_info_globals(ModuleInfo0, Globals),
+ globals__lookup_string_option(Globals, aditi_user, User),
% We have to add the actual clause after we have added the
% procs because we need a list of proc numbers for which the
@@ -428,10 +430,9 @@
pred_info_init(ModuleName, PredName, PredArity, ArgTypeVars,
ArgTypes, Cond, Context, DummyClausesInfo, Status,
- Markers, none, PredOrFunc, ClassContext, Proofs,
+ Markers, none, PredOrFunc, ClassContext, Proofs, User,
PredInfo0),
- module_info_globals(ModuleInfo0, Globals),
globals__get_args_method(Globals, ArgsMethod),
% Add procs with the expected modes and determinisms
Index: compiler/code_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_gen.m,v
retrieving revision 1.52
diff -u -t -u -r1.52 code_gen.m
--- code_gen.m 1998/06/18 06:05:48 1.52
+++ code_gen.m 1998/06/29 04:40:24
@@ -93,7 +93,11 @@
% extract a list of all the procedure ids for this
% predicate and generate code for them
{ pred_info_non_imported_procids(PredInfo, ProcIds) },
- ( { ProcIds = [] } ->
+ (
+ { ProcIds = []
+ ; hlds_pred__pred_info_is_aditi_relation(PredInfo)
+ }
+ ->
{ Predicates0 = [] },
{ ModuleInfo1 = ModuleInfo0 }
;
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dependency_graph.m,v
retrieving revision 1.35
diff -u -t -u -r1.35 dependency_graph.m
--- dependency_graph.m 1998/06/09 02:12:22 1.35
+++ dependency_graph.m 1998/06/29 05:21:43
@@ -5,10 +5,10 @@
%-----------------------------------------------------------------------------%
:- module dependency_graph.
-% Main author: bromage, conway.
+% Main author: bromage, conway, stayl.
% The dependency_graph records which procedures depend on which other
-% procedures. It is defined as a relation (see hlds.m) R where xRy
+% procedures. It is defined as a relation (see hlds_module.m) R where xRy
% means that the definition of x depends on the definition of y.
%
% The other important structure is the dependency_ordering which is
@@ -18,7 +18,8 @@
%-----------------------------------------------------------------------------%
:- interface.
-:- import_module hlds_module, io.
+:- import_module hlds_module, hlds_pred.
+:- import_module list, io.
:- pred module_info_ensure_dependency_info(module_info, module_info).
:- mode module_info_ensure_dependency_info(in, out) is det.
@@ -33,16 +34,33 @@
io__state, io__state).
:- mode dependency_graph__write_prof_dependency_graph(in, out, di, uo) is det.
+ % Given the list of predicates in a strongly connected component
+ % of the dependency graph, a list of the higher SCCs in the module
+ % and a module_info, find out which members of the SCC can be
+ % called from outside the SCC.
+:- pred dependency_graph__get_scc_entry_points(list(pred_proc_id),
+ dependency_ordering, module_info, list(pred_proc_id)).
+:- mode dependency_graph__get_scc_entry_points(in, in, in, out) is det.
+
+ % Create the Aditi dependency ordering. This contains all the Aditi
+ % SCCs in the original program. The difference is that SCCs which
+ % are only called from one other SCC and are not called through
+ % negation or aggregation are merged into the parent SCC. This makes
+ % the low-level RL optimizations more effective while maintaining
+ % stratification.
+:- pred module_info_ensure_aditi_dependency_info(module_info, module_info).
+:- mode module_info_ensure_aditi_dependency_info(in, out) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module hlds_pred, hlds_goal, hlds_data, prog_data.
-:- import_module mode_util, globals, options, code_util.
+:- import_module hlds_goal, hlds_data, prog_data.
+:- import_module mode_util, globals, options, code_util, goal_util.
:- import_module llds, llds_out, mercury_to_mercury.
:- import_module int, bool, term, require, string.
-:- import_module list, map, set, std_util.
-:- import_module varset, relation.
+:- import_module map, multi_map, set, std_util.
+:- import_module varset, relation, eqvclass.
%-----------------------------------------------------------------------------%
@@ -517,6 +535,458 @@
;
{ error("dependency_graph__output_label: label not of type local or imported or exported\n") }
).
+
+%-----------------------------------------------------------------------------%
+
+dependency_graph__get_scc_entry_points(SCC, HigherSCCs,
+ ModuleInfo, EntryPoints) :-
+ list__filter(dependency_graph__is_entry_point(HigherSCCs, ModuleInfo),
+ SCC, EntryPoints).
+
+:- pred dependency_graph__is_entry_point(list(list(pred_proc_id))::in,
+ module_info::in, pred_proc_id::in) is semidet.
+
+dependency_graph__is_entry_point(HigherSCCs, ModuleInfo, PredProcId) :-
+ (
+ % Is the predicate exported?
+ PredProcId = proc(PredId, _ProcId),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_is_exported(PredInfo)
+ ;
+ % Is the predicate called from a higher SCC?
+ module_info_dependency_info(ModuleInfo, DepInfo),
+ hlds_dependency_info_get_dependency_graph(DepInfo,
+ DepGraph),
+
+ relation__lookup_element(DepGraph, PredProcId, PredProcIdKey),
+ relation__lookup_to(DepGraph, PredProcIdKey, CallingKeys),
+ set__member(CallingKey, CallingKeys),
+ relation__lookup_key(DepGraph, CallingKey,
+ CallingPred),
+ list__member(HigherSCC, HigherSCCs),
+ list__member(CallingPred, HigherSCC)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+module_info_ensure_aditi_dependency_info(ModuleInfo0, ModuleInfo) :-
+ module_info_ensure_dependency_info(ModuleInfo0, ModuleInfo1),
+ module_info_dependency_info(ModuleInfo1, DepInfo0),
+ hlds_dependency_info_get_maybe_aditi_dependency_ordering(DepInfo0,
+ MaybeAditiInfo),
+ ( MaybeAditiInfo = yes(_) ->
+ ModuleInfo = ModuleInfo1
+ ;
+ hlds_dependency_info_get_dependency_ordering(DepInfo0,
+ DepOrdering),
+ aditi_scc_info_init(ModuleInfo1, AditiInfo0),
+ dependency_graph__build_aditi_scc_info(DepOrdering,
+ AditiInfo0, AditiInfo),
+ dependency_graph__merge_aditi_sccs(AditiInfo, AditiOrdering),
+ hlds_dependency_info_set_aditi_dependency_ordering(DepInfo0,
+ AditiOrdering, DepInfo),
+ module_info_set_dependency_info(ModuleInfo1,
+ DepInfo, ModuleInfo)
+ ).
+
+:- pred dependency_graph__build_aditi_scc_info(dependency_ordering::in,
+ aditi_scc_info::in, aditi_scc_info::out) is det.
+
+dependency_graph__build_aditi_scc_info([]) --> [].
+dependency_graph__build_aditi_scc_info([SCC | SCCs]) -->
+ aditi_scc_info_get_module_info(ModuleInfo),
+ (
+ { list__member(PredProcId, SCC) },
+ { PredProcId = proc(PredId, _) },
+ { module_info_pred_info(ModuleInfo, PredId, PredInfo) },
+ { pred_info_get_markers(PredInfo, Markers) },
+ { check_marker(Markers, aditi) }
+ ->
+ aditi_scc_info_add_scc(SCC, SCCs, SCCid),
+ list__foldl(dependency_graph__process_aditi_pred_proc_id(SCCid),
+ SCC)
+ ;
+ []
+ ),
+ dependency_graph__build_aditi_scc_info(SCCs).
+
+:- pred dependency_graph__process_aditi_pred_proc_id(scc_id::in,
+ pred_proc_id::in, aditi_scc_info::in, aditi_scc_info::out) is det.
+
+dependency_graph__process_aditi_pred_proc_id(SCCid, PredProcId) -->
+ aditi_scc_info_get_module_info(ModuleInfo),
+ { module_info_pred_proc_info(ModuleInfo, PredProcId,
+ PredInfo, ProcInfo) },
+ dependency_graph__process_aditi_proc_info(SCCid, PredInfo, ProcInfo).
+
+:- pred dependency_graph__process_aditi_proc_info(scc_id::in, pred_info::in,
+ proc_info::in, aditi_scc_info::in, aditi_scc_info::out) is det.
+
+dependency_graph__process_aditi_proc_info(CurrSCC, PredInfo, ProcInfo) -->
+ ( { pred_info_is_exported(PredInfo) } ->
+ aditi_scc_info_add_no_merge_scc(CurrSCC)
+ ;
+ []
+ ),
+ { proc_info_goal(ProcInfo, Goal) },
+ process_aditi_goal(Goal).
+
+%-----------------------------------------------------------------------------%
+
+ % Go over the goal finding predicates called through negation
+ % or aggregation. The SCCs containing those predicates cannot
+ % be merged into the current SCC.
+:- pred process_aditi_goal(hlds_goal::in, aditi_scc_info::in,
+ aditi_scc_info::out) is det.
+
+process_aditi_goal(Goal) -->
+ { multi_map__init(MMap0) },
+ process_aditi_goal(no, Goal, MMap0, _).
+
+:- pred process_aditi_goal(bool::in, hlds_goal::in,
+ multi_map(var, pred_proc_id)::in,
+ multi_map(var, pred_proc_id)::out,
+ aditi_scc_info::in, aditi_scc_info::out) is det.
+
+process_aditi_goal(IsNeg, conj(Goals) - _, Map0, Map) -->
+ list__foldl2(process_aditi_goal(IsNeg), Goals, Map0, Map).
+process_aditi_goal(_IsNeg, par_conj(_, _) - _, _, _) -->
+ { error("process_aditi_goal - par_conj") }.
+process_aditi_goal(IsNeg, disj(Goals, _) - _, Map0, Map) -->
+ list__foldl2(process_aditi_goal(IsNeg), Goals, Map0, Map).
+process_aditi_goal(IsNeg, switch(_, _, Cases, _) - _, Map0, Map) -->
+ { NegCallsInCases =
+ lambda([Case::in, M0::in, M::out, AInfo0::in, AInfo::out] is det, (
+ Case = case(_ConsId, Goal),
+ process_aditi_goal(IsNeg, Goal, M0, M, AInfo0, AInfo)
+ )) },
+ list__foldl2(NegCallsInCases, Cases, Map0, Map).
+process_aditi_goal(IsNeg, if_then_else(_, Cond, Then, Else, _) - _,
+ Map0, Map) -->
+ process_aditi_goal(yes, Cond, Map0, Map1),
+ process_aditi_goal(IsNeg, Then, Map1, Map2),
+ process_aditi_goal(IsNeg, Else, Map2, Map).
+process_aditi_goal(IsNeg, some(_, Goal) - _, Map0, Map) -->
+ process_aditi_goal(IsNeg, Goal, Map0, Map).
+process_aditi_goal(_IsNeg, not(Goal) - _, Map0, Map) -->
+ process_aditi_goal(yes, Goal, Map0, Map).
+process_aditi_goal(IsNeg, call(PredId, ProcId, Args, _, _, _) - _,
+ Map0, Map) -->
+ aditi_scc_info_handle_call(IsNeg, PredId, ProcId, Args, Map0, Map).
+
+process_aditi_goal(_IsNeg, unify(Var, _, _, Unify, _) - _,
+ Map0, Map) -->
+ ( { Unify = construct(_, pred_const(PredId, ProcId), _, _) } ->
+ aditi_scc_info_add_closure(Var,
+ proc(PredId, ProcId), Map0, Map)
+ ;
+ { Map = Map0 }
+ ).
+process_aditi_goal(_IsNeg, higher_order_call(_, _, _, _, _, _) - _,
+ Map, Map) --> [].
+process_aditi_goal(_IsNeg, class_method_call(_, _, _, _, _, _) - _,
+ Map, Map) --> [].
+process_aditi_goal(_IsNeg, pragma_c_code(_, _, _, _, _, _, _) - _,
+ Map, Map) --> [].
+
+%-----------------------------------------------------------------------------%
+
+:- pred dependency_graph__merge_aditi_sccs(aditi_scc_info::in,
+ aditi_dependency_ordering::out) is det.
+
+dependency_graph__merge_aditi_sccs(Info, Ordering) :-
+ Info = aditi_scc_info(_, _PredSCC, SCCPred, _, SCCRel, NoMerge, _),
+ ( relation__tsort(SCCRel, SCCTsort) ->
+ eqvclass__init(EqvSCCs0),
+ set__init(MergedSCCs),
+ % Make all the SCCs known to the equivalence class.
+ AddElement = lambda([Elem::in, Eqv0::in, Eqv::out] is det, (
+ eqvclass__new_element(Eqv0, Elem, Eqv)
+ )),
+ list__foldl(AddElement, SCCTsort, EqvSCCs0, EqvSCCs),
+ dependency_graph__merge_aditi_sccs_2(SCCTsort, EqvSCCs,
+ MergedSCCs, NoMerge, SCCRel, SCCPred, [], Ordering)
+ ;
+ error("dependency_graph__merge_aditi_sccs: SCC dependency relation is cyclic")
+ ).
+
+:- pred dependency_graph__merge_aditi_sccs_2(list(scc_id)::in,
+ eqvclass(scc_id)::in, set(scc_id)::in, set(scc_id)::in,
+ relation(scc_id)::in, scc_pred_map::in,
+ aditi_dependency_ordering::in, aditi_dependency_ordering::out) is det.
+
+dependency_graph__merge_aditi_sccs_2([], _, _, _, _, _, Ordering, Ordering).
+dependency_graph__merge_aditi_sccs_2([SCCid | SCCs0], EqvSCCs0,
+ MergedSCCs0, NoMergeSCCs, SCCRel,
+ SCCPreds, Ordering0, Ordering) :-
+ ( set__member(SCCid, MergedSCCs0) ->
+ % This SCC has been merged into its parent.
+ Ordering1 = Ordering0,
+ EqvSCCs = EqvSCCs0,
+ SCCs = SCCs0
+ ;
+ dependency_graph__get_called_scc_ids(SCCid, SCCRel,
+ CalledSCCs),
+ map__lookup(SCCPreds, SCCid, SCC0 - EntryPoints),
+ dependency_graph__do_merge_aditi_sccs(SCCid, CalledSCCs,
+ NoMergeSCCs, SCCs0, SCCs, SCCPreds, SCCRel,
+ EqvSCCs0, EqvSCCs,
+ aditi_sub_module([SCC0], EntryPoints), SCC),
+ Ordering1 = [SCC | Ordering0]
+ ),
+ dependency_graph__merge_aditi_sccs_2(SCCs, EqvSCCs, MergedSCCs0,
+ NoMergeSCCs, SCCRel, SCCPreds, Ordering1, Ordering).
+
+ % Find the SCCs called from a given SCC.
+:- pred dependency_graph__get_called_scc_ids(scc_id::in, relation(scc_id)::in,
+ set(scc_id)::out) is det.
+
+dependency_graph__get_called_scc_ids(SCCid, SCCRel, CalledSCCSet) :-
+ relation__lookup_element(SCCRel, SCCid, SCCidKey),
+ relation__lookup_from(SCCRel, SCCidKey, CalledSCCKeys),
+ set__to_sorted_list(CalledSCCKeys, CalledSCCKeyList),
+ list__map(relation__lookup_key(SCCRel), CalledSCCKeyList, CalledSCCs),
+ set__list_to_set(CalledSCCs, CalledSCCSet).
+
+ % Go over the list of SCCs finding all those which
+ % can be merged into a given SCC.
+:- pred dependency_graph__do_merge_aditi_sccs(scc_id::in, set(scc_id)::in,
+ set(scc_id)::in, list(scc_id)::in, list(scc_id)::out,
+ scc_pred_map::in, relation(scc_id)::in,
+ eqvclass(scc_id)::in, eqvclass(scc_id)::out,
+ aditi_sub_module::in, aditi_sub_module::out) is det.
+
+dependency_graph__do_merge_aditi_sccs(_, _, _, [], [],
+ _, _, Eqv, Eqv, SubModule, SubModule).
+dependency_graph__do_merge_aditi_sccs(CurrSCCid, CalledSCCs, NoMergeSCCs,
+ [LowerSCCid | LowerSCCs0], LowerSCCs, SCCPreds, SCCRel,
+ EqvSCCs0, EqvSCCs, SubModule0, SubModule) :-
+ (
+ set__member(LowerSCCid, CalledSCCs),
+ \+ set__member(LowerSCCid, NoMergeSCCs)
+ ->
+ relation__lookup_element(SCCRel, LowerSCCid, LowerSCCKey),
+ relation__lookup_to(SCCRel, LowerSCCKey, CallingSCCKeys),
+ set__to_sorted_list(CallingSCCKeys, CallingSCCKeyList),
+ list__map(relation__lookup_key(SCCRel),
+ CallingSCCKeyList, CallingSCCs),
+ ( eqvclass__same_eqvclass_list(EqvSCCs0, CallingSCCs) ->
+
+ %
+ % All the calling SCCs have been merged (or
+ % there was only one to start with) so we
+ % can safely merge this one in as well.
+ %
+ eqvclass__new_equivalence(EqvSCCs0, CurrSCCid,
+ LowerSCCid, EqvSCCs1),
+ map__lookup(SCCPreds, LowerSCCid, LowerSCC),
+ LowerSCC = LowerSCCPreds - _,
+
+ %
+ % The entry-points of the combined SCC cannot include
+ % the entry-points of the lower SCC, since that
+ % would mean that the lower SCC was called from
+ % multiple places and could not be merged.
+ %
+ SubModule0 =
+ aditi_sub_module(CurrSCCPreds0, EntryPoints),
+ SubModule1 =
+ aditi_sub_module(
+ [LowerSCCPreds | CurrSCCPreds0],
+ EntryPoints),
+
+ %
+ % Add the SCCs called by the newly merged SCC
+ % to those we are attempting to merge.
+ %
+ dependency_graph__get_called_scc_ids(LowerSCCid,
+ SCCRel, LowerCalledSCCs),
+ set__union(CalledSCCs, LowerCalledSCCs, CalledSCCs1),
+
+ dependency_graph__do_merge_aditi_sccs(CurrSCCid,
+ CalledSCCs1, NoMergeSCCs, LowerSCCs0,
+ LowerSCCs, SCCPreds, SCCRel, EqvSCCs1, EqvSCCs,
+ SubModule1, SubModule)
+ ;
+ dependency_graph__do_merge_aditi_sccs(CurrSCCid,
+ CalledSCCs, NoMergeSCCs, LowerSCCs0,
+ LowerSCCs1, SCCPreds, SCCRel,
+ EqvSCCs0, EqvSCCs, SubModule0, SubModule),
+ LowerSCCs = [LowerSCCid | LowerSCCs1]
+ )
+ ;
+ dependency_graph__do_merge_aditi_sccs(CurrSCCid, CalledSCCs,
+ NoMergeSCCs, LowerSCCs0, LowerSCCs1, SCCPreds, SCCRel,
+ EqvSCCs0, EqvSCCs, SubModule0, SubModule),
+ LowerSCCs = [LowerSCCid | LowerSCCs1]
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- type aditi_scc_info
+ ---> aditi_scc_info(
+ module_info,
+ map(pred_proc_id, scc_id),
+ scc_pred_map,
+ set(pred_proc_id), % all local Aditi preds
+ relation(scc_id),
+ set(scc_id), % SCCs which can't be merged
+ % into their parents.
+ scc_id % current SCC.
+ ).
+
+ % For each SCC, a list of all preds in SCC, and a list
+ % of entry-points of the SCC.
+:- type scc_pred_map == map(scc_id, pair(list(pred_proc_id))).
+
+:- type scc_id == int.
+
+:- type scc == list(pred_proc_id).
+
+:- pred aditi_scc_info_init(module_info::in, aditi_scc_info::out) is det.
+
+aditi_scc_info_init(ModuleInfo, AditiInfo) :-
+ map__init(PredSCC),
+ map__init(SCCPred),
+ set__init(AditiPreds),
+ relation__init(SCCDep),
+ set__init(NoMergeSCCs),
+ AditiInfo = aditi_scc_info(ModuleInfo, PredSCC, SCCPred,
+ AditiPreds, SCCDep, NoMergeSCCs, 0).
+
+:- pred aditi_scc_info_get_module_info(module_info::out,
+ aditi_scc_info::in, aditi_scc_info::out) is det.
+
+aditi_scc_info_get_module_info(Module, Info, Info) :-
+ Info = aditi_scc_info(Module, _, _, _, _, _, _).
+
+:- pred aditi_scc_info_add_no_merge_scc(scc_id::in,
+ aditi_scc_info::in, aditi_scc_info::out) is det.
+
+aditi_scc_info_add_no_merge_scc(SCCid, Info0, Info) :-
+ Info0 = aditi_scc_info(A, B, C, D, E, NoMerge0, G),
+ set__insert(NoMerge0, SCCid, NoMerge),
+ Info = aditi_scc_info(A, B, C, D, E, NoMerge, G).
+
+:- pred aditi_scc_info_add_scc(list(pred_proc_id)::in,
+ dependency_ordering::in, scc_id::out,
+ aditi_scc_info::in, aditi_scc_info::out) is det.
+
+aditi_scc_info_add_scc(SCC, HigherSCCs, SCCid, Info0, Info) :-
+ Info0 = aditi_scc_info(ModuleInfo, PredSCC0, SCCPred0, AditiPreds0,
+ SCCRel0, NoMerge, LastSCC),
+ SCCid is LastSCC + 1,
+ dependency_graph__get_scc_entry_points(SCC, HigherSCCs,
+ ModuleInfo, EntryPoints),
+ map__det_insert(SCCPred0, SCCid, SCC - EntryPoints, SCCPred),
+ AddToMap =
+ lambda([PredProcId::in, PS0::in, PS::out] is det, (
+ map__det_insert(PS0, PredProcId, SCCid, PS)
+ )),
+ list__foldl(AddToMap, SCC, PredSCC0, PredSCC),
+ relation__add_element(SCCRel0, SCCid, _, SCCRel),
+ set__insert_list(AditiPreds0, SCC, AditiPreds),
+ Info = aditi_scc_info(ModuleInfo, PredSCC, SCCPred, AditiPreds,
+ SCCRel, NoMerge, SCCid).
+
+:- pred aditi_scc_info_handle_call(bool::in, pred_id::in, proc_id::in,
+ list(var)::in, multi_map(var, pred_proc_id)::in,
+ multi_map(var, pred_proc_id)::out,
+ aditi_scc_info::in, aditi_scc_info::out) is det.
+
+aditi_scc_info_handle_call(IsNeg, PredId, ProcId, Args,
+ Map, Map, Info0, Info) :-
+ Info0 = aditi_scc_info(ModuleInfo, PredSCC, SCCPred, AditiPreds,
+ SCCRel0, NoMerge0, SCCid),
+ PredProcId = proc(PredId, ProcId),
+ ( set__member(PredProcId, AditiPreds) ->
+ map__lookup(PredSCC, PredProcId, CalledSCCid),
+ ( CalledSCCid = SCCid ->
+ SCCRel1 = SCCRel0,
+ NoMerge1 = NoMerge0
+ ;
+ relation__add_values(SCCRel0, SCCid, CalledSCCid,
+ SCCRel1),
+ ( IsNeg = yes ->
+ set__insert(NoMerge0, CalledSCCid, NoMerge1)
+ ;
+ NoMerge1 = NoMerge0
+ )
+ ),
+ handle_higher_order_args(Args, no, SCCid, Map, PredSCC,
+ SCCRel1, SCCRel, NoMerge1, NoMerge),
+ Info = aditi_scc_info(ModuleInfo, PredSCC, SCCPred, AditiPreds,
+ SCCRel, NoMerge, SCCid)
+ ;
+ ( hlds_pred__is_aditi_aggregate(ModuleInfo, PredId) ->
+ handle_higher_order_args(Args, yes, SCCid, Map,
+ PredSCC, SCCRel0, SCCRel, NoMerge0, NoMerge),
+ Info = aditi_scc_info(ModuleInfo, PredSCC, SCCPred,
+ AditiPreds, SCCRel, NoMerge, SCCid)
+ ;
+ Info = Info0
+ )
+ ).
+
+ % An SCC cannot be merged into its parents if one of its
+ % procedures is called as an aggregate query.
+:- pred handle_higher_order_args(list(var)::in, bool::in, scc_id::in,
+ multi_map(var, pred_proc_id)::in, map(pred_proc_id, scc_id)::in,
+ relation(scc_id)::in, relation(scc_id)::out,
+ set(scc_id)::in, set(scc_id)::out) is det.
+
+handle_higher_order_args([], _, _, _, _, SCCRel, SCCRel, NoMerge, NoMerge).
+handle_higher_order_args([Arg | Args], IsAgg, SCCid, Map, PredSCC,
+ SCCRel0, SCCRel, NoMerge0, NoMerge) :-
+ ( multi_map__search(Map, Arg, PredProcIds) ->
+ list__foldl2(handle_higher_order_arg(PredSCC, IsAgg, SCCid),
+ PredProcIds, SCCRel0, SCCRel1, NoMerge0, NoMerge1)
+ ;
+ SCCRel1 = SCCRel0,
+ NoMerge1 = NoMerge0
+ ),
+ handle_higher_order_args(Args, IsAgg, SCCid, Map, PredSCC,
+ SCCRel1, SCCRel, NoMerge1, NoMerge).
+
+:- pred handle_higher_order_arg(map(pred_proc_id, scc_id)::in, bool::in,
+ scc_id::in, pred_proc_id::in,
+ relation(scc_id)::in, relation(scc_id)::out,
+ set(scc_id)::in, set(scc_id)::out) is det.
+
+handle_higher_order_arg(PredSCC, IsAgg, SCCid, PredProcId,
+ SCCRel0, SCCRel, NoMerge0, NoMerge) :-
+ ( map__search(PredSCC, PredProcId, CalledSCCid) ->
+ % Make sure anything called through an
+ % aggregate is not merged into the current
+ % sub-module.
+ ( IsAgg = yes ->
+ set__insert(NoMerge0, CalledSCCid, NoMerge)
+ ;
+ NoMerge = NoMerge0
+ ),
+ ( CalledSCCid = SCCid ->
+ SCCRel = SCCRel0
+ ;
+ relation__add_values(SCCRel0, SCCid,
+ CalledSCCid, SCCRel)
+ )
+ ;
+ NoMerge = NoMerge0,
+ SCCRel = SCCRel0
+ ).
+
+:- pred aditi_scc_info_add_closure(var::in, pred_proc_id::in,
+ multi_map(var, pred_proc_id)::in,
+ multi_map(var, pred_proc_id)::out,
+ aditi_scc_info::in, aditi_scc_info::out) is det.
+
+aditi_scc_info_add_closure(Var, PredProcId, Map0, Map, Info, Info) :-
+ Info = aditi_scc_info(_, _, _, AditiPreds, _, _, _),
+ ( set__member(PredProcId, AditiPreds) ->
+ multi_map__set(Map0, Var, PredProcId, Map)
+ ;
+ Map = Map0
+ ).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/dnf.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dnf.m,v
retrieving revision 1.31
diff -u -t -u -r1.31 dnf.m
--- dnf.m 1998/06/09 02:12:29 1.31
+++ dnf.m 1998/06/11 23:33:34
@@ -26,6 +26,8 @@
%
% Calls and unifications are atomic goals. Existential quantification of
% a call or unification is an atomic goal.
+% A call and some test unifications on the output is an atomic goal. If these
+% are not made atomic, magic.m just recreates the tests anyway.
%
% The main predicate of this module allows callers to specify that *any*
% goal should be considered atomic unless it involves calls to certain
@@ -58,16 +60,18 @@
:- implementation.
-:- import_module hlds_goal, hlds_data, prog_data, instmap.
-:- import_module excess, make_hlds, mode_util.
-:- import_module require, map, string, int, term, varset.
+:- import_module code_aux, code_util, hlds_goal, hlds_data, prog_data, instmap.
+:- import_module dependency_graph, det_analysis, excess, make_hlds, mode_util.
+:- import_module require, map, list, string, int, bool, std_util, term, varset.
% Traverse the module structure.
-dnf__transform_module(ModuleInfo0, TransformAll, MaybeNonAtomic, ModuleInfo1) :-
+dnf__transform_module(ModuleInfo0, TransformAll, MaybeNonAtomic, ModuleInfo) :-
module_info_predids(ModuleInfo0, PredIds),
dnf__transform_preds(PredIds, TransformAll, MaybeNonAtomic,
- ModuleInfo0, ModuleInfo1).
+ ModuleInfo0, ModuleInfo1),
+ % The dependency_graph information is now incorrect.
+ module_info_clobber_dependency_info(ModuleInfo1, ModuleInfo).
:- pred dnf__transform_preds(list(pred_id)::in, bool::in,
maybe(set(pred_proc_id))::in, module_info::in, module_info::out) is det.
@@ -82,7 +86,9 @@
module_info_preds(ModuleInfo0, PredTable),
map__lookup(PredTable, PredId, PredInfo),
pred_info_get_markers(PredInfo, Markers),
- check_marker(Markers, dnf)
+ ( check_marker(Markers, dnf)
+ ; check_marker(Markers, aditi)
+ )
)
->
dnf__transform_pred(PredId, MaybeNonAtomic,
@@ -138,13 +144,14 @@
pred_info_typevarset(PredInfo0, TVarSet),
pred_info_get_markers(PredInfo0, Markers),
pred_info_get_class_context(PredInfo0, ClassContext),
+ pred_info_get_aditi_owner(PredInfo0, Owner),
proc_info_goal(ProcInfo0, Goal0),
proc_info_varset(ProcInfo0, VarSet),
proc_info_vartypes(ProcInfo0, VarTypes),
proc_info_typeinfo_varmap(ProcInfo0, TVarMap),
proc_info_typeclass_info_varmap(ProcInfo0, TCVarMap),
DnfInfo = dnf_info(TVarSet, VarTypes, ClassContext,
- VarSet, Markers, TVarMap, TCVarMap),
+ VarSet, Markers, TVarMap, TCVarMap, Owner),
proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap),
dnf__transform_goal(Goal0, InstMap, MaybeNonAtomic,
@@ -161,7 +168,8 @@
varset,
pred_markers,
map(tvar, type_info_locn),
- map(class_constraint, var)
+ map(class_constraint, var),
+ string % Aditi owner
).
:- pred dnf__transform_goal(hlds_goal::in, instmap::in,
@@ -182,17 +190,17 @@
GoalExpr0 = par_conj(_Goals0, _SM),
error("sorry, dnf of parallel conjunction not implemented")
;
- GoalExpr0 = some(_, _),
- dnf__transform_conj([Goal0], InstMap0, MaybeNonAtomic,
- ModuleInfo0, ModuleInfo, Base, 0, _, DnfInfo,
- Goals, NewPredIds0, NewPredIds),
- Goal = conj(Goals) - GoalInfo
- ;
- GoalExpr0 = not(_),
- dnf__transform_conj([Goal0], InstMap0, MaybeNonAtomic,
- ModuleInfo0, ModuleInfo, Base, 0, _, DnfInfo,
- Goals, NewPredIds0, NewPredIds),
- Goal = conj(Goals) - GoalInfo
+ GoalExpr0 = some(Vars, SomeGoal0),
+ dnf__make_goal_literal(SomeGoal0, InstMap0, MaybeNonAtomic,
+ ModuleInfo0, ModuleInfo, no, yes, Base, 0, _,
+ DnfInfo, SomeGoal, NewPredIds0, NewPredIds),
+ Goal = some(Vars, SomeGoal) - GoalInfo
+ ;
+ GoalExpr0 = not(NegGoal0),
+ dnf__make_goal_literal(NegGoal0, InstMap0, MaybeNonAtomic,
+ ModuleInfo0, ModuleInfo, yes, no, Base, 0, _,
+ DnfInfo, NegGoal, NewPredIds0, NewPredIds),
+ Goal = not(NegGoal) - GoalInfo
;
GoalExpr0 = disj(Goals0, SM),
dnf__transform_disj(Goals0, InstMap0, MaybeNonAtomic,
@@ -295,8 +303,8 @@
Cond, Then, Else, NewPredIds0, NewPredIds) :-
Cond0 = _ - CondInfo,
dnf__make_goal_literal(Cond0, InstMap0, MaybeNonAtomic,
- ModuleInfo0, ModuleInfo1, Base, Counter0, Counter1, DnfInfo,
- Cond, NewPredIds0, NewPredIds1),
+ ModuleInfo0, ModuleInfo1, yes, no, Base, Counter0, Counter1,
+ DnfInfo, Cond, NewPredIds0, NewPredIds1),
goal_info_get_instmap_delta(CondInfo, InstMapDelta),
instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap1),
Then0 = _ - ThenInfo,
@@ -325,8 +333,8 @@
ModuleInfo0, ModuleInfo, Base, Counter0, Counter, DnfInfo,
[Goal | Goals], NewPredIds0, NewPredIds) :-
dnf__make_goal_literal(Goal0, InstMap0, MaybeNonAtomic,
- ModuleInfo0, ModuleInfo1, Base, Counter0, Counter1, DnfInfo,
- Goal, NewPredIds0, NewPredIds1),
+ ModuleInfo0, ModuleInfo1, no, no, Base, Counter0, Counter1,
+ DnfInfo, Goal, NewPredIds0, NewPredIds1),
Goal0 = _ - GoalInfo0,
goal_info_get_instmap_delta(GoalInfo0, InstMapDelta),
instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap1),
@@ -334,15 +342,20 @@
ModuleInfo1, ModuleInfo, Base, Counter1, Counter, DnfInfo,
Goals, NewPredIds1, NewPredIds).
+%-----------------------------------------------------------------------------%
+
:- pred dnf__make_goal_literal(hlds_goal::in, instmap::in,
maybe(set(pred_proc_id))::in, module_info::in, module_info::out,
- string::in, int::in, int::out, dnf_info::in, hlds_goal::out,
- list(pred_id)::in, list(pred_id)::out) is det.
+ bool::in, bool::in, string::in, int::in, int::out, dnf_info::in,
+ hlds_goal::out, list(pred_id)::in, list(pred_id)::out) is det.
-dnf__make_goal_literal(Goal0, InstMap0, MaybeNonAtomic,
- ModuleInfo0, ModuleInfo, Base, Counter0, Counter, DnfInfo,
- Goal, NewPredIds0, NewPredIds) :-
- ( dnf__is_considered_literal_goal(Goal0, MaybeNonAtomic) ->
+dnf__make_goal_literal(Goal0, InstMap0, MaybeNonAtomic, ModuleInfo0,
+ ModuleInfo, InNeg, InSome, Base, Counter0, Counter,
+ DnfInfo, Goal, NewPredIds0, NewPredIds) :-
+ (
+ dnf__is_considered_literal_goal(Goal0,
+ InNeg, InSome, MaybeNonAtomic)
+ ->
Goal = Goal0,
Counter = Counter0,
ModuleInfo = ModuleInfo0,
@@ -377,7 +390,7 @@
dnf__define_new_pred(Goal0, Goal, InstMap0, PredName, DnfInfo,
ModuleInfo0, ModuleInfo, PredId) :-
DnfInfo = dnf_info(TVarSet, VarTypes, ClassContext,
- VarSet, Markers, TVarMap, TCVarMap),
+ VarSet, Markers, TVarMap, TCVarMap, Owner),
Goal0 = _GoalExpr - GoalInfo,
goal_info_get_nonlocals(GoalInfo, NonLocals),
set__to_sorted_list(NonLocals, ArgVars),
@@ -386,95 +399,124 @@
% that are not part of the goal.
hlds_pred__define_new_pred(Goal0, Goal, ArgVars, InstMap0, PredName,
TVarSet, VarTypes, ClassContext, TVarMap, TCVarMap,
- VarSet, Markers, ModuleInfo0, ModuleInfo, PredProcId),
+ VarSet, Markers, Owner, ModuleInfo0, ModuleInfo, PredProcId),
PredProcId = proc(PredId, _).
-:- pred dnf__compute_arg_types_modes(list(var)::in, map(var, type)::in,
- instmap::in, instmap::in, list(type)::out, list(mode)::out) is det.
-
-dnf__compute_arg_types_modes([], _, _, _, [], []).
-dnf__compute_arg_types_modes([Var | Vars], VarTypes, InstMap0, InstMap,
- [Type | Types], [Mode | Modes]) :-
- map__lookup(VarTypes, Var, Type),
- instmap__lookup_var(InstMap0, Var, Inst0),
- instmap__lookup_var(InstMap, Var, Inst),
- Mode = (Inst0 -> Inst),
- dnf__compute_arg_types_modes(Vars, VarTypes, InstMap0, InstMap,
- Types, Modes).
-
%-----------------------------------------------------------------------------%
-:- pred dnf__is_considered_literal_goal(hlds_goal::in,
+:- pred dnf__is_considered_literal_goal(hlds_goal::in, bool::in, bool::in,
maybe(set(pred_proc_id))::in) is semidet.
-dnf__is_considered_literal_goal(GoalExpr - _, MaybeNonAtomic) :-
- ( GoalExpr = not(SubGoalExpr - _) ->
- dnf__is_considered_atomic_expr(SubGoalExpr, MaybeNonAtomic)
+dnf__is_considered_literal_goal(Goal, InNeg, InSome, MaybeNonAtomic) :-
+ ( Goal = not(SubGoal) - _ ->
+ InNeg = no,
+ dnf__is_considered_atomic(SubGoal,
+ yes, InSome, MaybeNonAtomic)
;
- dnf__is_considered_atomic_expr(GoalExpr, MaybeNonAtomic)
+ dnf__is_considered_atomic(Goal,
+ InNeg, InSome, MaybeNonAtomic)
).
-:- pred dnf__is_considered_atomic_expr(hlds_goal_expr::in,
+:- pred dnf__is_considered_atomic(hlds_goal::in, bool::in, bool::in,
maybe(set(pred_proc_id))::in) is semidet.
-dnf__is_considered_atomic_expr(GoalExpr, MaybeNonAtomic) :-
+dnf__is_considered_atomic(Goal, InNeg, InSome, MaybeNonAtomic) :-
(
- dnf__is_atomic_expr(GoalExpr, yes)
+ Goal = GoalExpr - _,
+ dnf__is_atomic_expr(MaybeNonAtomic, InNeg, InSome,
+ GoalExpr, yes)
;
MaybeNonAtomic = yes(NonAtomic),
- dnf__expr_free_of_nonatomic(GoalExpr, NonAtomic)
+ dnf__free_of_nonatomic(Goal, NonAtomic)
).
-:- pred dnf__is_atomic_expr(hlds_goal_expr::in, bool::out) is det.
+:- pred dnf__is_atomic_expr(maybe(set(pred_proc_id))::in, bool::in, bool::in,
+ hlds_goal_expr::in, bool::out) is det.
-dnf__is_atomic_expr(conj(_), no).
-dnf__is_atomic_expr(par_conj(_, _), no).
-dnf__is_atomic_expr(higher_order_call(_, _, _, _, _, _), yes).
-dnf__is_atomic_expr(class_method_call(_, _, _, _, _, _), yes).
-dnf__is_atomic_expr(call(_, _, _, _, _, _), yes).
-dnf__is_atomic_expr(switch(_, _, _, _), no).
-dnf__is_atomic_expr(unify(_, _, _, _, _), yes).
-dnf__is_atomic_expr(disj(_, _), no).
-dnf__is_atomic_expr(not(_), no).
-dnf__is_atomic_expr(some(_, GoalExpr - _), IsAtomic) :-
- dnf__is_atomic_expr(GoalExpr, IsAtomic).
-dnf__is_atomic_expr(if_then_else(_, _, _, _, _), no).
-dnf__is_atomic_expr(pragma_c_code(_, _, _, _, _, _, _), yes).
+dnf__is_atomic_expr(_, _, _, conj([]), yes).
+ % Don't transform a call and some atomic tests on the outputs, since
+ % magic.m will just create another copy of the tests, adding some extra
+ % overhead. This form of conjunction commonly occurs for calls
+ % in implied modes.
+dnf__is_atomic_expr(MaybeNonAtomic, _, _, conj([Call | Tests]), IsAtomic) :-
+ (
+ Call = call(_, _, _, _, _, _) - _,
+ MaybeNonAtomic = yes(NonAtomic),
+ dnf__goals_free_of_nonatomic(Tests, NonAtomic)
+ ->
+ IsAtomic = yes
+ ;
+ IsAtomic = no
+ ).
+dnf__is_atomic_expr(_, _, _, par_conj(_, _), no).
+dnf__is_atomic_expr(_, _, _, higher_order_call(_, _, _, _, _, _), yes).
+dnf__is_atomic_expr(_, _, _, call(_, _, _, _, _, _), yes).
+dnf__is_atomic_expr(_, _, _, switch(_, _, _, _), no).
+dnf__is_atomic_expr(_, _, _, unify(_, _, _, _, _), yes).
+dnf__is_atomic_expr(_, _, _, disj(_, _), no).
+dnf__is_atomic_expr(MaybeNonAtomic, InNeg, InSome, not(NegGoalExpr - _),
+ IsAtomic) :-
+ ( InNeg = no ->
+ dnf__is_atomic_expr(MaybeNonAtomic, yes, InSome,
+ NegGoalExpr, IsAtomic)
+ ;
+ IsAtomic = no
+ ).
+dnf__is_atomic_expr(MaybeNonAtomic, InNeg, InSome,
+ some(_, GoalExpr - _), IsAtomic) :-
+ ( InSome = no ->
+ dnf__is_atomic_expr(MaybeNonAtomic, InNeg, yes,
+ GoalExpr, IsAtomic)
+ ;
+ IsAtomic = no
+ ).
+dnf__is_atomic_expr(_, _, _, if_then_else(_, _, _, _, _), no).
+dnf__is_atomic_expr(_, _, _, pragma_c_code(_, _, _, _, _, _, _), yes).
+dnf__is_atomic_expr(_, _, _, class_method_call(_, _, _, _, _, _), yes).
-:- pred dnf__expr_free_of_nonatomic(hlds_goal_expr::in,
+:- pred dnf__free_of_nonatomic(hlds_goal::in,
set(pred_proc_id)::in) is semidet.
-dnf__expr_free_of_nonatomic(conj(Goals), NonAtomic) :-
+dnf__free_of_nonatomic(conj(Goals) - _, NonAtomic) :-
dnf__goals_free_of_nonatomic(Goals, NonAtomic).
-dnf__expr_free_of_nonatomic(call(PredId, ProcId, _, _, _, _), NonAtomic) :-
+dnf__free_of_nonatomic(par_conj(Goals, _) - _, NonAtomic) :-
+ dnf__goals_free_of_nonatomic(Goals, NonAtomic).
+dnf__free_of_nonatomic(call(PredId, ProcId, _, _, _, _) - _, NonAtomic) :-
\+ set__member(proc(PredId, ProcId), NonAtomic).
-dnf__expr_free_of_nonatomic(switch(_, _, Cases, _), NonAtomic) :-
+dnf__free_of_nonatomic(switch(_, _, Cases, _) - _, NonAtomic) :-
dnf__cases_free_of_nonatomic(Cases, NonAtomic).
-dnf__expr_free_of_nonatomic(unify(_, _, _, _, _), _NonAtomic).
-dnf__expr_free_of_nonatomic(disj(Goals, _), NonAtomic) :-
+dnf__free_of_nonatomic(unify(_, _, _, Uni, _) - _, NonAtomic) :-
+ \+ (
+ Uni = construct(_, pred_const(PredId, ProcId), _, _),
+ set__member(proc(PredId, ProcId), NonAtomic)
+ ).
+dnf__free_of_nonatomic(disj(Goals, _) - GoalInfo, NonAtomic) :-
+ % For Aditi, nondet disjunctions are non-atomic,
+ % no matter what they contain.
+ goal_info_get_determinism(GoalInfo, Detism),
+ \+ determinism_components(Detism, _, at_most_many),
dnf__goals_free_of_nonatomic(Goals, NonAtomic).
-dnf__expr_free_of_nonatomic(not(Goal), NonAtomic) :-
- dnf__goal_free_of_nonatomic(Goal, NonAtomic).
-dnf__expr_free_of_nonatomic(some(_, Goal), NonAtomic) :-
- dnf__goal_free_of_nonatomic(Goal, NonAtomic).
-dnf__expr_free_of_nonatomic(if_then_else(_, Cond, Then, Else, _), NonAtomic) :-
- dnf__goal_free_of_nonatomic(Cond, NonAtomic),
- dnf__goal_free_of_nonatomic(Then, NonAtomic),
- dnf__goal_free_of_nonatomic(Else, NonAtomic).
-dnf__expr_free_of_nonatomic(pragma_c_code(_, _, _, _, _, _, _), _NonAtomic).
-
-:- pred dnf__goal_free_of_nonatomic(hlds_goal::in,
- set(pred_proc_id)::in) is semidet.
-
-dnf__goal_free_of_nonatomic(GoalExpr - _, NonAtomic) :-
- dnf__expr_free_of_nonatomic(GoalExpr, NonAtomic).
+dnf__free_of_nonatomic(not(Goal) - _, NonAtomic) :-
+ dnf__free_of_nonatomic(Goal, NonAtomic).
+dnf__free_of_nonatomic(some(_, Goal) - _, NonAtomic) :-
+ dnf__free_of_nonatomic(Goal, NonAtomic).
+dnf__free_of_nonatomic(if_then_else(_, Cond, Then, Else, _) - GoalInfo,
+ NonAtomic) :-
+ % For Aditi, nondet if-then-elses are non-atomic,
+ % no matter what they contain.
+ goal_info_get_determinism(GoalInfo, Detism),
+ \+ determinism_components(Detism, _, at_most_many),
+ dnf__free_of_nonatomic(Cond, NonAtomic),
+ dnf__free_of_nonatomic(Then, NonAtomic),
+ dnf__free_of_nonatomic(Else, NonAtomic).
+dnf__free_of_nonatomic(pragma_c_code(_, _, _, _, _, _, _) - _, _NonAtomic).
:- pred dnf__goals_free_of_nonatomic(list(hlds_goal)::in,
set(pred_proc_id)::in) is semidet.
dnf__goals_free_of_nonatomic([], _NonAtomic).
dnf__goals_free_of_nonatomic([Goal | Goals], NonAtomic) :-
- dnf__goal_free_of_nonatomic(Goal, NonAtomic),
+ dnf__free_of_nonatomic(Goal, NonAtomic),
dnf__goals_free_of_nonatomic(Goals, NonAtomic).
:- pred dnf__cases_free_of_nonatomic(list(case)::in,
@@ -482,7 +524,7 @@
dnf__cases_free_of_nonatomic([], _NonAtomic).
dnf__cases_free_of_nonatomic([case(_, Goal) | Cases], NonAtomic) :-
- dnf__goal_free_of_nonatomic(Goal, NonAtomic),
+ dnf__free_of_nonatomic(Goal, NonAtomic),
dnf__cases_free_of_nonatomic(Cases, NonAtomic).
%-----------------------------------------------------------------------------%
Index: compiler/dupelim.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dupelim.m,v
retrieving revision 1.33
diff -u -t -u -r1.33 dupelim.m
--- dupelim.m 1998/06/09 02:12:32 1.33
+++ dupelim.m 1998/06/19 01:47:34
@@ -953,6 +953,11 @@
do_semidet_class_method).
dupelim__replace_labels_code_addr(do_nondet_class_method, _,
do_nondet_class_method).
+dupelim__replace_labels_code_addr(do_det_aditi_call, _, do_det_aditi_call).
+dupelim__replace_labels_code_addr(do_semidet_aditi_call, _,
+ do_semidet_aditi_call).
+dupelim__replace_labels_code_addr(do_nondet_aditi_call, _,
+ do_nondet_aditi_call).
dupelim__replace_labels_code_addr(do_not_reached, _, do_not_reached).
:- pred dupelim__replace_labels_label_list(list(label)::in,
Index: compiler/error_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/error_util.m,v
retrieving revision 1.5
diff -u -t -u -r1.5 error_util.m
--- error_util.m 1998/05/21 16:51:40 1.5
+++ error_util.m 1998/06/29 05:13:50
@@ -16,7 +16,8 @@
:- interface.
-:- import_module io, list, term.
+:- import_module hlds_module, hlds_pred.
+:- import_module assoc_list, io, list, std_util, term.
% Given a context, a starting indentation level and a list of words,
% print an error message that looks like this:
@@ -41,20 +42,55 @@
---> fixed(string) % This string should appear in the output
% in one piece, as it is.
- ; words(string). % This string contains words separated by
+ ; words(string) % This string contains words separated by
% white space. The words should appear in
% the output in the given order, but the
% white space may be rearranged and line
% breaks may be inserted.
+ ; nl % Insert a line break, if there has been text
+ % output since the last line break.
+ .
+
+
+:- pred error_util__list_to_pieces(list(string)::in,
+ list(format_component)::out) is det.
+
:- pred write_error_pieces(term__context::in, int::in,
list(format_component)::in, io__state::di, io__state::uo) is det.
+
+ % Predicates to convert a predicate names to strings.
+
+:- pred error_util__describe_one_pred_name(module_info::in, pred_id::in,
+ string::out) is det.
+
+:- pred error_util__describe_one_proc_name(module_info::in, pred_proc_id::in,
+ string::out) is det.
+
+:- pred error_util__describe_several_proc_names(module_info::in,
+ list(pred_proc_id)::in, list(format_component)::out) is det.
+
+:- pred error_util__describe_one_call_site(module_info::in,
+ pair(pred_proc_id, term__context)::in, string::out) is det.
+
+:- pred error_util__describe_several_call_sites(module_info::in,
+ assoc_list(pred_proc_id, term__context)::in,
+ list(format_component)::out) is det.
+
:- implementation.
:- import_module prog_out.
-:- import_module char.
-:- import_module io, list, term, char, string, int.
+:- import_module bool, io, list, term, char, string, int.
+
+error_util__list_to_pieces([], []).
+error_util__list_to_pieces([Elem], [words(Elem)]).
+error_util__list_to_pieces([Elem1, Elem2],
+ [fixed(Elem1), words("and"), fixed(Elem2)]).
+error_util__list_to_pieces([Elem1, Elem2, Elem3 | Elems], Pieces) :-
+ string__append(Elem1, ",", Piece1),
+ error_util__list_to_pieces([Elem2, Elem3 | Elems], Pieces1),
+ Pieces = [fixed(Piece1) | Pieces1].
write_error_pieces(Context, Indent, Components) -->
{
@@ -77,8 +113,8 @@
),
Remain is 79 - (FileNameLength + 1 +
LineNumberStrLength + 2 + Indent),
- convert_components_to_word_list(Components, Words),
- group_words(Words, Remain, Lines)
+ convert_components_to_word_list(Components, [], [], Words),
+ group_words(yes, Words, Remain, Lines)
},
write_lines(Lines, Context, Indent).
@@ -124,37 +160,48 @@
%----------------------------------------------------------------------------%
:- pred convert_components_to_word_list(list(format_component)::in,
- list(string)::out) is det.
+ list(string)::in, list(list(string))::in,
+ list(list(string))::out) is det.
-convert_components_to_word_list([], []).
-convert_components_to_word_list([Component | Components], Words) :-
- convert_components_to_word_list(Components, TailWords),
+convert_components_to_word_list([], Words0, Paras0, Paras) :-
+ list__reverse(Words0, Words),
+ list__reverse([Words | Paras0], Paras).
+convert_components_to_word_list([Component | Components], Words0,
+ Paras0, Paras) :-
(
Component = fixed(Word),
- Words = [Word | TailWords]
+ Words1 = [Word | Words0],
+ Paras1 = Paras0
;
Component = words(WordsStr),
- break_into_words(WordsStr, HeadWords),
- list__append(HeadWords, TailWords, Words)
- ).
-
-:- pred break_into_words(string::in, list(string)::out) is det.
+ break_into_words(WordsStr, Words0, Words1),
+ Paras1 = Paras0
+ ;
+ Component = nl,
+ list__reverse(Words0, Words),
+ Paras1 = [Words | Paras0],
+ Words1 = []
+ ),
+ convert_components_to_word_list(Components, Words1, Paras1, Paras).
+
+:- pred break_into_words(string::in, list(string)::in,
+ list(string)::out) is det.
-break_into_words(String, Words) :-
- break_into_words_from(String, 0, Words).
+break_into_words(String, Words0, Words) :-
+ break_into_words_from(String, 0, Words0, Words).
-:- pred break_into_words_from(string::in, int::in, list(string)::out) is det.
+:- pred break_into_words_from(string::in, int::in,
+ list(string)::in, list(string)::out) is det.
-break_into_words_from(String, Cur, Words) :-
+break_into_words_from(String, Cur, Words0, Words) :-
( find_word_start(String, Cur, Start) ->
find_word_end(String, Start, End),
Length is End - Start + 1,
string__substring(String, Start, Length, Word),
Next is End + 1,
- break_into_words_from(String, Next, MoreWords),
- Words = [Word | MoreWords]
+ break_into_words_from(String, Next, [Word | Words0], Words)
;
- Words = []
+ Words = Words0
).
:- pred find_word_start(string::in, int::in, int::out) is semidet.
@@ -189,18 +236,32 @@
% The given list of words must be nonempty, since we always return
% at least one line.
-:- pred group_words(list(string)::in, int::in, list(list(string))::out) is det.
+:- pred group_words(bool::in, list(list(string))::in, int::in,
+ list(list(string))::out) is det.
-group_words(Words, Max, Lines) :-
+group_words(IsFirst, Paras, Max, Lines) :-
(
- Words = [],
+ Paras = [],
Lines = []
;
- Words = [FirstWord | LaterWords],
- get_line_of_words(FirstWord, LaterWords, Max, Line, RestWords),
- Max2 is Max - 2,
- group_nonfirst_line_words(RestWords, Max2, RestLines),
- Lines = [Line | RestLines]
+ Paras = [FirstPara | LaterParas],
+ (
+ FirstPara = [],
+ group_words(IsFirst, LaterParas, Max, Lines)
+ ;
+ FirstPara = [FirstWord | LaterWords],
+ get_line_of_words(FirstWord, LaterWords,
+ Max, Line, RestWords),
+ ( IsFirst = yes ->
+ Max2 is Max - 2
+ ;
+ Max2 = Max
+ ),
+ group_nonfirst_line_words(RestWords, Max2, RestLines1),
+ Lines1 = [Line | RestLines1],
+ group_words(no, LaterParas, Max2, RestLines),
+ list__append(Lines1, RestLines, Lines)
+ )
).
:- pred group_nonfirst_line_words(list(string)::in, int::in,
@@ -233,10 +294,73 @@
string__length(Word, WordLen),
NewLen is OldLen + 1 + WordLen,
( NewLen =< MaxLen ->
- append(Line0, [Word], Line1),
+ list__append(Line0, [Word], Line1),
get_later_words(Words, NewLen, MaxLen,
Line1, Line, RestWords)
;
Line = Line0,
RestWords = [Word | Words]
).
+
+%-----------------------------------------------------------------------------%
+
+ % The code of this predicate duplicates the functionality of
+ % hlds_out__write_pred_id. Changes here should be made there as well.
+
+error_util__describe_one_pred_name(Module, PredId, Piece) :-
+ module_info_pred_info(Module, PredId, PredInfo),
+ pred_info_module(PredInfo, ModuleName),
+ prog_out__sym_name_to_string(ModuleName, ModuleNameString),
+ pred_info_name(PredInfo, PredName),
+ pred_info_arity(PredInfo, Arity),
+ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
+ (
+ PredOrFunc = predicate,
+ PredOrFuncPart = "predicate ",
+ OrigArity = Arity
+ ;
+ PredOrFunc = function,
+ PredOrFuncPart = "function ",
+ OrigArity is Arity - 1
+ ),
+ string__int_to_string(OrigArity, ArityPart),
+ string__append_list([
+ PredOrFuncPart,
+ ModuleNameString,
+ ":",
+ PredName,
+ "/",
+ ArityPart
+ ], Piece).
+
+error_util__describe_one_proc_name(Module, proc(PredId, ProcId), Piece) :-
+ error_util__describe_one_pred_name(Module, PredId, PredPiece),
+ proc_id_to_int(ProcId, ProcIdInt),
+ string__int_to_string(ProcIdInt, ProcIdPart),
+ string__append_list([
+ PredPiece,
+ " mode ",
+ ProcIdPart
+ ], Piece).
+
+error_util__describe_several_proc_names(Module, PPIds, Pieces) :-
+ list__map(error_util__describe_one_proc_name(Module), PPIds, Pieces0),
+ error_util__list_to_pieces(Pieces0, Pieces).
+
+error_util__describe_one_call_site(Module, PPId - Context, Piece) :-
+ error_util__describe_one_proc_name(Module, PPId, ProcName),
+ term__context_file(Context, FileName),
+ term__context_line(Context, LineNumber),
+ string__int_to_string(LineNumber, LineNumberPart),
+ string__append_list([
+ ProcName,
+ " at ",
+ FileName,
+ ":",
+ LineNumberPart
+ ], Piece).
+
+error_util__describe_several_call_sites(Module, Sites, Pieces) :-
+ list__map(error_util__describe_one_call_site(Module), Sites, Pieces0),
+ error_util__list_to_pieces(Pieces0, Pieces).
+
Index: compiler/exprn_aux.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/exprn_aux.m,v
retrieving revision 1.28
diff -u -t -u -r1.28 exprn_aux.m
--- exprn_aux.m 1998/01/23 12:56:29 1.28
+++ exprn_aux.m 1998/06/19 01:43:49
@@ -153,6 +153,9 @@
exprn_aux__addr_is_constant(do_det_class_method, _, no).
exprn_aux__addr_is_constant(do_semidet_class_method, _, no).
exprn_aux__addr_is_constant(do_nondet_class_method, _, no).
+exprn_aux__addr_is_constant(do_det_aditi_call, _, no).
+exprn_aux__addr_is_constant(do_semidet_aditi_call, _, no).
+exprn_aux__addr_is_constant(do_nondet_aditi_call, _, no).
exprn_aux__addr_is_constant(do_not_reached, _, no).
:- pred exprn_aux__label_is_constant(label, bool, bool, bool).
Index: compiler/globals.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/globals.m,v
retrieving revision 1.31
diff -u -t -u -r1.31 globals.m
--- globals.m 1998/06/18 06:06:09 1.31
+++ globals.m 1998/07/07 00:33:21
@@ -46,6 +46,12 @@
; num_data_elems
; size_data_elems.
+ % This field should be set to `do_aditi_compilation' if there
+ % are local Aditi predicates.
+:- type aditi_compilation
+ ---> do_aditi_compilation
+ ; no_aditi_compilation.
+
:- type trace_level.
:- pred trace_level_trace_interface(trace_level::in, bool::out) is det.
@@ -65,8 +71,8 @@
% Access predicates for the `globals' structure.
:- pred globals__init(option_table::di, gc_method::di, tags_method::di,
- args_method::di, prolog_dialect::di,
- termination_norm::di, trace_level::di, globals::uo) is det.
+ args_method::di, prolog_dialect::di, termination_norm::di,
+ trace_level::di, aditi_compilation::di, globals::uo) is det.
:- pred globals__get_options(globals::in, option_table::out) is det.
:- pred globals__get_gc_method(globals::in, gc_method::out) is det.
@@ -76,12 +82,15 @@
:- pred globals__get_termination_norm(globals::in, termination_norm::out)
is det.
:- pred globals__get_trace_level(globals::in, trace_level::out) is det.
+:- pred globals__get_do_aditi_compilation(globals::in,
+ aditi_compilation::out) is det.
:- pred globals__set_options(globals::in, option_table::in, globals::out)
is det.
:- pred globals__set_trace_level(globals::in, trace_level::in, globals::out)
is det.
+:- pred globals__set_do_aditi_compilation(globals::in, globals::out) is det.
:- pred globals__lookup_option(globals::in, option::in, option_data::out)
is det.
@@ -111,7 +120,8 @@
:- pred globals__io_init(option_table::di, gc_method::in, tags_method::in,
args_method::in, prolog_dialect::in, termination_norm::in,
- trace_level::in, io__state::di, io__state::uo) is det.
+ trace_level::in, aditi_compilation::in,
+ io__state::di, io__state::uo) is det.
:- pred globals__io_get_gc_method(gc_method::out,
io__state::di, io__state::uo) is det.
@@ -131,6 +141,9 @@
:- pred globals__io_get_trace_level(trace_level::out,
io__state::di, io__state::uo) is det.
+:- pred globals__io_get_do_aditi_compilation(aditi_compilation::out,
+ io__state::di, io__state::uo) is det.
+
:- pred globals__io_get_globals(globals::out, io__state::di, io__state::uo)
is det.
@@ -142,9 +155,11 @@
:- pred globals__io_set_trace_level(trace_level::in,
io__state::di, io__state::uo) is det.
-
:- pred globals__io_set_trace_level_none(io__state::di, io__state::uo) is det.
+:- pred globals__io_set_do_aditi_compilation(io__state::di,
+ io__state::uo) is det.
+
:- pred globals__io_lookup_option(option::in, option_data::out,
io__state::di, io__state::uo) is det.
@@ -240,29 +255,33 @@
args_method,
prolog_dialect,
termination_norm,
- trace_level
+ trace_level,
+ aditi_compilation
).
globals__init(Options, GC_Method, TagsMethod, ArgsMethod,
- PrologDialect, TerminationNorm, TraceLevel,
+ PrologDialect, TerminationNorm, TraceLevel, Aditi,
globals(Options, GC_Method, TagsMethod, ArgsMethod,
- PrologDialect, TerminationNorm, TraceLevel)).
+ PrologDialect, TerminationNorm, TraceLevel, Aditi)).
-globals__get_options(globals(Options, _, _, _, _, _, _), Options).
-globals__get_gc_method(globals(_, GC_Method, _, _, _, _, _), GC_Method).
-globals__get_tags_method(globals(_, _, TagsMethod, _, _, _, _), TagsMethod).
-globals__get_args_method(globals(_, _, _, ArgsMethod, _, _, _), ArgsMethod).
-globals__get_prolog_dialect(globals(_, _, _, _, PrologDialect, _, _),
+globals__get_options(globals(Options, _, _, _, _, _, _, _), Options).
+globals__get_gc_method(globals(_, GC_Method, _, _, _, _, _, _), GC_Method).
+globals__get_tags_method(globals(_, _, TagsMethod, _, _, _, _, _), TagsMethod).
+globals__get_args_method(globals(_, _, _, ArgsMethod, _, _, _, _), ArgsMethod).
+globals__get_prolog_dialect(globals(_, _, _, _, PrologDialect, _, _, _),
PrologDialect).
-globals__get_termination_norm(globals(_, _, _, _, _, TerminationNorm, _),
+globals__get_termination_norm(globals(_, _, _, _, _, TerminationNorm, _, _),
TerminationNorm).
-globals__get_trace_level(globals(_, _, _, _, _, _, TraceLevel), TraceLevel).
+globals__get_trace_level(globals(_, _, _, _, _, _, TraceLevel, _), TraceLevel).
+globals__get_do_aditi_compilation(globals(_, _, _, _, _, _, _, Aditi), Aditi).
-globals__set_options(globals(_, B, C, D, E, F, G), Options,
- globals(Options, B, C, D, E, F, G)).
+globals__set_options(globals(_, B, C, D, E, F, G, H), Options,
+ globals(Options, B, C, D, E, F, G, H)).
-globals__set_trace_level(globals(A, B, C, D, E, F, _), TraceLevel,
- globals(A, B, C, D, E, F, TraceLevel)).
+globals__set_trace_level(globals(A, B, C, D, E, F, _, H), TraceLevel,
+ globals(A, B, C, D, E, F, TraceLevel, H)).
+globals__set_do_aditi_compilation(globals(A, B, C, D, E, F, G, _),
+ globals(A, B, C, D, E, F, G, do_aditi_compilation)).
globals__lookup_option(Globals, Option, OptionData) :-
globals__get_options(Globals, OptionTable),
@@ -321,15 +340,17 @@
%-----------------------------------------------------------------------------%
globals__io_init(Options, GC_Method, TagsMethod, ArgsMethod,
- PrologDialect, TerminationNorm, TraceLevel) -->
+ PrologDialect, TerminationNorm, TraceLevel, Aditi) -->
{ copy(GC_Method, GC_Method1) },
{ copy(TagsMethod, TagsMethod1) },
{ copy(ArgsMethod, ArgsMethod1) },
{ copy(PrologDialect, PrologDialect1) },
{ copy(TerminationNorm, TerminationNorm1) },
{ copy(TraceLevel, TraceLevel1) },
+ { copy(Aditi, Aditi1) },
{ globals__init(Options, GC_Method1, TagsMethod1, ArgsMethod1,
- PrologDialect1, TerminationNorm1, TraceLevel1, Globals) },
+ PrologDialect1, TerminationNorm1, TraceLevel1,
+ Aditi1, Globals) },
globals__io_set_globals(Globals).
globals__io_get_gc_method(GC_Method) -->
@@ -356,6 +377,10 @@
globals__io_get_globals(Globals),
{ globals__get_trace_level(Globals, TraceLevel) }.
+globals__io_get_do_aditi_compilation(Aditi) -->
+ globals__io_get_globals(Globals),
+ { globals__get_do_aditi_compilation(Globals, Aditi) }.
+
globals__io_get_globals(Globals) -->
io__get_globals(UnivGlobals),
{
@@ -399,6 +424,14 @@
% anything about type trace_level.
globals__io_set_trace_level_none -->
globals__io_set_trace_level(none).
+
+globals__io_set_do_aditi_compilation -->
+ globals__io_get_globals(Globals0),
+ { globals__set_do_aditi_compilation(Globals0, Globals1) },
+ { unsafe_promise_unique(Globals1, Globals) },
+ % XXX there is a bit of a design flaw with regard to
+ % uniqueness and io__set_globals
+ globals__io_set_globals(Globals).
%-----------------------------------------------------------------------------%
Index: compiler/goal_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/goal_util.m,v
retrieving revision 1.46
diff -u -t -u -r1.46 goal_util.m
--- goal_util.m 1998/06/09 02:12:44 1.46
+++ goal_util.m 1998/06/11 01:04:39
@@ -26,7 +26,8 @@
:- interface.
-:- import_module hlds_goal, hlds_pred, prog_data.
+:- import_module hlds_data, hlds_goal, hlds_module, hlds_pred.
+:- import_module instmap, prog_data.
:- import_module bool, list, set, map, varset, term.
% goal_util__rename_vars_in_goals(GoalList, MustRename, Substitution,
@@ -97,6 +98,7 @@
% Test whether the goal calls the given procedure.
:- pred goal_calls(hlds_goal, pred_proc_id).
:- mode goal_calls(in, in) is semidet.
+:- mode goal_calls(in, out) is nondet.
% Test whether the goal calls the given predicate.
% This is useful before mode analysis when the proc_ids
@@ -104,13 +106,35 @@
:- pred goal_calls_pred_id(hlds_goal, pred_id).
:- mode goal_calls_pred_id(in, in) is semidet.
+ % Convert a switch back into a disjunction. This is needed
+ % for the magic set transformation.
+:- pred goal_util__switch_to_disjunction(var, list(case), instmap,
+ list(hlds_goal), varset, varset, map(var, type),
+ map(var, type), module_info, module_info).
+:- mode goal_util__switch_to_disjunction(in, in, in, out,
+ in, out, in, out, in, out) is det.
+
+:- pred goal_util__case_to_disjunct(var, cons_id, hlds_goal, instmap,
+ hlds_goal, varset, varset, map(var, type), map(var, type),
+ module_info, module_info).
+:- mode goal_util__case_to_disjunct(in, in, in, in, out, in, out,
+ in, out, in, out) is det.
+
+ % Transform an if-then-else into ( Cond, Then ; \+ Cond, Else ),
+ % since magic.m and rl_gen.m don't handle if-then-elses.
+:- pred goal_util__if_then_else_to_disjunction(hlds_goal, hlds_goal,
+ hlds_goal, hlds_goal_info, hlds_goal_expr) is det.
+:- mode goal_util__if_then_else_to_disjunction(in, in, in, in, out) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module hlds_data, mode_util, code_aux, instmap.
-:- import_module int, std_util, assoc_list, require, string.
+:- import_module hlds_data, hlds_module, mode_util, code_aux, prog_data.
+:- import_module det_analysis, instmap, inst_match, type_util, (inst).
+:- import_module code_aux.
+:- import_module int, set, std_util, string, assoc_list, term, require, varset.
%-----------------------------------------------------------------------------%
@@ -607,6 +631,7 @@
:- pred goals_calls(list(hlds_goal), pred_proc_id).
:- mode goals_calls(in, in) is semidet.
+:- mode goals_calls(in, out) is nondet.
goals_calls([Goal | Goals], PredProcId) :-
(
@@ -617,6 +642,7 @@
:- pred cases_calls(list(case), pred_proc_id).
:- mode cases_calls(in, in) is semidet.
+:- mode cases_calls(in, out) is nondet.
cases_calls([case(_, Goal) | Cases], PredProcId) :-
(
@@ -627,6 +653,7 @@
:- pred goal_expr_calls(hlds_goal_expr, pred_proc_id).
:- mode goal_expr_calls(in, in) is semidet.
+:- mode goal_expr_calls(in, out) is nondet.
goal_expr_calls(conj(Goals), PredProcId) :-
goals_calls(Goals, PredProcId).
@@ -695,6 +722,129 @@
goal_expr_calls_pred_id(some(_, Goal), PredId) :-
goal_calls_pred_id(Goal, PredId).
goal_expr_calls_pred_id(call(PredId, _, _, _, _, _), PredId).
+
+%-----------------------------------------------------------------------------%
+
+goal_util__switch_to_disjunction(_, [], _, [], VarSet, VarSet,
+ VarTypes, VarTypes, ModuleInfo, ModuleInfo).
+goal_util__switch_to_disjunction(Var, [case(ConsId, Goal0) | Cases], InstMap,
+ [Goal | Goals], VarSet0, VarSet, VarTypes0, VarTypes,
+ ModuleInfo0, ModuleInfo) :-
+ goal_util__case_to_disjunct(Var, ConsId, Goal0, InstMap, Goal, VarSet0,
+ VarSet1, VarTypes0, VarTypes1, ModuleInfo0, ModuleInfo1),
+ goal_util__switch_to_disjunction(Var, Cases, InstMap, Goals,
+ VarSet1, VarSet, VarTypes1, VarTypes, ModuleInfo1, ModuleInfo).
+
+goal_util__case_to_disjunct(Var, ConsId, CaseGoal, InstMap, Disjunct, VarSet0,
+ VarSet, VarTypes0, VarTypes, ModuleInfo0, ModuleInfo) :-
+ cons_id_arity(ConsId, ConsArity),
+ varset__new_vars(VarSet0, ConsArity, ArgVars, VarSet),
+ map__lookup(VarTypes0, Var, VarType),
+ type_util__get_cons_id_arg_types(ModuleInfo0,
+ VarType, ConsId, ArgTypes),
+ map__det_insert_from_corresponding_lists(VarTypes0, ArgVars,
+ ArgTypes, VarTypes),
+ instmap__lookup_var(InstMap, Var, Inst0),
+ (
+ inst_expand(ModuleInfo, Inst0, Inst1),
+ get_arg_insts(Inst1, ConsId, ConsArity, ArgInsts1)
+ ->
+ ArgInsts = ArgInsts1
+ ;
+ error("goal_util__case_to_disjunct - get_arg_insts failed")
+ ),
+ InstToUniMode =
+ lambda([ArgInst::in, ArgUniMode::out] is det, (
+ ArgUniMode = ((ArgInst - free) -> (ArgInst - ArgInst))
+ )),
+ list__map(InstToUniMode, ArgInsts, UniModes),
+ UniMode = (Inst0 -> Inst0) - (Inst0 -> Inst0),
+ UnifyContext = unify_context(explicit, []),
+ Unification = deconstruct(Var, ConsId, ArgVars, UniModes, can_fail),
+ ExtraGoal = unify(Var, functor(ConsId, ArgVars),
+ UniMode, Unification, UnifyContext),
+ set__singleton_set(NonLocals, Var),
+ instmap_delta_init_reachable(ExtraInstMapDelta0),
+ instmap_delta_bind_var_to_functor(Var, ConsId, InstMap,
+ ExtraInstMapDelta0, ExtraInstMapDelta,
+ ModuleInfo0, ModuleInfo),
+ goal_info_init(NonLocals, ExtraInstMapDelta, semidet, ExtraGoalInfo),
+
+ % Conjoin the test and the rest of the case.
+ goal_to_conj_list(CaseGoal, CaseGoalConj),
+ GoalList = [ExtraGoal - ExtraGoalInfo | CaseGoalConj],
+
+ % Work out the nonlocals, instmap_delta and determinism
+ % of the entire conjunction.
+ CaseGoal = _ - CaseGoalInfo,
+ goal_info_get_nonlocals(CaseGoalInfo, CaseNonLocals0),
+ set__insert(CaseNonLocals0, Var, CaseNonLocals),
+ goal_info_get_instmap_delta(CaseGoalInfo, CaseInstMapDelta),
+ instmap_delta_apply_instmap_delta(ExtraInstMapDelta,
+ CaseInstMapDelta, InstMapDelta),
+ goal_info_get_determinism(CaseGoalInfo, CaseDetism0),
+ det_conjunction_detism(semidet, CaseDetism0, Detism),
+ goal_info_init(CaseNonLocals, InstMapDelta, Detism, CombinedGoalInfo),
+ Disjunct = conj(GoalList) - CombinedGoalInfo.
+
+%-----------------------------------------------------------------------------%
+
+goal_util__if_then_else_to_disjunction(Cond, Then, Else, GoalInfo, Goal) :-
+ goal_util__compute_disjunct_goal_info(Cond, Then,
+ GoalInfo, CondThenInfo),
+ conj_list_to_goal([Cond, Then], CondThenInfo, CondThen),
+
+ Cond = _ - CondInfo,
+ goal_info_get_determinism(CondInfo, CondDetism),
+ det_negation_det(CondDetism, MaybeNegCondDet),
+ ( MaybeNegCondDet = yes(NegCondDet1) ->
+ NegCondDet = NegCondDet1
+ ;
+ error("goal_util__if_then_else_to_disjunction: inappropriate determinism in a negation.")
+ ),
+ determinism_components(NegCondDet, _, NegCondMaxSoln),
+ ( NegCondMaxSoln = at_most_zero ->
+ instmap_delta_init_unreachable(NegCondDelta)
+ ;
+ instmap_delta_init_reachable(NegCondDelta)
+ ),
+ goal_info_get_nonlocals(CondInfo, CondNonLocals),
+ goal_info_init(CondNonLocals, NegCondDelta, NegCondDet, NegCondInfo),
+
+ goal_util__compute_disjunct_goal_info(not(Cond) - NegCondInfo, Else,
+ GoalInfo, NegCondElseInfo),
+ conj_list_to_goal([not(Cond) - NegCondInfo, Else],
+ NegCondElseInfo, NegCondElse),
+
+ map__init(SM),
+ Goal = disj([CondThen, NegCondElse], SM).
+
+
+ % Compute a hlds_goal_info for a pair of conjoined goals.
+:- pred goal_util__compute_disjunct_goal_info(hlds_goal::in, hlds_goal::in,
+ hlds_goal_info::in, hlds_goal_info::out) is det.
+
+goal_util__compute_disjunct_goal_info(Goal1, Goal2, GoalInfo, CombinedInfo) :-
+ Goal1 = _ - GoalInfo1,
+ Goal2 = _ - GoalInfo2,
+
+ goal_info_get_nonlocals(GoalInfo1, NonLocals1),
+ goal_info_get_nonlocals(GoalInfo2, NonLocals2),
+ goal_info_get_nonlocals(GoalInfo, OuterNonLocals),
+ set__union(NonLocals1, NonLocals2, CombinedNonLocals0),
+ set__intersect(CombinedNonLocals0, OuterNonLocals, CombinedNonLocals),
+
+ goal_info_get_instmap_delta(GoalInfo1, Delta1),
+ goal_info_get_instmap_delta(GoalInfo2, Delta2),
+ instmap_delta_apply_instmap_delta(Delta1, Delta2, CombinedDelta0),
+ instmap_delta_restrict(CombinedDelta0, OuterNonLocals, CombinedDelta),
+
+ goal_info_get_determinism(GoalInfo1, Detism1),
+ goal_info_get_determinism(GoalInfo2, Detism2),
+ det_conjunction_detism(Detism1, Detism2, CombinedDetism),
+
+ goal_info_init(CombinedNonLocals, CombinedDelta,
+ CombinedDetism, CombinedInfo).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/handle_options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/handle_options.m,v
retrieving revision 1.58
diff -u -t -u -r1.58 handle_options.m
--- handle_options.m 1998/07/01 06:08:24 1.58
+++ handle_options.m 1998/07/07 01:14:13
@@ -83,11 +83,13 @@
globals__io_lookup_bool_option(errorcheck_only, ErrorcheckOnly),
globals__io_lookup_bool_option(compile_to_c, CompileToC),
globals__io_lookup_bool_option(compile_only, CompileOnly),
+ globals__io_lookup_bool_option(aditi_only, AditiOnly),
{ bool__or_list([GenerateDependencies, MakeInterface,
MakePrivateInterface, MakeShortInterface,
MakeOptimizationInt, MakeTransOptInt,
ConvertToMercury, ConvertToGoedel, TypecheckOnly,
- ErrorcheckOnly, CompileToC, CompileOnly], NotLink) },
+ ErrorcheckOnly, CompileToC, CompileOnly, AditiOnly],
+ NotLink) },
{ bool__not(NotLink, Link) }
).
@@ -197,7 +199,7 @@
{ unsafe_promise_unique(OptionTable, OptionTable1) }, % XXX
globals__io_init(OptionTable1, GC_Method, TagsMethod, ArgsMethod,
- PrologDialect, TermNorm, TraceLevel),
+ PrologDialect, TermNorm, TraceLevel, no_aditi_compilation),
% --gc conservative implies --no-reclaim-heap-*
( { GC_Method = conservative } ->
@@ -397,6 +399,22 @@
% is only available while generating the dependencies.
option_implies(generate_module_order, generate_dependencies,
bool(yes)),
+
+ % --aditi-only implies --aditi.
+ option_implies(aditi_only, aditi, bool(yes)),
+
+ % Set --aditi-user to the value of $USER if it is not set already.
+ globals__io_lookup_string_option(aditi_user, User0),
+ ( { User0 = "" } ->
+ io__get_environment_var("USER", MaybeUser),
+ ( { MaybeUser = yes(User) } ->
+ globals__io_set_option(aditi_user, string(User))
+ ;
+ []
+ )
+ ;
+ []
+ ),
% If --use-search-directories-for-intermod is true, append the
% search directories to the list of directories to search for
Index: compiler/higher_order.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/higher_order.m,v
retrieving revision 1.44
diff -u -t -u -r1.44 higher_order.m
--- higher_order.m 1998/06/09 02:12:50 1.44
+++ higher_order.m 1998/06/11 01:04:41
@@ -844,6 +844,7 @@
% context will need to be updated.
% cf. remove_listof_higher_order_args.
pred_info_get_class_context(PredInfo0, ClassContext),
+ pred_info_get_aditi_owner(PredInfo0, Owner),
Name = qualified(PredModule, PredName),
varset__init(EmptyVarSet),
map__init(EmptyVarTypes),
@@ -855,7 +856,7 @@
EmptyVarTypes, [], []),
pred_info_init(PredModule, Name, Arity, Tvars,
Types, true, Context, ClausesInfo, local, MarkerList, GoalType,
- PredOrFunc, ClassContext, EmptyProofs, PredInfo1),
+ PredOrFunc, ClassContext, EmptyProofs, Owner, PredInfo1),
pred_info_set_typevarset(PredInfo1, TypeVars, PredInfo2),
pred_info_procedures(PredInfo2, Procs0),
next_mode_id(Procs0, no, NewProcId),
More information about the developers
mailing list