[m-rev.] diff: hlds_module.m cleanup
Zoltan Somogyi
zs at cs.mu.OZ.AU
Fri Oct 31 14:26:59 AEDT 2003
This diff makes hlds_module.m and many callers of its predicates easier to read
and to maintain, but contains no changes in algorithms whatsoever.
compiler/hlds_module.m:
Bring (most of) this module into line with our current coding
standards. Use predmode declarations, functions, and state variable
syntax when appropriate. (The 'most of' is because I left the part of
the module dealing with predicate tables alone, not wishing to cause
a conflict for Pete.)
Reorder arguments of predicates where necessary for the use of state
variable syntax, and where this improves readability.
Replace old-style lambdas with new-style lambdas or with partially
applied named procedures.
compiler/*.m:
Conform to the changes in hlds_module.m. This mostly means using the
new argument orders of predicates exported by hlds_module.m, and
switching to state variable notation.
Replace old-style lambdas with new-style lambdas or with partially
applied named procedures in updated code.
Replace unnecessary occurrences of four-space indentation with
standard indentation in updated code.
library/list.m:
library/map.m:
library/tree234.m:
Add list__foldl4 and map__foldl3, since in some compiler modules,
state variable notation is more convenient (and the code more
efficient) if we don't have to bundle up several data structures
into a tuple just to iterate over them.
Change the fold predicates to use state variable notation.
NEWS:
Mention the new library functions.
Zoltan.
cvs diff: Diffing .
Index: NEWS
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/NEWS,v
retrieving revision 1.319
diff -u -b -r1.319 NEWS
--- NEWS 25 Sep 2003 07:56:24 -0000 1.319
+++ NEWS 31 Oct 2003 02:25:41 -0000
@@ -151,9 +151,11 @@
* We've added a new library module, `array2d'.
-* We've added a new predicate, list__map2_foldl, to list.m.
+* We've added some new predicates, list__map2_foldl and list__foldl4,
+ to list.m.
-* We've added a new predicate, map__common_subset, to map.m.
+* We've added some new predicates, map__common_subset and map__foldl3,
+ to map.m.
* We've added a predicate, map_fold, to set.m.
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/accumulator.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/accumulator.m,v
retrieving revision 1.23
diff -u -b -r1.23 accumulator.m
--- compiler/accumulator.m 24 Oct 2003 06:17:34 -0000 1.23
+++ compiler/accumulator.m 27 Oct 2003 16:49:19 -0000
@@ -1555,7 +1555,7 @@
module_info_get_predicate_table(ModuleInfo0, PredTable0),
predicate_table_insert(PredTable0, AccPredInfo, AccPredId, PredTable),
- module_info_set_predicate_table(ModuleInfo0, PredTable, ModuleInfo1),
+ module_info_set_predicate_table(PredTable, ModuleInfo0, ModuleInfo1),
create_goal(RecCallId, Accs, AccPredId, AccProcId, AccName, Substs,
HeadToCallSubst, CallToHeadSubst, BaseCase,
@@ -1973,14 +1973,13 @@
:- pred update_accumulator_pred(pred_id::in, proc_id::in,
hlds_goal::in, module_info::in, module_info::out) is det.
-update_accumulator_pred(NewPredId, NewProcId, AccGoal,
- ModuleInfo0, ModuleInfo) :-
- module_info_pred_proc_info(ModuleInfo0, NewPredId, NewProcId,
+update_accumulator_pred(NewPredId, NewProcId, AccGoal, !ModuleInfo) :-
+ module_info_pred_proc_info(!.ModuleInfo, NewPredId, NewProcId,
PredInfo, ProcInfo0),
proc_info_set_goal(AccGoal, ProcInfo0, ProcInfo1),
requantify_proc(ProcInfo1, ProcInfo),
- module_info_set_pred_proc_info(ModuleInfo0, NewPredId, NewProcId,
- PredInfo, ProcInfo, ModuleInfo).
+ module_info_set_pred_proc_info(NewPredId, NewProcId,
+ PredInfo, ProcInfo, !ModuleInfo).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/aditi_builtin_ops.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/aditi_builtin_ops.m,v
retrieving revision 1.6
diff -u -b -r1.6 aditi_builtin_ops.m
--- compiler/aditi_builtin_ops.m 24 Oct 2003 06:17:34 -0000 1.6
+++ compiler/aditi_builtin_ops.m 27 Oct 2003 16:49:57 -0000
@@ -257,8 +257,8 @@
->
{ pred_info_set_import_status(exported,
CalleePredInfo0, CalleePredInfo) },
- { module_info_set_pred_info(ModuleInfo1, PredId,
- CalleePredInfo, ModuleInfo) },
+ { module_info_set_pred_info(PredId, CalleePredInfo,
+ ModuleInfo1, ModuleInfo) },
^ module_info := ModuleInfo
;
{ CalleePredInfo = CalleePredInfo0 }
@@ -449,8 +449,8 @@
requantify_proc(ProcInfo2, ProcInfo3),
recompute_instmap_delta_proc(yes, ProcInfo3, ProcInfo,
ModuleInfo1, ModuleInfo2),
- module_info_set_pred_proc_info(ModuleInfo2,
- PredProcId, PredInfo, ProcInfo, ModuleInfo).
+ module_info_set_pred_proc_info(PredProcId, PredInfo, ProcInfo,
+ ModuleInfo2, ModuleInfo).
%
% Produce the call
@@ -718,7 +718,7 @@
ProcInfo = Info ^ proc_info,
PredInfo = Info ^ pred_info,
Changed = Info ^ changed,
- module_info_set_pred_info(ModuleInfo0, PredId, PredInfo, ModuleInfo).
+ module_info_set_pred_info(PredId, PredInfo, ModuleInfo0, ModuleInfo).
:- type aditi_transform_info
---> aditi_transform_info(
Index: compiler/arg_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/arg_info.m,v
retrieving revision 1.40
diff -u -b -r1.40 arg_info.m
--- compiler/arg_info.m 24 Oct 2003 06:17:34 -0000 1.40
+++ compiler/arg_info.m 27 Oct 2003 16:50:11 -0000
@@ -146,7 +146,7 @@
map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
map__det_update(PredTable0, PredId, PredInfo, PredTable),
- module_info_set_preds(!.ModuleInfo, PredTable, !:ModuleInfo)
+ module_info_set_preds(PredTable, !ModuleInfo)
),
generate_proc_list_arg_info(PredId, ProcIds, !ModuleInfo).
Index: compiler/assertion.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/assertion.m,v
retrieving revision 1.24
diff -u -b -r1.24 assertion.m
--- compiler/assertion.m 24 Oct 2003 06:17:34 -0000 1.24
+++ compiler/assertion.m 27 Oct 2003 16:50:22 -0000
@@ -665,7 +665,7 @@
pred_info_get_assertions(PredInfo0, Assertions0),
set__insert(Assertions0, AssertId, Assertions),
pred_info_set_assertions(Assertions, PredInfo0, PredInfo),
- module_info_set_pred_info(!.Module, PredId, PredInfo, !:Module).
+ module_info_set_pred_info(PredId, PredInfo, !Module).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.49
diff -u -b -r1.49 check_typeclass.m
--- compiler/check_typeclass.m 24 Oct 2003 06:17:35 -0000 1.49
+++ compiler/check_typeclass.m 30 Oct 2003 03:42:20 -0000
@@ -97,8 +97,8 @@
Errors = []
->
map__from_assoc_list(InstanceList, InstanceTable),
- module_info_set_instances(ModuleInfo1, InstanceTable,
- ModuleInfo),
+ module_info_set_instances(InstanceTable,
+ ModuleInfo1, ModuleInfo),
IO = IO1,
FoundError = no
;
@@ -423,7 +423,7 @@
pred_info_arg_types(PredInfo, ArgTypeVars, ExistQVars, ArgTypes),
pred_info_get_class_context(PredInfo, ClassContext0),
pred_info_get_markers(PredInfo, Markers0),
- remove_marker(Markers0, class_method, Markers),
+ remove_marker(class_method, Markers0, Markers),
% The first constraint in the class context of a class method
% is always the constraint for the class of which it is
% a member. Seeing that we are checking an instance
@@ -725,14 +725,14 @@
% given in the instance declaration.
Cond = true,
map__init(Proofs),
- add_marker(Markers0, class_instance_method, Markers1),
+ add_marker(class_instance_method, Markers0, Markers1),
( InstancePredDefn = name(_) ->
% For instance methods which are defined using the named
% syntax (e.g. "pred(...) is ...") rather than the clauses
% syntax, we record an additional marker; the only effect
% of this marker is that we output slightly different
% error messages for such predicates.
- add_marker(Markers1, named_class_instance_method, Markers)
+ add_marker(named_class_instance_method, Markers1, Markers)
;
Markers = Markers1
),
@@ -783,8 +783,8 @@
% rather than passing must_be_qualified or calling the /4 version?
predicate_table_insert(PredicateTable1, PredInfo,
may_be_unqualified, PQInfo, PredId, PredicateTable),
- module_info_set_predicate_table(ModuleInfo1, PredicateTable,
- ModuleInfo),
+ module_info_set_predicate_table(PredicateTable,
+ ModuleInfo1, ModuleInfo),
Info = instance_method_info(ModuleInfo, QualInfo, PredName, Arity,
ExistQVars, ArgTypes, ClassContext, ArgModes, Errors,
Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.37
diff -u -b -r1.37 clause_to_proc.m
--- compiler/clause_to_proc.m 24 Oct 2003 06:17:35 -0000 1.37
+++ compiler/clause_to_proc.m 27 Oct 2003 16:50:59 -0000
@@ -106,10 +106,10 @@
MaybeProcId = no
).
-copy_module_clauses_to_procs(PredIds, ModuleInfo0, ModuleInfo) :-
- module_info_preds(ModuleInfo0, Preds0),
+copy_module_clauses_to_procs(PredIds, !ModuleInfo) :-
+ module_info_preds(!.ModuleInfo, Preds0),
copy_module_clauses_to_procs_2(PredIds, Preds0, Preds),
- module_info_set_preds(ModuleInfo0, Preds, ModuleInfo).
+ module_info_set_preds(Preds, !ModuleInfo).
:- pred copy_module_clauses_to_procs_2(list(pred_id), pred_table, pred_table).
:- mode copy_module_clauses_to_procs_2(in, in, out) is det.
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.117
diff -u -b -r1.117 code_gen.m
--- compiler/code_gen.m 27 Oct 2003 05:42:35 -0000 1.117
+++ compiler/code_gen.m 27 Oct 2003 16:51:21 -0000
@@ -184,8 +184,8 @@
% modules, we must switch off the tracing
% of such preds on a pred-by-pred basis.
globals__set_trace_level_none(Globals0, Globals1),
- module_info_set_globals(ModuleInfo0, Globals1,
- ModuleInfo1),
+ module_info_set_globals(Globals1,
+ ModuleInfo0, ModuleInfo1),
generate_pred_code(ModuleInfo1, !GlobalData,
PredId, PredInfo, ProcIds, Predicates)
;
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/cse_detection.m,v
retrieving revision 1.76
diff -u -b -r1.76 cse_detection.m
--- compiler/cse_detection.m 24 Oct 2003 06:17:35 -0000 1.76
+++ compiler/cse_detection.m 27 Oct 2003 16:51:30 -0000
@@ -191,7 +191,7 @@
map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
map__det_update(PredTable0, PredId, PredInfo, PredTable),
- module_info_set_preds(ModuleInfo0, PredTable, ModuleInfo)
+ module_info_set_preds(PredTable, ModuleInfo0, ModuleInfo)
).
%-----------------------------------------------------------------------------%
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.83
diff -u -b -r1.83 dead_proc_elim.m
--- compiler/dead_proc_elim.m 24 Oct 2003 06:17:36 -0000 1.83
+++ compiler/dead_proc_elim.m 30 Oct 2003 03:51:54 -0000
@@ -104,10 +104,9 @@
:- type entity_queue == queue(entity).
:- type examined_set == set(entity).
-dead_proc_elim(Pass, ModuleInfo0, ModuleInfo, State0, State) :-
- dead_proc_elim__analyze(ModuleInfo0, Needed),
- dead_proc_elim__eliminate(Pass, ModuleInfo0, Needed, ModuleInfo,
- State0, State).
+dead_proc_elim(Pass, !ModuleInfo, !IO) :-
+ dead_proc_elim__analyze(!.ModuleInfo, Needed),
+ dead_proc_elim__eliminate(Pass, Needed, !ModuleInfo, !IO).
%-----------------------------------------------------------------------------%
@@ -525,7 +524,6 @@
%-----------------------------------------------------------------------------%
-
% information used during the elimination phase.
:- type elim_info
@@ -540,37 +538,34 @@
% Given the information about which entities are needed,
% eliminate procedures which are not needed.
-:- pred dead_proc_elim__eliminate(dead_proc_pass, module_info, needed_map,
- module_info, io__state, io__state).
-:- mode dead_proc_elim__eliminate(in, in, in, out, di, uo) is det.
-
-dead_proc_elim__eliminate(Pass, ModuleInfo0, Needed0, ModuleInfo,
- State0, State) :-
- module_info_predids(ModuleInfo0, PredIds),
- module_info_preds(ModuleInfo0, PredTable0),
+:- pred dead_proc_elim__eliminate(dead_proc_pass::in, needed_map::in,
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
+
+dead_proc_elim__eliminate(Pass, Needed0, !ModuleInfo, !IO) :-
+ module_info_predids(!.ModuleInfo, PredIds),
+ module_info_preds(!.ModuleInfo, PredTable0),
Changed0 = no,
- ElimInfo0 = elimination_info(Needed0, ModuleInfo0,
- PredTable0, Changed0),
- list__foldl2(dead_proc_elim__eliminate_pred(Pass), PredIds, ElimInfo0,
- ElimInfo, State0, State),
- ElimInfo = elimination_info(Needed, ModuleInfo1, PredTable, Changed),
+ ElimInfo0 = elimination_info(Needed0, !.ModuleInfo, PredTable0,
+ Changed0),
+ list__foldl2(dead_proc_elim__eliminate_pred(Pass), PredIds,
+ ElimInfo0, ElimInfo, !IO),
+ ElimInfo = elimination_info(Needed, !:ModuleInfo, PredTable, Changed),
- module_info_set_preds(ModuleInfo1, PredTable, ModuleInfo2),
- module_info_type_ctor_gen_infos(ModuleInfo2, TypeCtorGenInfos0),
+ module_info_set_preds(PredTable, !ModuleInfo),
+ module_info_type_ctor_gen_infos(!.ModuleInfo, TypeCtorGenInfos0),
dead_proc_elim__eliminate_base_gen_infos(TypeCtorGenInfos0, Needed,
TypeCtorGenInfos),
- module_info_set_type_ctor_gen_infos(ModuleInfo2, TypeCtorGenInfos,
- ModuleInfo3),
+ module_info_set_type_ctor_gen_infos(TypeCtorGenInfos, !ModuleInfo),
(
Changed = yes,
% The dependency graph will still contain references to the
% eliminated procedures, so it must be rebuilt if it will
% be used later.
- module_info_clobber_dependency_info(ModuleInfo3, ModuleInfo)
+ module_info_clobber_dependency_info(!ModuleInfo)
;
- Changed = no,
- ModuleInfo = ModuleInfo3
+ Changed = no
).
% eliminate any unused procedures for this pred
@@ -579,8 +574,7 @@
elim_info, elim_info, io__state, io__state).
:- mode dead_proc_elim__eliminate_pred(in, in, in, out, di, uo) is det.
-dead_proc_elim__eliminate_pred(Pass, PredId, ElimInfo0, ElimInfo,
- State0, State) :-
+dead_proc_elim__eliminate_pred(Pass, PredId, ElimInfo0, ElimInfo, !IO) :-
ElimInfo0 = elimination_info(Needed, ModuleInfo, PredTable0, Changed0),
map__lookup(PredTable0, PredId, PredInfo0),
pred_info_import_status(PredInfo0, Status),
@@ -628,7 +622,7 @@
list__foldl2(dead_proc_elim__eliminate_proc(Pass, PredId,
Keep, WarnForThisProc, ElimInfo0),
ProcIds, Changed0 - ProcTable0, Changed - ProcTable,
- State0, State),
+ !IO),
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
map__det_update(PredTable0, PredId, PredInfo, PredTable)
;
@@ -661,23 +655,22 @@
PredInfo1, PredInfo),
map__det_update(PredTable0, PredId, PredInfo, PredTable),
globals__io_lookup_bool_option(very_verbose, VeryVerbose,
- State0, State1),
- ( VeryVerbose = yes ->
+ !IO),
+ (
+ VeryVerbose = yes,
write_pred_progress_message(
"% Eliminated opt_imported predicate ",
- PredId, ModuleInfo, State1, State)
+ PredId, ModuleInfo, !IO)
;
- State = State1
+ VeryVerbose = no
)
;
% This predicate is not defined in this module.
- State = State0,
PredTable = PredTable0,
Changed = Changed0
),
ElimInfo = elimination_info(Needed, ModuleInfo, PredTable, Changed).
-
% eliminate a procedure, if unused
:- pred dead_proc_elim__eliminate_proc(dead_proc_pass, pred_id, maybe(proc_id),
@@ -768,11 +761,10 @@
set(sym_name) % pred names needed.
).
-dead_pred_elim(ModuleInfo0, ModuleInfo) :-
-
+dead_pred_elim(!ModuleInfo) :-
queue__init(Queue0),
map__init(Needed0),
- module_info_get_pragma_exported_procs(ModuleInfo0, PragmaExports),
+ module_info_get_pragma_exported_procs(!.ModuleInfo, PragmaExports),
dead_proc_elim__initialize_pragma_exports(PragmaExports,
Queue0, _, Needed0, Needed1),
%
@@ -780,8 +772,8 @@
% examined because they contain calls to the actual method
% implementations.
%
- module_info_instances(ModuleInfo0, Instances),
- module_info_classes(ModuleInfo0, Classes),
+ module_info_instances(!.ModuleInfo, Instances),
+ module_info_classes(!.ModuleInfo, Classes),
dead_proc_elim__initialize_class_methods(Classes, Instances,
Queue0, _, Needed1, Needed),
map__keys(Needed, Entities),
@@ -792,21 +784,20 @@
set__init(Preds0),
set__init(Names0),
- DeadInfo0 = dead_pred_info(ModuleInfo0, Queue,
+ DeadInfo0 = dead_pred_info(!.ModuleInfo, Queue,
Preds0, NeededPreds1, Names0),
- module_info_predids(ModuleInfo0, PredIds),
- list__foldl(dead_pred_elim_initialize, PredIds,
- DeadInfo0, DeadInfo1),
+ module_info_predids(!.ModuleInfo, PredIds),
+ list__foldl(dead_pred_elim_initialize, PredIds, DeadInfo0, DeadInfo1),
dead_pred_elim_analyze(DeadInfo1, DeadInfo),
- DeadInfo = dead_pred_info(ModuleInfo1, _, _, NeededPreds2, _),
+ DeadInfo = dead_pred_info(!:ModuleInfo, _, _, NeededPreds2, _),
%
% If a predicate is not needed, predicates which were added in
% make_hlds.m to force type specialization are also not needed.
% Here we add in those which are needed.
%
- module_info_type_spec_info(ModuleInfo1,
+ module_info_type_spec_info(!.ModuleInfo,
type_spec_info(TypeSpecProcs0, TypeSpecForcePreds0,
SpecMap0, PragmaMap0)),
set__to_sorted_list(NeededPreds2, NeededPredList2),
@@ -820,17 +811,16 @@
)), NeededPredList2, NeededPreds2, NeededPreds),
set__intersect(TypeSpecForcePreds0, NeededPreds, TypeSpecForcePreds),
- module_info_set_type_spec_info(ModuleInfo1,
+ module_info_set_type_spec_info(
type_spec_info(TypeSpecProcs0, TypeSpecForcePreds,
SpecMap0, PragmaMap0),
- ModuleInfo2),
+ !ModuleInfo),
- module_info_get_predicate_table(ModuleInfo2, PredTable0),
- module_info_get_partial_qualifier_info(ModuleInfo2, PartialQualInfo),
+ module_info_get_predicate_table(!.ModuleInfo, PredTable0),
+ module_info_get_partial_qualifier_info(!.ModuleInfo, PartialQualInfo),
predicate_table_restrict(PartialQualInfo, PredTable0,
set__to_sorted_list(NeededPreds), PredTable),
- module_info_set_predicate_table(ModuleInfo2, PredTable, ModuleInfo).
-
+ module_info_set_predicate_table(PredTable, !ModuleInfo).
:- pred dead_pred_elim_add_entity(entity::in, queue(pred_id)::in,
queue(pred_id)::out, set(pred_id)::in, set(pred_id)::out) is det.
Index: compiler/deep_profiling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deep_profiling.m,v
retrieving revision 1.20
diff -u -b -r1.20 deep_profiling.m
--- compiler/deep_profiling.m 24 Oct 2003 06:17:36 -0000 1.20
+++ compiler/deep_profiling.m 30 Oct 2003 04:47:33 -0000
@@ -49,31 +49,29 @@
:- import_module bool, int, list, assoc_list, map, require, set.
:- import_module std_util, string, term, varset, counter.
-apply_deep_profiling_transformation(ModuleInfo0, ModuleInfo, ProcStatics) -->
- { module_info_globals(ModuleInfo0, Globals) },
- { globals__lookup_bool_option(Globals, deep_profile_tail_recursion,
- TailRecursion) },
+apply_deep_profiling_transformation(!ModuleInfo, ProcStatics, !IO) :-
+ module_info_globals(!.ModuleInfo, Globals),
+ globals__lookup_bool_option(Globals, deep_profile_tail_recursion,
+ TailRecursion),
(
- { TailRecursion = yes },
- { apply_tail_recursion_transformation(ModuleInfo0,
- ModuleInfo1) }
+ TailRecursion = yes,
+ apply_tail_recursion_transformation(!ModuleInfo)
;
- { TailRecursion = no },
- { ModuleInfo1 = ModuleInfo0 }
+ TailRecursion = no
),
- { module_info_predids(ModuleInfo1, PredIds) },
- { module_info_get_predicate_table(ModuleInfo1, PredTable0) },
- { predicate_table_get_preds(PredTable0, PredMap0) },
- { list__foldl2(transform_predicate(ModuleInfo1),
- PredIds, PredMap0, PredMap, [], MaybeProcStatics) },
+ module_info_predids(!.ModuleInfo, PredIds),
+ module_info_get_predicate_table(!.ModuleInfo, PredTable0),
+ predicate_table_get_preds(PredTable0, PredMap0),
+ list__foldl2(transform_predicate(!.ModuleInfo),
+ PredIds, PredMap0, PredMap, [], MaybeProcStatics),
% Remove any duplicates that resulted from
% references in inner tail recursive procedures
- { list__filter_map(
+ list__filter_map(
(pred(MaybeProcStatic::in, ProcStatic::out) is semidet :-
MaybeProcStatic = yes(ProcStatic)
- ), MaybeProcStatics, ProcStatics) },
- { predicate_table_set_preds(PredTable0, PredMap, PredTable) },
- { module_info_set_predicate_table(ModuleInfo1, PredTable, ModuleInfo) }.
+ ), MaybeProcStatics, ProcStatics),
+ predicate_table_set_preds(PredTable0, PredMap, PredTable),
+ module_info_set_predicate_table(PredTable, !ModuleInfo).
%-----------------------------------------------------------------------------%
@@ -141,7 +139,7 @@
ProcTable),
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
map__det_update(PredTable0, PredId, PredInfo, PredTable),
- module_info_set_preds(ModuleInfo0, PredTable, ModuleInfo)
+ module_info_set_preds(PredTable, ModuleInfo0, ModuleInfo)
;
ModuleInfo = ModuleInfo0
).
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.31
diff -u -b -r1.31 deforest.m
--- compiler/deforest.m 24 Oct 2003 06:17:36 -0000 1.31
+++ compiler/deforest.m 27 Oct 2003 17:01:31 -0000
@@ -155,8 +155,8 @@
;
proc_info_set_inferred_determinism(erroneous,
ProcInfo0, ProcInfo),
- module_info_set_pred_proc_info(!.ModuleInfo, PredProcId,
- PredInfo, ProcInfo, !:ModuleInfo)
+ module_info_set_pred_proc_info(PredProcId, PredInfo, ProcInfo,
+ !ModuleInfo)
).
:- pred proc_arg_info_init(map(pred_proc_id, pd_proc_arg_info)::out) is det.
@@ -229,8 +229,8 @@
pd_info_get_pred_info(PredInfo),
{ proc_info_set_goal(Goal, ProcInfo3, ProcInfo) },
- { module_info_set_pred_proc_info(ModuleInfo3, PredId, ProcId,
- PredInfo, ProcInfo, ModuleInfo4) },
+ { module_info_set_pred_proc_info(PredId, ProcId,
+ PredInfo, ProcInfo, ModuleInfo3, ModuleInfo4) },
pd_info_get_rerun_det(RerunDet),
@@ -254,8 +254,8 @@
;
pd_info_get_module_info(ModuleInfo2),
pd_info_get_pred_info(PredInfo),
- { module_info_set_pred_proc_info(ModuleInfo2, PredId, ProcId,
- PredInfo, ProcInfo2, ModuleInfo3) },
+ { module_info_set_pred_proc_info(PredId, ProcId,
+ PredInfo, ProcInfo2, ModuleInfo2, ModuleInfo3) },
pd_info_set_module_info(ModuleInfo3)
),
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.64
diff -u -b -r1.64 dependency_graph.m
--- compiler/dependency_graph.m 24 Oct 2003 06:17:36 -0000 1.64
+++ compiler/dependency_graph.m 27 Oct 2003 17:03:07 -0000
@@ -124,15 +124,14 @@
% Ensure that the dependency graph has been built by building
% it if necessary.
-module_info_ensure_dependency_info(ModuleInfo0, ModuleInfo) :-
- module_info_get_maybe_dependency_info(ModuleInfo0, MaybeDepInfo),
+module_info_ensure_dependency_info(!ModuleInfo) :-
+ module_info_get_maybe_dependency_info(!.ModuleInfo, MaybeDepInfo),
( MaybeDepInfo = yes(_) ->
- ModuleInfo = ModuleInfo0
+ true
;
- dependency_graph__build_dependency_graph(ModuleInfo0, no,
+ dependency_graph__build_dependency_graph(!.ModuleInfo, no,
DepInfo),
- module_info_set_dependency_info(ModuleInfo0, DepInfo,
- ModuleInfo)
+ module_info_set_dependency_info(DepInfo, !ModuleInfo)
).
% Traverse the module structure, calling `dependency_graph__add_arcs'
@@ -153,10 +152,10 @@
dependency_graph__add_arcs(PredIds, ModuleInfo, Imported,
DepGraph1, DepGraph),
hlds_dependency_info_init(DepInfo0),
- hlds_dependency_info_set_dependency_graph(DepInfo0, DepGraph, DepInfo1),
+ hlds_dependency_info_set_dependency_graph(DepGraph, DepInfo0, DepInfo1),
relation__atsort(DepGraph, DepOrd0),
dependency_graph__sets_to_lists(DepOrd0, [], DepOrd),
- hlds_dependency_info_set_dependency_ordering(DepInfo1, DepOrd, DepInfo).
+ hlds_dependency_info_set_dependency_ordering(DepOrd, DepInfo1, DepInfo).
:- pred dependency_graph__sets_to_lists(list(set(T)), list(list(T)),
list(list(T))).
@@ -704,24 +703,23 @@
%-----------------------------------------------------------------------------%
-module_info_ensure_aditi_dependency_info(ModuleInfo0, ModuleInfo) :-
- module_info_ensure_dependency_info(ModuleInfo0, ModuleInfo1),
- module_info_dependency_info(ModuleInfo1, DepInfo0),
+module_info_ensure_aditi_dependency_info(!ModuleInfo) :-
+ module_info_ensure_dependency_info(!ModuleInfo),
+ module_info_dependency_info(!.ModuleInfo, DepInfo0),
hlds_dependency_info_get_maybe_aditi_dependency_ordering(DepInfo0,
MaybeAditiInfo),
( MaybeAditiInfo = yes(_) ->
- ModuleInfo = ModuleInfo1
+ true
;
hlds_dependency_info_get_dependency_ordering(DepInfo0,
DepOrdering),
- aditi_scc_info_init(ModuleInfo1, AditiInfo0),
+ aditi_scc_info_init(!.ModuleInfo, 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)
+ hlds_dependency_info_set_aditi_dependency_ordering(
+ AditiOrdering, DepInfo0, DepInfo),
+ module_info_set_dependency_info(DepInfo, !ModuleInfo)
).
:- pred dependency_graph__build_aditi_scc_info(dependency_ordering::in,
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_analysis.m,v
retrieving revision 1.162
diff -u -b -r1.162 det_analysis.m
--- compiler/det_analysis.m 24 Oct 2003 06:17:36 -0000 1.162
+++ compiler/det_analysis.m 30 Oct 2003 15:43:03 -0000
@@ -139,7 +139,7 @@
:- import_module libs__options.
:- import_module parse_tree__mercury_to_mercury.
-:- import_module assoc_list, bool, map, set, require, term.
+:- import_module string, assoc_list, bool, map, set, require, term.
%-----------------------------------------------------------------------------%
@@ -313,7 +313,7 @@
map__det_update(Procs0, ProcId, Proc, Procs),
pred_info_set_procedures(Procs, Pred0, Pred),
map__det_update(Preds0, PredId, Pred, Preds),
- module_info_set_preds(ModuleInfo0, Preds, ModuleInfo).
+ module_info_set_preds(Preds, ModuleInfo0, ModuleInfo).
%-----------------------------------------------------------------------------%
@@ -1144,14 +1144,16 @@
det_disjunction_maxsoln(at_most_many_cc, at_most_many, _) :-
% if the first disjunct could be cc pruned,
% the second disjunct ought to have been cc pruned too
- error("det_disjunction_maxsoln: cc in first case, not cc in second case").
+ error("det_disjunction_maxsoln: cc in first case, " ++
+ "not cc in second case").
det_disjunction_maxsoln(at_most_many, at_most_zero, at_most_many).
det_disjunction_maxsoln(at_most_many, at_most_one, at_most_many).
det_disjunction_maxsoln(at_most_many, at_most_many_cc, _) :-
% if the first disjunct could be cc pruned,
% the second disjunct ought to have been cc pruned too
- error("det_disjunction_maxsoln: cc in second case, not cc in first case").
+ error("det_disjunction_maxsoln: cc in second case, " ++
+ "not cc in first case").
det_disjunction_maxsoln(at_most_many, at_most_many, at_most_many).
det_disjunction_canfail(can_fail, can_fail, can_fail).
@@ -1318,8 +1320,7 @@
proc_info_set_inferred_determinism(Det, ProcInfo0, ProcInfo),
map__det_update(Procs0, ProcId, ProcInfo, Procs),
pred_info_set_procedures(Procs, PredInfo0, PredInfo),
- module_info_set_pred_info(!.ModuleInfo,
- PredId, PredInfo, !:ModuleInfo)
+ module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
;
true
).
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.83
diff -u -b -r1.83 det_report.m
--- compiler/det_report.m 24 Oct 2003 06:17:37 -0000 1.83
+++ compiler/det_report.m 30 Oct 2003 15:43:14 -0000
@@ -75,39 +75,36 @@
% Check all the determinism declarations in this module.
% This is the main predicate exported by this module.
-:- pred global_checking_pass(pred_proc_list, module_info, module_info,
- io__state, io__state).
-:- mode global_checking_pass(in, in, out, di, uo) is det.
+:- pred global_checking_pass(pred_proc_list::in,
+ module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
% Check a lambda goal with the specified declared and inferred
% determinisms.
-:- pred det_check_lambda(determinism, determinism, hlds_goal, hlds_goal_info,
- det_info, list(det_msg)).
-:- mode det_check_lambda(in, in, in, in, in, out) is det.
+:- pred det_check_lambda(determinism::in, determinism::in, hlds_goal::in,
+ hlds_goal_info::in, det_info::in, list(det_msg)::out) is det.
% Print some determinism warning and/or error messages,
% and update the module info accordingly.
-:- pred det_report_and_handle_msgs(list(det_msg), module_info, module_info,
- io__state, io__state).
-:- mode det_report_and_handle_msgs(in, in, out, di, uo) is det.
+:- pred det_report_and_handle_msgs(list(det_msg)::in,
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
% Print some determinism warning and/or error messages,
% and return the number of warnings and errors, so that code
% somewhere elsewhere can update the module info.
-:- pred det_report_msgs(list(det_msg), module_info, int, int,
- io__state, io__state).
-:- mode det_report_msgs(in, in, out, out, di, uo) is det.
+:- pred det_report_msgs(list(det_msg)::in, module_info::in, int::out, int::out,
+ io__state::di, io__state::uo) is det.
:- type msg_modes
---> all_modes % the warning should be reported only
% if it occurs in all modes of the predicate
- ; any_mode % the warning should be reported
+ ; any_mode. % the warning should be reported
% if it occurs in any mode of the predicate
- .
% Return `yes' if the warning should be reported if it occurs in
% any mode of the predicate, not only if it occurs in all modes.
@@ -120,11 +117,11 @@
% Call this predicate before rerunning determinism analysis
% after an optimization pass to disable all warnings. Errors will
% still be reported.
-:- pred disable_det_warnings(options_to_restore, io__state, io__state).
-:- mode disable_det_warnings(out, di, uo) is det.
+:- pred disable_det_warnings(options_to_restore::out,
+ io__state::di, io__state::uo) is det.
-:- pred restore_det_warnings(options_to_restore, io__state, io__state).
-:- mode restore_det_warnings(in, di, uo) is det.
+:- pred restore_det_warnings(options_to_restore::in,
+ io__state::di, io__state::uo) is det.
%-----------------------------------------------------------------------------%
@@ -154,46 +151,42 @@
%-----------------------------------------------------------------------------%
-global_checking_pass([], ModuleInfo, ModuleInfo) --> [].
-global_checking_pass([proc(PredId, ProcId) | Rest], ModuleInfo0, ModuleInfo) -->
- { module_info_pred_proc_info(ModuleInfo0, PredId, ProcId,
- PredInfo, ProcInfo) },
+global_checking_pass([], !ModuleInfo, !IO).
+global_checking_pass([proc(PredId, ProcId) | Rest], !ModuleInfo, !IO) :-
+ module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
+ PredInfo, ProcInfo),
check_determinism(PredId, ProcId, PredInfo, ProcInfo,
- ModuleInfo0, ModuleInfo1),
+ !ModuleInfo, !IO),
check_determinism_of_main(PredId, ProcId, PredInfo, ProcInfo,
- ModuleInfo1, ModuleInfo2),
+ !ModuleInfo, !IO),
check_for_multisoln_func(PredId, ProcId, PredInfo, ProcInfo,
- ModuleInfo2, ModuleInfo3),
- global_checking_pass(Rest, ModuleInfo3, ModuleInfo).
+ !ModuleInfo, !IO),
+ global_checking_pass(Rest, !ModuleInfo, !IO).
-:- pred check_determinism(pred_id, proc_id, pred_info, proc_info,
- module_info, module_info, io__state, io__state).
-:- mode check_determinism(in, in, in, in, in, out, di, uo) is det.
+:- pred check_determinism(pred_id::in, proc_id::in, pred_info::in,
+ proc_info::in, module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
check_determinism(PredId, ProcId, PredInfo0, ProcInfo0,
- ModuleInfo0, ModuleInfo) -->
- { proc_info_declared_determinism(ProcInfo0, MaybeDetism) },
- { proc_info_inferred_determinism(ProcInfo0, InferredDetism) },
+ !ModuleInfo, !IO) :-
+ proc_info_declared_determinism(ProcInfo0, MaybeDetism),
+ proc_info_inferred_determinism(ProcInfo0, InferredDetism),
(
- { MaybeDetism = no },
- { ModuleInfo1 = ModuleInfo0 }
+ MaybeDetism = no
;
- { MaybeDetism = yes(DeclaredDetism) },
- { compare_determinisms(DeclaredDetism, InferredDetism, Cmp) },
+ MaybeDetism = yes(DeclaredDetism),
+ compare_determinisms(DeclaredDetism, InferredDetism, Cmp),
(
- { Cmp = sameas },
- { ModuleInfo1 = ModuleInfo0 }
- ;
- { Cmp = looser },
- globals__io_lookup_bool_option(
- warn_det_decls_too_lax,
- ShouldIssueWarning),
- globals__io_lookup_bool_option(
- warn_inferred_erroneous,
- WarnAboutInferredErroneous),
- { pred_info_get_markers(PredInfo0, Markers) },
+ Cmp = sameas
+ ;
+ Cmp = looser,
+ globals__io_lookup_bool_option(warn_det_decls_too_lax,
+ ShouldIssueWarning, !IO),
+ globals__io_lookup_bool_option(warn_inferred_erroneous,
+ WarnAboutInferredErroneous, !IO),
+ pred_info_get_markers(PredInfo0, Markers),
(
- { ShouldIssueWarning = yes },
+ ShouldIssueWarning = yes,
% Don't report warnings for class method
% implementations -- the determinism in the
@@ -201,12 +194,12 @@
% the loosest of all possible instances.
% This is similar to the reason we don't
% report warnings for lambda expressions.
- { \+ check_marker(Markers,
- class_instance_method) },
+ \+ check_marker(Markers,
+ class_instance_method),
% Don't report warnings for procedures with
% no clauses.
- { \+ check_marker(Markers, stub) },
+ \+ check_marker(Markers, stub),
% Don't report warnings for compiler-generated
% Unify, Compare or Index procedures, since the
@@ -214,40 +207,44 @@
% happen for the Unify pred for the unit type,
% if such types are not boxed (as they are not
% boxed for the IL backend).
- { \+ is_unify_or_compare_pred(PredInfo0) },
+ \+ is_unify_or_compare_pred(PredInfo0),
% Don't warn about predicates which are
% inferred erroneous when the appropiate
% option is set. This is to avoid
% warnings about unimplemented
% predicates.
- { WarnAboutInferredErroneous = yes,
+ (
+ WarnAboutInferredErroneous = yes,
true
- ; WarnAboutInferredErroneous = no,
+ ;
+ WarnAboutInferredErroneous = no,
InferredDetism \= erroneous
- }
+ )
->
- { Message = " warning: determinism declaration could be tighter.\n" },
- report_determinism_problem(PredId,
- ProcId, ModuleInfo0, Message,
- DeclaredDetism, InferredDetism)
+ Message = " warning: determinism " ++
+ "declaration could be tighter.\n",
+ report_determinism_problem(PredId, ProcId,
+ !.ModuleInfo, Message, DeclaredDetism,
+ InferredDetism, !IO)
;
- []
- ),
- { ModuleInfo1 = ModuleInfo0 }
+ true
+ )
;
- { Cmp = tighter },
- { module_info_incr_errors(ModuleInfo0, ModuleInfo1) },
- { Message = " error: determinism declaration not satisfied.\n" },
- report_determinism_problem(PredId,
- ProcId, ModuleInfo1, Message,
- DeclaredDetism, InferredDetism),
- { proc_info_goal(ProcInfo0, Goal) },
- { proc_info_vartypes(ProcInfo0, VarTypes) },
- globals__io_get_globals(Globals),
- { det_info_init(ModuleInfo1, VarTypes, PredId, ProcId,
- Globals, DetInfo) },
- det_diagnose_goal(Goal, DeclaredDetism, [], DetInfo, _)
+ Cmp = tighter,
+ module_info_incr_errors(!ModuleInfo),
+ Message = " error: determinism declaration " ++
+ "not satisfied.\n",
+ report_determinism_problem(PredId, ProcId,
+ !.ModuleInfo, Message, DeclaredDetism,
+ InferredDetism, !IO),
+ proc_info_goal(ProcInfo0, Goal),
+ proc_info_vartypes(ProcInfo0, VarTypes),
+ globals__io_get_globals(Globals, !IO),
+ det_info_init(!.ModuleInfo, VarTypes, PredId, ProcId,
+ Globals, DetInfo),
+ det_diagnose_goal(Goal, DeclaredDetism, [], DetInfo,
+ _, !IO)
% XXX with the right verbosity options, we want to
% call report_determinism_problem only if diagnose
% returns false, i.e. it didn't print a message.
@@ -255,40 +252,40 @@
),
% make sure the code model is valid given the eval method
- { proc_info_eval_method(ProcInfo0, EvalMethod) },
+ proc_info_eval_method(ProcInfo0, EvalMethod),
(
- { valid_determinism_for_eval_method(EvalMethod,
- InferredDetism) = yes }
+ valid_determinism_for_eval_method(EvalMethod,
+ InferredDetism) = yes
->
- {
proc_info_set_eval_method(EvalMethod, ProcInfo0, ProcInfo),
pred_info_procedures(PredInfo0, ProcTable0),
map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
- module_info_set_pred_info(ModuleInfo1, PredId, PredInfo,
- ModuleInfo)
- }
+ module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
;
- { proc_info_context(ProcInfo0, Context) },
- prog_out__write_context(Context),
- { EvalMethodS = eval_method_to_string(EvalMethod) },
- io__write_string("Error: `pragma "),
- io__write_string(EvalMethodS),
- io__write_string("' declaration not allowed for procedure\n"),
- prog_out__write_context(Context),
- io__write_string(" with determinism `"),
- mercury_output_det(InferredDetism),
- io__write_string("'.\n"),
- globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
- ( { VerboseErrors = yes } ->
- io__write_string(
-"\tThe pragma requested is only valid for the folowing determinism(s):\n"),
- { solutions(get_valid_dets(EvalMethod), Sols) },
- print_dets(Sols)
+ proc_info_context(ProcInfo0, Context),
+ prog_out__write_context(Context, !IO),
+ EvalMethodS = eval_method_to_string(EvalMethod),
+ io__write_string("Error: `pragma ", !IO),
+ io__write_string(EvalMethodS, !IO),
+ io__write_string("' declaration not allowed for procedure\n",
+ !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" with determinism `", !IO),
+ mercury_output_det(InferredDetism, !IO),
+ io__write_string("'.\n", !IO),
+ globals__io_lookup_bool_option(verbose_errors, VerboseErrors,
+ !IO),
+ ( VerboseErrors = yes ->
+ io__write_string("\tThe pragma requested is only " ++
+ "valid for the folowing determinism(s):\n",
+ !IO),
+ solutions(get_valid_dets(EvalMethod), Sols),
+ print_dets(Sols, !IO)
;
- []
+ true
),
- { module_info_incr_errors(ModuleInfo1, ModuleInfo) }
+ module_info_incr_errors(!ModuleInfo)
).
:- pred get_valid_dets(eval_method, determinism).
@@ -322,31 +319,32 @@
io__nl,
print_dets(Rest).
-:- pred check_determinism_of_main(pred_id, proc_id, pred_info, proc_info,
- module_info, module_info, io__state, io__state).
-:- mode check_determinism_of_main(in, in, in, in, in, out, di, uo) is det.
+:- pred check_determinism_of_main(pred_id::in, proc_id::in,
+ pred_info::in, proc_info::in, module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
check_determinism_of_main(_PredId, _ProcId, PredInfo, ProcInfo,
- ModuleInfo0, ModuleInfo) -->
+ !ModuleInfo, !IO) :-
%
% check that `main/2' has determinism `det' or `cc_multi',
% as required by the language reference manual
%
- { proc_info_declared_determinism(ProcInfo, MaybeDetism) },
+ proc_info_declared_determinism(ProcInfo, MaybeDetism),
(
- { pred_info_name(PredInfo) = "main" },
- { pred_info_arity(PredInfo) = 2 },
- { pred_info_is_exported(PredInfo) },
- { MaybeDetism = yes(DeclaredDetism) },
- { DeclaredDetism \= det, DeclaredDetism \= cc_multidet }
+ pred_info_name(PredInfo) = "main",
+ pred_info_arity(PredInfo) = 2,
+ pred_info_is_exported(PredInfo),
+ MaybeDetism = yes(DeclaredDetism),
+ DeclaredDetism \= det,
+ DeclaredDetism \= cc_multidet
->
- { proc_info_context(ProcInfo, Context1) },
- prog_out__write_context(Context1),
+ proc_info_context(ProcInfo, Context1),
+ prog_out__write_context(Context1, !IO),
io__write_string(
- "Error: main/2 must be `det' or `cc_multi'.\n"),
- { module_info_incr_errors(ModuleInfo0, ModuleInfo) }
+ "Error: main/2 must be `det' or `cc_multi'.\n", !IO),
+ module_info_incr_errors(!ModuleInfo)
;
- { ModuleInfo = ModuleInfo0 }
+ true
).
:- pred check_for_multisoln_func(pred_id, proc_id, pred_info, proc_info,
@@ -1433,8 +1431,7 @@
] }.
restore_det_warnings(OptionsToRestore) -->
- list__foldl(
- (pred((Option - Value)::in, di, uo) is det -->
+ list__foldl((pred((Option - Value)::in, di, uo) is det -->
globals__io_set_option(Option, Value)
), OptionsToRestore).
Index: compiler/dnf.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dnf.m,v
retrieving revision 1.50
diff -u -b -r1.50 dnf.m
--- compiler/dnf.m 24 Oct 2003 06:17:37 -0000 1.50
+++ compiler/dnf.m 30 Oct 2003 03:41:45 -0000
@@ -127,30 +127,30 @@
maybe(set(pred_proc_id))::in, module_info::in, module_info::out,
list(pred_id)::in, list(pred_id)::out) is det.
-dnf__transform_procs([], _, _, ModuleInfo, ModuleInfo, NewPredIds, NewPredIds).
+dnf__transform_procs([], _, _, !ModuleInfo, NewPredIds, NewPredIds).
dnf__transform_procs([ProcId | ProcIds], PredId, MaybeNonAtomic,
- ModuleInfo0, ModuleInfo, NewPredIds0, NewPredIds) :-
- module_info_preds(ModuleInfo0, PredTable0),
+ !ModuleInfo, NewPredIds0, NewPredIds) :-
+ module_info_preds(!.ModuleInfo, PredTable0),
map__lookup(PredTable0, PredId, PredInfo0),
pred_info_procedures(PredInfo0, ProcTable0),
map__lookup(ProcTable0, ProcId, ProcInfo0),
dnf__transform_proc(ProcInfo0, PredInfo0, MaybeNonAtomic,
- ModuleInfo0, ModuleInfo1, ProcInfo, NewPredIds0, NewPredIds1),
+ !ModuleInfo, ProcInfo, NewPredIds0, NewPredIds1),
map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
% We must look up the pred table again
% since dnf__transform_proc may have added new predicates
- module_info_preds(ModuleInfo1, PredTable1),
+ module_info_preds(!.ModuleInfo, PredTable1),
map__det_update(PredTable1, PredId, PredInfo, PredTable),
- module_info_set_preds(ModuleInfo1, PredTable, ModuleInfo2),
+ module_info_set_preds(PredTable, !ModuleInfo),
dnf__transform_procs(ProcIds, PredId, MaybeNonAtomic,
- ModuleInfo2, ModuleInfo, NewPredIds1, NewPredIds).
+ !ModuleInfo, NewPredIds1, NewPredIds).
dnf__transform_proc(ProcInfo0, PredInfo0, MaybeNonAtomic,
- ModuleInfo0, ModuleInfo, ProcInfo, NewPredIds0, NewPredIds) :-
+ !ModuleInfo, ProcInfo, NewPredIds0, NewPredIds) :-
PredName = pred_info_name(PredInfo0),
pred_info_typevarset(PredInfo0, TVarSet),
pred_info_get_markers(PredInfo0, Markers),
@@ -165,9 +165,8 @@
DnfInfo = dnf_info(TVarSet, VarTypes, ClassContext,
VarSet, InstVarSet, Markers, TVarMap, TCVarMap, Owner),
- proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap),
- dnf__transform_goal(Goal0, InstMap, MaybeNonAtomic,
- ModuleInfo0, ModuleInfo,
+ proc_info_get_initial_instmap(ProcInfo0, !.ModuleInfo, InstMap),
+ dnf__transform_goal(Goal0, InstMap, MaybeNonAtomic, !ModuleInfo,
PredName, DnfInfo, Goal, NewPredIds0, NewPredIds),
proc_info_set_goal(Goal, ProcInfo0, ProcInfo).
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.88
diff -u -b -r1.88 goal_util.m
--- compiler/goal_util.m 24 Oct 2003 06:17:38 -0000 1.88
+++ compiler/goal_util.m 30 Oct 2003 15:36:49 -0000
@@ -332,9 +332,8 @@
;
Must = yes,
term__var_to_int(V, VInt),
- string__format(
- "goal_util__rename_var: no substitute for var %i",
- [i(VInt)], Msg),
+ string__format("goal_util__rename_var: " ++
+ "no substitute for var %i", [i(VInt)], Msg),
error(Msg)
)
).
@@ -460,11 +459,11 @@
functor(Functor, E, ArgVars)) :-
goal_util__rename_var_list(ArgVars0, Must, Subn, ArgVars).
goal_util__rename_unify_rhs(
- lambda_goal(Purity, PredOrFunc, EvalMethod, FixModes, NonLocals0,
- Vars0, Modes, Det, Goal0),
+ lambda_goal(Purity, PredOrFunc, EvalMethod, FixModes,
+ NonLocals0, Vars0, Modes, Det, Goal0),
Must, Subn,
- lambda_goal(Purity, PredOrFunc, EvalMethod, FixModes, NonLocals,
- Vars, Modes, Det, Goal)) :-
+ lambda_goal(Purity, PredOrFunc, EvalMethod, FixModes,
+ NonLocals, Vars, Modes, Det, Goal)) :-
goal_util__rename_var_list(NonLocals0, Must, Subn, NonLocals),
goal_util__rename_var_list(Vars0, Must, Subn, Vars),
goal_util__rename_vars_in_goal(Goal0, Must, Subn, Goal).
@@ -680,7 +679,8 @@
goal_util__rhs_goal_vars(functor(_Functor, _, ArgVars), Set0, Set) :-
set__insert_list(Set0, ArgVars, Set).
goal_util__rhs_goal_vars(
- lambda_goal(_, _, _, _, NonLocals, LambdaVars, _M, _D, Goal - _),
+ lambda_goal(_, _, _, _, NonLocals, LambdaVars, _M, _D,
+ Goal - _),
Set0, Set) :-
set__insert_list(Set0, NonLocals, Set1),
set__insert_list(Set1, LambdaVars, Set2),
@@ -700,7 +700,7 @@
term__vars_list(NonLocalsTypes, NonLocalTypeVars),
% Find all the type-infos and typeclass-infos that are
% non-local
- solutions_set(lambda([Var::out] is nondet, (
+ solutions_set((pred(Var::out) is nondet :-
%
% if there is some TypeVar for which either
% (a) the type of some non-local variable
@@ -717,7 +717,8 @@
% constraints on types which include that type,
% should be included in the NonLocalTypeInfos.
%
- ( map__search(TypeVarMap, TypeVar, Location),
+ (
+ map__search(TypeVarMap, TypeVar, Location),
type_info_locn_var(Location, Var)
;
% this is probably not very efficient...
@@ -725,7 +726,7 @@
Constraint = constraint(_Name, ArgTypes),
term__contains_var_list(ArgTypes, TypeVar)
)
- )), NonLocalTypeInfos).
+ ), NonLocalTypeInfos).
%-----------------------------------------------------------------------------%
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.112
diff -u -b -r1.112 higher_order.m
--- compiler/higher_order.m 24 Oct 2003 06:17:38 -0000 1.112
+++ compiler/higher_order.m 27 Oct 2003 17:06:20 -0000
@@ -375,8 +375,8 @@
proc(PredId, ProcId), PredInfo0, ProcInfo0, unchanged),
traverse_goal(MustRecompute, Info0, Info),
Info = higher_order_info(GlobalInfo1, _, _, PredInfo, ProcInfo, _),
- module_info_set_pred_proc_info(GlobalInfo1 ^ module_info,
- PredId, ProcId, PredInfo, ProcInfo, ModuleInfo),
+ module_info_set_pred_proc_info(PredId, ProcId, PredInfo, ProcInfo,
+ GlobalInfo1 ^ module_info, ModuleInfo),
GlobalInfo = GlobalInfo1 ^ module_info := ModuleInfo.
%-------------------------------------------------------------------------------
@@ -2518,7 +2518,7 @@
module_info_get_predicate_table(ModuleInfo0, PredTable0),
predicate_table_insert(PredTable0, NewPredInfo1, NewPredId, PredTable),
- module_info_set_predicate_table(ModuleInfo0, PredTable, ModuleInfo1),
+ module_info_set_predicate_table(PredTable, ModuleInfo0, ModuleInfo1),
!:Info = !.Info ^ module_info := ModuleInfo1,
@@ -2529,8 +2529,8 @@
add_new_pred(CalledPredProc, NewPred, !Info),
create_new_proc(NewPred, ProcInfo0, NewPredInfo1, NewPredInfo, !Info),
- module_info_set_pred_info(!.Info ^ module_info, NewPredId, NewPredInfo,
- ModuleInfo),
+ module_info_set_pred_info(NewPredId, NewPredInfo,
+ !.Info ^ module_info, ModuleInfo),
!:Info = !.Info ^ module_info := ModuleInfo.
:- pred add_new_pred(pred_proc_id::in, new_pred::in,
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.92
diff -u -b -r1.92 hlds_module.m
--- compiler/hlds_module.m 24 Oct 2003 11:29:40 -0000 1.92
+++ compiler/hlds_module.m 27 Oct 2003 16:40:55 -0000
@@ -127,362 +127,306 @@
% import `table_builtin', but the items are not inserted into
% the module_info.
%
-:- pred module_info_init(module_name, item_list, globals,
- partial_qualifier_info, maybe(recompilation_info), module_info).
-:- mode module_info_init(in, in, in, in, in, out) is det.
-
-:- pred module_info_get_predicate_table(module_info, predicate_table).
-:- mode module_info_get_predicate_table(in, out) is det.
-
-:- pred module_info_set_predicate_table(module_info, predicate_table,
- module_info).
-:- mode module_info_set_predicate_table(in, in, out) is det.
+:- pred module_info_init(module_name::in, item_list::in, globals::in,
+ partial_qualifier_info::in, maybe(recompilation_info)::in,
+ module_info::out) is det.
+
+:- pred module_info_get_predicate_table(module_info::in, predicate_table::out)
+ is det.
+
+:- pred module_info_set_predicate_table(predicate_table::in,
+ module_info::in, module_info::out) is det.
% For an explanation of the proc_requests structure,
% see unify_proc.m.
-:- pred module_info_get_proc_requests(module_info, proc_requests).
-:- mode module_info_get_proc_requests(in, out) is det.
+:- pred module_info_get_proc_requests(module_info::in, proc_requests::out)
+ is det.
-:- pred module_info_get_special_pred_map(module_info, special_pred_map).
-:- mode module_info_get_special_pred_map(in, out) is det.
+:- pred module_info_get_special_pred_map(module_info::in,
+ special_pred_map::out) is det.
-:- pred module_info_set_special_pred_map(module_info, special_pred_map,
- module_info).
-:- mode module_info_set_special_pred_map(in, in, out) is det.
+:- pred module_info_set_special_pred_map(special_pred_map::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_get_partial_qualifier_info(module_info,
- partial_qualifier_info).
-:- mode module_info_get_partial_qualifier_info(in, out) is det.
+:- pred module_info_get_partial_qualifier_info(module_info::in,
+ partial_qualifier_info::out) is det.
-:- pred module_info_set_partial_qualifier_info(module_info,
- partial_qualifier_info, module_info).
-:- mode module_info_set_partial_qualifier_info(in, in, out) is det.
+:- pred module_info_set_partial_qualifier_info(partial_qualifier_info::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_types(module_info, type_table).
-:- mode module_info_types(in, out) is det.
+:- pred module_info_types(module_info::in, type_table::out) is det.
-:- pred module_info_set_types(module_info, type_table, module_info).
-:- mode module_info_set_types(in, in, out) is det.
+:- pred module_info_set_types(type_table::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_insts(module_info, inst_table).
-:- mode module_info_insts(in, out) is det.
+:- pred module_info_insts(module_info::in, inst_table::out) is det.
-:- pred module_info_set_insts(module_info, inst_table, module_info).
-:- mode module_info_set_insts(in, in, out) is det.
+:- pred module_info_set_insts(inst_table::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_modes(module_info, mode_table).
-:- mode module_info_modes(in, out) is det.
+:- pred module_info_modes(module_info::in, mode_table::out) is det.
-:- pred module_info_set_modes(module_info, mode_table, module_info).
-:- mode module_info_set_modes(in, in, out) is det.
+:- pred module_info_set_modes(mode_table::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_ctors(module_info, cons_table).
-:- mode module_info_ctors(in, out) is det.
+:- pred module_info_ctors(module_info::in, cons_table::out) is det.
-:- pred module_info_set_ctors(module_info, cons_table, module_info).
-:- mode module_info_set_ctors(in, in, out) is det.
+:- pred module_info_set_ctors(cons_table::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_classes(module_info, class_table).
-:- mode module_info_classes(in, out) is det.
+:- pred module_info_classes(module_info::in, class_table::out) is det.
-:- pred module_info_set_classes(module_info, class_table, module_info).
-:- mode module_info_set_classes(in, in, out) is det.
+:- pred module_info_set_classes(class_table::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_instances(module_info, instance_table).
-:- mode module_info_instances(in, out) is det.
+:- pred module_info_instances(module_info::in, instance_table::out) is det.
-:- pred module_info_set_instances(module_info, instance_table, module_info).
-:- mode module_info_set_instances(in, in, out) is det.
+:- pred module_info_set_instances(instance_table::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_superclasses(module_info, superclass_table).
-:- mode module_info_superclasses(in, out) is det.
+:- pred module_info_superclasses(module_info::in, superclass_table::out)
+ is det.
-:- pred module_info_set_superclasses(module_info, superclass_table,
- module_info).
-:- mode module_info_set_superclasses(in, in, out) is det.
+:- pred module_info_set_superclasses(superclass_table::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_assertion_table(module_info, assertion_table).
-:- mode module_info_assertion_table(in, out) is det.
+:- pred module_info_assertion_table(module_info::in, assertion_table::out)
+ is det.
-:- pred module_info_set_assertion_table(module_info, assertion_table,
- module_info).
-:- mode module_info_set_assertion_table(in, in, out) is det.
+:- pred module_info_set_assertion_table(assertion_table::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_exclusive_table(module_info, exclusive_table).
-:- mode module_info_exclusive_table(in, out) is det.
+:- pred module_info_exclusive_table(module_info::in, exclusive_table::out)
+ is det.
-:- pred module_info_set_exclusive_table(module_info, exclusive_table,
- module_info).
-:- mode module_info_set_exclusive_table(in, in, out) is det.
+:- pred module_info_set_exclusive_table(exclusive_table::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_ctor_field_table(module_info, ctor_field_table).
-:- mode module_info_ctor_field_table(in, out) is det.
+:- pred module_info_ctor_field_table(module_info::in, ctor_field_table::out)
+ is det.
-:- pred module_info_set_ctor_field_table(module_info,
- ctor_field_table, module_info).
-:- mode module_info_set_ctor_field_table(in, in, out) is det.
+:- pred module_info_set_ctor_field_table(ctor_field_table::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_get_maybe_recompilation_info(module_info,
- maybe(recompilation_info)).
-:- mode module_info_get_maybe_recompilation_info(in, out) is det.
+:- pred module_info_get_maybe_recompilation_info(module_info::in,
+ maybe(recompilation_info)::out) is det.
-:- pred module_info_set_maybe_recompilation_info(module_info,
- maybe(recompilation_info), module_info).
-:- mode module_info_set_maybe_recompilation_info(in, in, out) is det.
+:- pred module_info_set_maybe_recompilation_info(maybe(recompilation_info)::in,
+ module_info::in, module_info::out) is det.
-:- pred module_add_imported_module_specifiers(list(module_specifier),
- module_info, module_info).
-:- mode module_add_imported_module_specifiers(in, in, out) is det.
+:- pred module_add_imported_module_specifiers(list(module_specifier)::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_get_imported_module_specifiers(module_info,
- set(module_specifier)).
-:- mode module_info_get_imported_module_specifiers(in, out) is det.
+:- pred module_info_get_imported_module_specifiers(module_info::in,
+ set(module_specifier)::out) is det.
:- pred module_add_indirectly_imported_module_specifiers(
- list(module_specifier), module_info, module_info).
-:- mode module_add_indirectly_imported_module_specifiers(in, in, out) is det.
+ list(module_specifier)::in, module_info::in, module_info::out) is det.
-:- pred module_info_get_indirectly_imported_module_specifiers(module_info,
- set(module_specifier)).
-:- mode module_info_get_indirectly_imported_module_specifiers(in, out) is det.
+:- pred module_info_get_indirectly_imported_module_specifiers(module_info::in,
+ set(module_specifier)::out) is det.
% The visible modules are the current module, any
% imported modules, any ancestor modules and any
% modules imported by ancestor modules.
% It excludes transitively imported modules (those
% for which we read `.int2' files).
-:- pred visible_module(module_name, module_info).
-:- mode visible_module(out, in) is multi.
+:- pred visible_module(module_name::out, module_info::in) is multi.
% This returns all the modules that this module's code depends on,
% i.e. all modules that have been used or imported by this module,
% directly or indirectly, including parent modules.
-:- pred module_info_get_all_deps(module_info, set(module_name)).
-:- mode module_info_get_all_deps(in, out) is det.
+:- pred module_info_get_all_deps(module_info::in, set(module_name)::out)
+ is det.
%-----------------------------------------------------------------------------%
-:- pred module_info_name(module_info, module_name).
-:- mode module_info_name(in, out) is det.
+:- pred module_info_name(module_info::in, module_name::out) is det.
-:- pred module_info_globals(module_info, globals).
-:- mode module_info_globals(in, out) is det.
+:- pred module_info_globals(module_info::in, globals::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_set_globals(globals::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_contains_foreign_type(module_info).
-:- mode module_info_contains_foreign_type(in) is semidet.
+:- pred module_info_contains_foreign_type(module_info::in) is semidet.
-:- pred module_info_contains_foreign_type(module_info, module_info).
-:- mode module_info_contains_foreign_type(in, out) is det.
+:- pred module_info_contains_foreign_type(module_info::in, module_info::out)
+ is det.
-:- pred module_info_get_foreign_decl(module_info, foreign_decl_info).
-:- mode module_info_get_foreign_decl(in, out) is det.
+:- pred module_info_get_foreign_decl(module_info::in, foreign_decl_info::out)
+ is det.
-:- pred module_info_set_foreign_decl(module_info,
- foreign_decl_info, module_info).
-:- mode module_info_set_foreign_decl(in, in, out) is det.
+:- pred module_info_set_foreign_decl(foreign_decl_info::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_get_foreign_body_code(module_info, foreign_body_info).
-:- mode module_info_get_foreign_body_code(in, out) is det.
+:- pred module_info_get_foreign_body_code(module_info::in,
+ foreign_body_info::out) is det.
-:- pred module_info_set_foreign_body_code(module_info,
- foreign_body_info, module_info).
-:- mode module_info_set_foreign_body_code(in, in, out) is det.
+:- pred module_info_set_foreign_body_code(foreign_body_info::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_get_foreign_import_module(module_info,
- foreign_import_module_info).
-:- mode module_info_get_foreign_import_module(in, out) is det.
+:- pred module_info_get_foreign_import_module(module_info::in,
+ foreign_import_module_info::out) is det.
-:- pred module_info_set_foreign_import_module(module_info,
- foreign_import_module_info, module_info).
-:- mode module_info_set_foreign_import_module(in, in, out) is det.
+:- pred module_info_set_foreign_import_module(foreign_import_module_info::in,
+ module_info::in, module_info::out) is det.
-:- pred module_add_foreign_decl(foreign_language, string, prog_context,
- module_info, module_info).
-:- mode module_add_foreign_decl(in, in, in, in, out) is det.
+:- pred module_add_foreign_decl(foreign_language::in, string::in,
+ prog_context::in, module_info::in, module_info::out) is det.
-:- pred module_add_foreign_import_module(foreign_language,
- module_name, prog_context, module_info, module_info).
-:- mode module_add_foreign_import_module(in, in, in, in, out) is det.
+:- pred module_add_foreign_import_module(foreign_language::in, module_name::in,
+ prog_context::in, module_info::in, module_info::out) is det.
-:- pred module_add_foreign_body_code(foreign_language, string, prog_context,
- module_info, module_info).
-:- mode module_add_foreign_body_code(in, in, in, in, out) is det.
+:- pred module_add_foreign_body_code(foreign_language::in, string::in,
+ prog_context::in, module_info::in, module_info::out) is det.
% Please see module_info_ensure_dependency_info for the
% constraints on this dependency_info.
-:- pred module_info_get_maybe_dependency_info(module_info,
- maybe(dependency_info)).
-:- mode module_info_get_maybe_dependency_info(in, out) is det.
+:- pred module_info_get_maybe_dependency_info(module_info::in,
+ maybe(dependency_info)::out) is det.
-:- pred module_info_num_errors(module_info, int).
-:- mode module_info_num_errors(in, out) is det.
+:- pred module_info_num_errors(module_info::in, int::out) is det.
-:- pred module_info_unused_arg_info(module_info, unused_arg_info).
-:- mode module_info_unused_arg_info(in, out) is det.
+:- pred module_info_unused_arg_info(module_info::in, unused_arg_info::out)
+ is det.
-:- pred module_info_set_proc_requests(module_info, proc_requests,
- module_info).
-:- mode module_info_set_proc_requests(in, in, out) is det.
+:- pred module_info_set_proc_requests(proc_requests::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_set_unused_arg_info(module_info,
- unused_arg_info, module_info).
-:- mode module_info_set_unused_arg_info(in, in, out) is det.
+:- pred module_info_set_unused_arg_info(unused_arg_info::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_set_num_errors(module_info, int, module_info).
-:- mode module_info_set_num_errors(in, in, out) is det.
+:- pred module_info_set_num_errors(int::in, module_info::in, module_info::out)
+ is det.
-:- pred module_info_get_pragma_exported_procs(module_info,
- list(pragma_exported_proc)).
-:- mode module_info_get_pragma_exported_procs(in, out) is det.
+:- pred module_info_get_pragma_exported_procs(module_info::in,
+ list(pragma_exported_proc)::out) is det.
-:- pred module_info_set_pragma_exported_procs(module_info,
- list(pragma_exported_proc), module_info).
-:- mode module_info_set_pragma_exported_procs(in, in, out) is det.
+:- pred module_info_set_pragma_exported_procs(list(pragma_exported_proc)::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_type_ctor_gen_infos(module_info, list(type_ctor_gen_info)).
-:- mode module_info_type_ctor_gen_infos(in, out) is det.
+:- pred module_info_type_ctor_gen_infos(module_info::in,
+ list(type_ctor_gen_info)::out) is det.
-:- pred module_info_set_type_ctor_gen_infos(module_info,
- list(type_ctor_gen_info), module_info).
-:- mode module_info_set_type_ctor_gen_infos(in, in, out) is det.
+:- pred module_info_set_type_ctor_gen_infos(list(type_ctor_gen_info)::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_stratified_preds(module_info, set(pred_id)).
-:- mode module_info_stratified_preds(in, out) is det.
+:- pred module_info_stratified_preds(module_info::in, set(pred_id)::out)
+ is det.
-:- pred module_info_set_stratified_preds(module_info, set(pred_id),
- module_info).
-:- mode module_info_set_stratified_preds(in, in, out) is det.
+:- pred module_info_set_stratified_preds(set(pred_id)::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_get_do_aditi_compilation(module_info,
- do_aditi_compilation).
-:- mode module_info_get_do_aditi_compilation(in, out) is det.
+:- pred module_info_get_do_aditi_compilation(module_info::in,
+ do_aditi_compilation::out) is det.
-:- pred module_info_set_do_aditi_compilation(module_info, module_info).
-:- mode module_info_set_do_aditi_compilation(in, out) is det.
+:- pred module_info_set_do_aditi_compilation(module_info::in, module_info::out)
+ is det.
-:- pred module_info_type_spec_info(module_info, type_spec_info).
-:- mode module_info_type_spec_info(in, out) is det.
+:- pred module_info_type_spec_info(module_info::in, type_spec_info::out)
+ is det.
-:- pred module_info_set_type_spec_info(module_info,
- type_spec_info, module_info).
-:- mode module_info_set_type_spec_info(in, in, out) is det.
+:- pred module_info_set_type_spec_info(type_spec_info::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_no_tag_types(module_info, no_tag_type_table).
-:- mode module_info_no_tag_types(in, out) is det.
+:- pred module_info_no_tag_types(module_info::in, no_tag_type_table::out)
+ is det.
-:- pred module_info_set_no_tag_types(module_info,
- no_tag_type_table, module_info).
-:- mode module_info_set_no_tag_types(in, in, out) is det.
+:- pred module_info_set_no_tag_types(no_tag_type_table::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_analysis_info(module_info, analysis_info).
-:- mode module_info_analysis_info(in, out) is det.
+:- pred module_info_analysis_info(module_info::in, analysis_info::out) is det.
-:- pred module_info_set_analysis_info(module_info,
- analysis_info, module_info).
-:- mode module_info_set_analysis_info(in, in, out) is det.
+:- pred module_info_set_analysis_info(analysis_info::in,
+ module_info::in, module_info::out) is det.
%-----------------------------------------------------------------------------%
-:- pred module_info_preds(module_info, pred_table).
-:- mode module_info_preds(in, out) is det.
+:- pred module_info_preds(module_info::in, pred_table::out) is det.
-:- pred module_info_pred_info(module_info, pred_id, pred_info).
-:- mode module_info_pred_info(in, in, out) is det.
+:- pred module_info_pred_info(module_info::in, pred_id::in, pred_info::out)
+ is det.
% Given a pred_id and a proc_id, get the
% pred_info that predicate and the proc_info for that
% mode of that predicate.
-:- pred module_info_pred_proc_info(module_info, pred_id, proc_id,
- 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.
+:- pred module_info_pred_proc_info(module_info::in, pred_id::in, proc_id::in,
+ pred_info::out, proc_info::out) is det.
+
+:- pred module_info_pred_proc_info(module_info::in, pred_proc_id::in,
+ pred_info::out, proc_info::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
% on the predicates in this list being type-correct, etc.)
-:- pred module_info_predids(module_info, list(pred_id)).
-:- mode module_info_predids(in, out) is det.
+:- pred module_info_predids(module_info::in, list(pred_id)::out) is det.
% Reverse the list of pred_ids.
% (The list is built up by inserting values at the front,
% for efficiency; once we've done so, we reverse the list
% so that progress messages and error messages come out
% in the expected order.)
-:- pred module_info_reverse_predids(module_info, module_info).
-:- mode module_info_reverse_predids(in, out) is det.
+:- pred module_info_reverse_predids(module_info::in, module_info::out) is det.
% Remove a predicate from the list of pred_ids, to prevent
% further processing of this predicate after an error is encountered.
-:- pred module_info_remove_predid(module_info, pred_id, module_info).
-:- mode module_info_remove_predid(in, in, out) is det.
+:- pred module_info_remove_predid(pred_id::in,
+ module_info::in, module_info::out) is det.
% Completely remove a predicate from a module.
-:- pred module_info_remove_predicate(pred_id, module_info, module_info).
-:- mode module_info_remove_predicate(in, in, out) is det.
+:- pred module_info_remove_predicate(pred_id::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_set_preds(module_info, pred_table, module_info).
-:- mode module_info_set_preds(in, in, out) is det.
+:- pred module_info_set_preds(pred_table::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_set_pred_info(module_info, pred_id, pred_info, module_info).
-:- mode module_info_set_pred_info(in, in, in, out) is det.
+:- pred module_info_set_pred_info(pred_id::in, pred_info::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_set_pred_proc_info(module_info,
- 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(pred_id::in, proc_id::in,
+ pred_info::in, proc_info::in, module_info::in, module_info::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_set_pred_proc_info(pred_proc_id::in,
+ pred_info::in, proc_info::in, module_info::in, module_info::out)
+ is det.
-:- pred module_info_typeids(module_info, list(type_ctor)).
-:- mode module_info_typeids(in, out) is det.
+:- pred module_info_typeids(module_info::in, list(type_ctor)::out) is det.
-:- pred module_info_instids(module_info, list(inst_id)).
-:- mode module_info_instids(in, out) is det.
+:- pred module_info_instids(module_info::in, list(inst_id)::out) is det.
-:- pred module_info_modeids(module_info, list(mode_id)).
-:- mode module_info_modeids(in, out) is det.
+:- pred module_info_modeids(module_info::in, list(mode_id)::out) is det.
-:- pred module_info_consids(module_info, list(cons_id)).
-:- mode module_info_consids(in, out) is det.
+:- pred module_info_consids(module_info::in, list(cons_id)::out) is det.
% Please see module_info_ensure_dependency_info for the
% constraints on this dependency_info.
-:- pred module_info_dependency_info(module_info, dependency_info).
-:- mode module_info_dependency_info(in, out) is det.
+:- pred module_info_dependency_info(module_info::in, dependency_info::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_aditi_dependency_ordering(module_info::in,
+ aditi_dependency_ordering::out) is det.
% Please see module_info_ensure_dependency_info for the
% constraints on this dependency_info.
-:- pred module_info_set_dependency_info(module_info, dependency_info,
- module_info).
-:- mode module_info_set_dependency_info(in, in, out) is det.
+:- pred module_info_set_dependency_info(dependency_info::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_clobber_dependency_info(module_info, module_info).
-:- mode module_info_clobber_dependency_info(in, out) is det.
+:- pred module_info_clobber_dependency_info(module_info::in, module_info::out)
+ is det.
-:- pred module_info_incr_errors(module_info, module_info).
-:- mode module_info_incr_errors(in, out) is det.
+:- pred module_info_incr_errors(module_info::in, module_info::out) is det.
% The module_info stores a counter which is used to number
% introduced lambda predicates as __LambdaGoal__1, __LambdaGoal__2,
% etc.; this predicate returns the next number and increments
% the counter.
-:- pred module_info_next_lambda_count(module_info, int, module_info).
-:- mode module_info_next_lambda_count(in, out, out) is det.
+:- pred module_info_next_lambda_count(int::out,
+ module_info::in, module_info::out) is det.
-:- pred module_info_next_model_non_pragma_count(module_info, int, module_info).
-:- mode module_info_next_model_non_pragma_count(in, out, out) is det.
+:- pred module_info_next_model_non_pragma_count(int::out,
+ module_info::in, module_info::out) is det.
% Once the module_info has been built, we call module_info_optimize
% to attempt to optimize the data structures for lots of accesses
@@ -491,8 +435,7 @@
% 234-trees, it is a no-op, except for the mode and inst tables,
% where the cached lists of mode_ids and inst_ids are sorted for
% efficient conversion to sets in module_qual.m.)
-:- pred module_info_optimize(module_info, module_info).
-:- mode module_info_optimize(in, out) is det.
+:- pred module_info_optimize(module_info::in, module_info::out) is det.
%-----------------------------------------------------------------------------%
@@ -500,22 +443,19 @@
:- import_module counter.
-:- pred module_info_get_lambda_counter(module_info, counter).
-:- mode module_info_get_lambda_counter(in, out) is det.
+:- pred module_info_get_lambda_counter(module_info::in, counter::out) is det.
-:- pred module_info_set_lambda_counter(module_info, counter, module_info).
-:- mode module_info_set_lambda_counter(in, in, out) is det.
+:- pred module_info_set_lambda_counter(counter::in,
+ module_info::in, module_info::out) is det.
-:- pred module_info_get_model_non_pragma_counter(module_info, counter).
-:- mode module_info_get_model_non_pragma_counter(in, out) is det.
+:- pred module_info_get_model_non_pragma_counter(module_info::in, counter::out)
+ is det.
-:- pred module_info_set_model_non_pragma_counter(module_info, counter,
- module_info).
-:- mode module_info_set_model_non_pragma_counter(in, in, out) is det.
-
-:- pred module_info_set_maybe_dependency_info(module_info,
- maybe(dependency_info), module_info).
-:- mode module_info_set_maybe_dependency_info(in, in, out) is det.
+:- pred module_info_set_model_non_pragma_counter(counter::in,
+ module_info::in, module_info::out) is det.
+
+:- pred module_info_set_maybe_dependency_info(maybe(dependency_info)::in,
+ module_info::in, module_info::out) is det.
:- type module_info --->
module(
@@ -682,22 +622,22 @@
% Various predicates which modify the module_info data structure.
-module_info_set_predicate_table(MI, PT, MI ^ predicate_table := PT).
-module_info_set_proc_requests(MI, PR, MI ^ proc_requests := PR).
-module_info_set_special_pred_map(MI, SPM, MI ^ special_pred_map := SPM).
-module_info_set_partial_qualifier_info(MI, PQ,
+module_info_set_predicate_table(PT, MI, MI ^ predicate_table := PT).
+module_info_set_proc_requests(PR, MI, MI ^ proc_requests := PR).
+module_info_set_special_pred_map(SPM, MI, MI ^ special_pred_map := SPM).
+module_info_set_partial_qualifier_info(PQ, MI,
MI ^ partial_qualifier_info := PQ).
-module_info_set_types(MI, T, MI ^ type_table := T).
-module_info_set_insts(MI, I, MI ^ inst_table := I).
-module_info_set_modes(MI, M, MI ^ mode_table := M).
-module_info_set_ctors(MI, C, MI ^ cons_table := C).
-module_info_set_classes(MI, C, MI ^ class_table := C).
-module_info_set_instances(MI, I, MI ^ instance_table := I).
-module_info_set_superclasses(MI, S, MI ^ superclass_table := S).
-module_info_set_assertion_table(MI, A, MI ^ assertion_table := A).
-module_info_set_exclusive_table(MI, PXT, MI ^ exclusive_table := PXT).
-module_info_set_ctor_field_table(MI, CF, MI ^ ctor_field_table := CF).
-module_info_set_maybe_recompilation_info(MI, I,
+module_info_set_types(T, MI, MI ^ type_table := T).
+module_info_set_insts(I, MI, MI ^ inst_table := I).
+module_info_set_modes(M, MI, MI ^ mode_table := M).
+module_info_set_ctors(C, MI, MI ^ cons_table := C).
+module_info_set_classes(C, MI, MI ^ class_table := C).
+module_info_set_instances(I, MI, MI ^ instance_table := I).
+module_info_set_superclasses(S, MI, MI ^ superclass_table := S).
+module_info_set_assertion_table(A, MI, MI ^ assertion_table := A).
+module_info_set_exclusive_table(PXT, MI, MI ^ exclusive_table := PXT).
+module_info_set_ctor_field_table(CF, MI, MI ^ ctor_field_table := CF).
+module_info_set_maybe_recompilation_info(I, MI,
MI ^ maybe_recompilation_info := I).
%-----------------------------------------------------------------------------%
@@ -739,31 +679,31 @@
% Various predicates which modify the module_sub_info data structure
% via the module_info structure.
-module_info_set_globals(MI, NewVal,
+module_info_set_globals(NewVal, MI,
MI ^ sub_info ^ globals := NewVal).
module_info_contains_foreign_type(MI,
MI ^ sub_info ^ contains_foreign_type := yes).
-module_info_set_foreign_decl(MI, NewVal,
+module_info_set_foreign_decl(NewVal, MI,
MI ^ sub_info ^ foreign_decl_info := NewVal).
-module_info_set_foreign_body_code(MI, NewVal,
+module_info_set_foreign_body_code(NewVal, MI,
MI ^ sub_info ^ foreign_body_info := NewVal).
-module_info_set_foreign_import_module(MI, NewVal,
+module_info_set_foreign_import_module(NewVal, MI,
MI ^ sub_info ^ foreign_import_module_info := NewVal).
-module_info_set_maybe_dependency_info(MI, NewVal,
+module_info_set_maybe_dependency_info(NewVal, MI,
MI ^ sub_info ^ maybe_dependency_info := NewVal).
-module_info_set_num_errors(MI, NewVal,
+module_info_set_num_errors(NewVal, MI,
MI ^ sub_info ^ num_errors := NewVal).
-module_info_set_pragma_exported_procs(MI, NewVal,
+module_info_set_pragma_exported_procs(NewVal, MI,
MI ^ sub_info ^ pragma_exported_procs := NewVal).
-module_info_set_type_ctor_gen_infos(MI, NewVal,
+module_info_set_type_ctor_gen_infos(NewVal, MI,
MI ^ sub_info ^ type_ctor_gen_infos := NewVal).
-module_info_set_stratified_preds(MI, NewVal,
+module_info_set_stratified_preds(NewVal, MI,
MI ^ sub_info ^ must_be_stratified_preds := NewVal).
-module_info_set_unused_arg_info(MI, NewVal,
+module_info_set_unused_arg_info(NewVal, MI,
MI ^ sub_info ^ unused_arg_info := NewVal).
-module_info_set_lambda_counter(MI, NewVal,
+module_info_set_lambda_counter(NewVal, MI,
MI ^ sub_info ^ lambda_number_counter := NewVal).
-module_info_set_model_non_pragma_counter(MI, NewVal,
+module_info_set_model_non_pragma_counter(NewVal, MI,
MI ^ sub_info ^ model_non_pragma_counter := NewVal).
module_add_imported_module_specifiers(ModuleSpecifiers, MI,
MI ^ sub_info ^ imported_module_specifiers :=
@@ -777,11 +717,11 @@
Modules)).
module_info_set_do_aditi_compilation(MI,
MI ^ sub_info ^ do_aditi_compilation := do_aditi_compilation).
-module_info_set_type_spec_info(MI, NewVal,
+module_info_set_type_spec_info(NewVal, MI,
MI ^ sub_info ^ type_spec_info := NewVal).
-module_info_set_no_tag_types(MI, NewVal,
+module_info_set_no_tag_types(NewVal, MI,
MI ^ sub_info ^ no_tag_type_table := NewVal).
-module_info_set_analysis_info(MI, NewVal,
+module_info_set_analysis_info(NewVal, MI,
MI ^ sub_info ^ analysis_info := NewVal).
%-----------------------------------------------------------------------------%
@@ -819,38 +759,38 @@
module_info_reverse_predids(MI0, MI) :-
module_info_get_predicate_table(MI0, PredTable0),
predicate_table_reverse_predids(PredTable0, PredTable),
- module_info_set_predicate_table(MI0, PredTable, MI).
+ module_info_set_predicate_table(PredTable, MI0, MI).
-module_info_remove_predid(MI0, PredId, MI) :-
+module_info_remove_predid(PredId, MI0, MI) :-
module_info_get_predicate_table(MI0, PredTable0),
predicate_table_remove_predid(PredTable0, PredId, PredTable),
- module_info_set_predicate_table(MI0, PredTable, MI).
+ module_info_set_predicate_table(PredTable, MI0, MI).
module_info_remove_predicate(PredId, MI0, MI) :-
module_info_get_predicate_table(MI0, PredTable0),
predicate_table_remove_predicate(PredTable0, PredId, PredTable),
- module_info_set_predicate_table(MI0, PredTable, MI).
+ module_info_set_predicate_table(PredTable, MI0, MI).
-module_info_set_preds(MI0, Preds, MI) :-
+module_info_set_preds(Preds, MI0, MI) :-
module_info_get_predicate_table(MI0, PredTable0),
predicate_table_set_preds(PredTable0, Preds, PredTable),
- module_info_set_predicate_table(MI0, PredTable, MI).
+ module_info_set_predicate_table(PredTable, MI0, MI).
-module_info_set_pred_info(MI0, PredId, PredInfo, MI) :-
+module_info_set_pred_info(PredId, PredInfo, MI0, MI) :-
module_info_preds(MI0, Preds0),
map__set(Preds0, PredId, PredInfo, Preds),
- module_info_set_preds(MI0, Preds, MI).
+ module_info_set_preds(Preds, MI0, 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(proc(PredId, ProcId), PredInfo, ProcInfo,
+ MI0, MI) :-
+ module_info_set_pred_proc_info(PredId, ProcId,
+ PredInfo, ProcInfo, MI0, MI).
-module_info_set_pred_proc_info(MI0, PredId, ProcId, PredInfo0, ProcInfo, MI) :-
+module_info_set_pred_proc_info(PredId, ProcId, PredInfo0, ProcInfo, MI0, MI) :-
pred_info_procedures(PredInfo0, Procs0),
map__set(Procs0, ProcId, ProcInfo, Procs),
pred_info_set_procedures(Procs, PredInfo0, PredInfo),
- module_info_set_pred_info(MI0, PredId, PredInfo, MI).
+ module_info_set_pred_info(PredId, PredInfo, MI0, MI).
module_info_typeids(MI, TypeCtors) :-
module_info_types(MI, Types),
@@ -887,54 +827,53 @@
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).
+module_info_set_dependency_info(DependencyInfo, MI0, MI) :-
+ module_info_set_maybe_dependency_info(yes(DependencyInfo), MI0, MI).
module_info_clobber_dependency_info(MI0, MI) :-
- module_info_set_maybe_dependency_info(MI0, no, MI).
+ module_info_set_maybe_dependency_info(no, MI0, MI).
module_info_incr_errors(MI0, MI) :-
module_info_num_errors(MI0, Errs0),
Errs = Errs0 + 1,
- module_info_set_num_errors(MI0, Errs, MI).
+ module_info_set_num_errors(Errs, MI0, MI).
-module_info_next_lambda_count(MI0, Count, MI) :-
+module_info_next_lambda_count(Count, MI0, MI) :-
module_info_get_lambda_counter(MI0, Counter0),
counter__allocate(Count, Counter0, Counter),
- module_info_set_lambda_counter(MI0, Counter, MI).
+ module_info_set_lambda_counter(Counter, MI0, MI).
-module_info_next_model_non_pragma_count(MI0, Count, MI) :-
+module_info_next_model_non_pragma_count(Count, MI0, MI) :-
module_info_get_model_non_pragma_counter(MI0, Counter0),
counter__allocate(Count, Counter0, Counter),
- module_info_set_model_non_pragma_counter(MI0, Counter, MI).
+ module_info_set_model_non_pragma_counter(Counter, MI0, MI).
% After we have finished constructing the symbol tables,
% we balance all the binary trees, to improve performance
% in later stages of the compiler.
-module_info_optimize(ModuleInfo0, ModuleInfo) :-
-
- module_info_get_predicate_table(ModuleInfo0, Preds0),
+module_info_optimize(!ModuleInfo) :-
+ module_info_get_predicate_table(!.ModuleInfo, Preds0),
predicate_table_optimize(Preds0, Preds),
- module_info_set_predicate_table(ModuleInfo0, Preds, ModuleInfo3),
+ module_info_set_predicate_table(Preds, !ModuleInfo),
- module_info_types(ModuleInfo3, Types0),
+ module_info_types(!.ModuleInfo, Types0),
map__optimize(Types0, Types),
- module_info_set_types(ModuleInfo3, Types, ModuleInfo4),
+ module_info_set_types(Types, !ModuleInfo),
- module_info_insts(ModuleInfo4, InstTable0),
+ module_info_insts(!.ModuleInfo, InstTable0),
inst_table_get_user_insts(InstTable0, Insts0),
user_inst_table_optimize(Insts0, Insts),
inst_table_set_user_insts(InstTable0, Insts, InstTable),
- module_info_set_insts(ModuleInfo4, InstTable, ModuleInfo5),
+ module_info_set_insts(InstTable, !ModuleInfo),
- module_info_modes(ModuleInfo5, Modes0),
+ module_info_modes(!.ModuleInfo, Modes0),
mode_table_optimize(Modes0, Modes),
- module_info_set_modes(ModuleInfo4, Modes, ModuleInfo6),
+ module_info_set_modes(Modes, !ModuleInfo),
- module_info_ctors(ModuleInfo6, Ctors0),
+ module_info_ctors(!.ModuleInfo, Ctors0),
map__optimize(Ctors0, Ctors),
- module_info_set_ctors(ModuleInfo6, Ctors, ModuleInfo).
+ module_info_set_ctors(Ctors, !ModuleInfo).
visible_module(VisibleModule, ModuleInfo) :-
module_info_name(ModuleInfo, ThisModule),
@@ -957,33 +896,31 @@
AllImports = (IndirectImports `set__union` DirectImports)
`set__union` set__list_to_set(Parents).
-module_add_foreign_decl(Lang, ForeignDecl, Context, Module0, Module) :-
- module_info_get_foreign_decl(Module0, ForeignDeclIndex0),
+module_add_foreign_decl(Lang, ForeignDecl, Context, !Module) :-
+ module_info_get_foreign_decl(!.Module, ForeignDeclIndex0),
% store the decls in reverse order and reverse them later
% for efficiency
- ForeignDeclIndex1 = [foreign_decl_code(Lang, ForeignDecl, Context) |
+ ForeignDeclIndex = [foreign_decl_code(Lang, ForeignDecl, Context) |
ForeignDeclIndex0],
- module_info_set_foreign_decl(Module0, ForeignDeclIndex1, Module).
+ module_info_set_foreign_decl(ForeignDeclIndex, !Module).
-module_add_foreign_import_module(Lang, ModuleName, Context, Module0, Module) :-
- module_info_get_foreign_import_module(Module0, ForeignImportIndex0),
+module_add_foreign_import_module(Lang, ModuleName, Context, !Module) :-
+ module_info_get_foreign_import_module(!.Module, ForeignImportIndex0),
% store the decls in reverse order and reverse them later
% for efficiency
- ForeignImportIndex1 =
+ ForeignImportIndex =
[foreign_import_module(Lang, ModuleName, Context) |
ForeignImportIndex0],
- module_info_set_foreign_import_module(Module0,
- ForeignImportIndex1, Module).
+ module_info_set_foreign_import_module(ForeignImportIndex, !Module).
-module_add_foreign_body_code(Lang, Foreign_Body_Code, Context,
- Module0, Module) :-
- module_info_get_foreign_body_code(Module0, Foreign_Body_List0),
+module_add_foreign_body_code(Lang, Foreign_Body_Code, Context, !Module) :-
+ module_info_get_foreign_body_code(!.Module, Foreign_Body_List0),
% store the decls in reverse order and reverse them later
% for efficiency
Foreign_Body_List =
[foreign_body_code(Lang, Foreign_Body_Code, Context) |
Foreign_Body_List0],
- module_info_set_foreign_body_code(Module0, Foreign_Body_List, Module).
+ module_info_set_foreign_body_code(Foreign_Body_List, !Module).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1009,43 +946,37 @@
:- type dependency_info(T).
:- type dependency_info == dependency_info(pred_proc_id).
-:- pred hlds_dependency_info_init(dependency_info(T)).
-:- mode hlds_dependency_info_init(out) is det.
+:- pred hlds_dependency_info_init(dependency_info(T)::out) is det.
+
+:- pred hlds_dependency_info_get_dependency_graph(dependency_info(T)::in,
+ dependency_graph(T)::out) is det.
-:- pred hlds_dependency_info_get_dependency_graph(dependency_info(T),
- dependency_graph(T)).
-:- mode hlds_dependency_info_get_dependency_graph(in, out) is det.
-
-:- pred hlds_dependency_info_get_dependency_ordering(dependency_info(T),
- dependency_ordering(T)).
-:- mode hlds_dependency_info_get_dependency_ordering(in, out) is det.
+:- pred hlds_dependency_info_get_dependency_ordering(dependency_info(T)::in,
+ dependency_ordering(T)::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(T),
- dependency_graph(T), dependency_info(T)).
-:- mode hlds_dependency_info_set_dependency_graph(in, in, out) is det.
-
-:- pred hlds_dependency_info_set_dependency_ordering(dependency_info(T),
- dependency_ordering(T), dependency_info(T)).
-:- 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.
+ dependency_info::in, maybe(aditi_dependency_ordering)::out) is det.
+
+:- pred hlds_dependency_info_set_dependency_graph(dependency_graph(T)::in,
+ dependency_info(T)::in, dependency_info(T)::out) is det.
+
+:- pred hlds_dependency_info_set_dependency_ordering(
+ dependency_ordering(T)::in,
+ dependency_info(T)::in, dependency_info(T)::out) is det.
+
+:- pred hlds_dependency_info_set_aditi_dependency_ordering(
+ aditi_dependency_ordering::in,
+ dependency_info::in, dependency_info::out) is det.
%-----------------------------------------------------------------------------%
:- implementation.
-:- type dependency_info(T) --->
- dependency_info(
- dependency_graph(T), % Dependency graph
- dependency_ordering(T), % Dependency ordering
- maybe(aditi_dependency_ordering)
+:- type dependency_info(T)
+ ---> dependency_info(
+ dep_graph :: dependency_graph(T),
+ dep_ord :: dependency_ordering(T),
+ dep_aditi_ord :: maybe(aditi_dependency_ordering)
% Dependency ordering of Aditi SCCs
).
@@ -1054,27 +985,17 @@
DepOrd = [],
DepInfo = dependency_info(DepRel, DepOrd, no).
-hlds_dependency_info_get_dependency_graph(DepInfo, A) :-
- DepInfo = dependency_info(A, _, _).
-
-hlds_dependency_info_get_dependency_ordering(DepInfo, 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, 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)).
+hlds_dependency_info_get_dependency_graph(DepInfo, DepInfo ^ dep_graph).
+hlds_dependency_info_get_dependency_ordering(DepInfo, DepInfo ^ dep_ord).
+hlds_dependency_info_get_maybe_aditi_dependency_ordering(DepInfo,
+ DepInfo ^ dep_aditi_ord).
+
+hlds_dependency_info_set_dependency_graph(DepGraph, DepInfo,
+ DepInfo ^ dep_graph := DepGraph).
+hlds_dependency_info_set_dependency_ordering(DepOrd, DepInfo,
+ DepInfo ^ dep_ord := DepOrd).
+hlds_dependency_info_set_aditi_dependency_ordering(DepOrd, DepInfo,
+ DepInfo ^ dep_aditi_ord := yes(DepOrd)).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.133
diff -u -b -r1.133 hlds_pred.m
--- compiler/hlds_pred.m 24 Oct 2003 11:29:41 -0000 1.133
+++ compiler/hlds_pred.m 29 Oct 2003 18:06:05 -0000
@@ -798,10 +798,10 @@
:- pred check_marker(pred_markers::in, marker::in) is semidet.
% add a marker to the set
-:- pred add_marker(pred_markers::in, marker::in, pred_markers::out) is det.
+:- pred add_marker(marker::in, pred_markers::in, pred_markers::out) is det.
% remove a marker from the set
-:- pred remove_marker(pred_markers::in, marker::in, pred_markers::out) is det.
+:- pred remove_marker(marker::in, pred_markers::in, pred_markers::out) is det.
% convert the set to a list
:- pred markers_to_marker_list(pred_markers::in, list(marker)::out) is det.
@@ -1380,9 +1380,9 @@
check_marker(Markers, Marker) :-
list__member(Marker, Markers).
-add_marker(Markers, Marker, [Marker | Markers]).
+add_marker(Marker, Markers, [Marker | Markers]).
-remove_marker(Markers0, Marker, Markers) :-
+remove_marker(Marker, Markers0, Markers) :-
list__delete_all(Markers0, Marker, Markers).
markers_to_marker_list(Markers, Markers).
@@ -1495,8 +1495,7 @@
module_info_get_predicate_table(ModuleInfo0, PredTable0),
predicate_table_insert(PredTable0, PredInfo, PredId,
PredTable),
- module_info_set_predicate_table(ModuleInfo0, PredTable,
- ModuleInfo),
+ module_info_set_predicate_table(PredTable, ModuleInfo0, ModuleInfo),
GoalExpr = call(PredId, ProcId, ArgVars, not_builtin, no, SymName),
Goal = GoalExpr - GoalInfo,
Index: compiler/inlining.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.112
diff -u -b -r1.112 inlining.m
--- compiler/inlining.m 24 Oct 2003 06:17:39 -0000 1.112
+++ compiler/inlining.m 29 Oct 2003 15:25:40 -0000
@@ -438,15 +438,14 @@
module_info, module_info, io__state, io__state).
:- mode inlining__in_predproc(in, in, in, in, out, di, uo) is det.
-inlining__in_predproc(PredProcId, InlinedProcs, Params,
- ModuleInfo0, ModuleInfo, IoState0, IoState) :-
+inlining__in_predproc(PredProcId, InlinedProcs, Params, !ModuleInfo, !IO) :-
VarThresh = Params ^ var_threshold,
HighLevelCode = Params ^ highlevel_code,
AnyTracing = Params ^ any_tracing,
PredProcId = proc(PredId, ProcId),
- module_info_preds(ModuleInfo0, PredTable0),
+ module_info_preds(!.ModuleInfo, PredTable0),
map__lookup(PredTable0, PredId, PredInfo0),
pred_info_procedures(PredInfo0, ProcTable0),
map__lookup(ProcTable0, ProcId, ProcInfo0),
@@ -466,7 +465,7 @@
PurityChanged0 = no,
InlineInfo0 = inline_info(VarThresh, HighLevelCode, AnyTracing,
- InlinedProcs, ModuleInfo0, UnivQTVars, Markers,
+ InlinedProcs, !.ModuleInfo, UnivQTVars, Markers,
VarSet0, VarTypes0, TypeVarSet0, TypeInfoVarMap0,
DidInlining0, Requantify0, DetChanged0, PurityChanged0),
@@ -494,11 +493,10 @@
(
DidInlining = yes,
recompute_instmap_delta_proc(yes, ProcInfo5, ProcInfo,
- ModuleInfo0, ModuleInfo1)
+ !ModuleInfo)
;
DidInlining = no,
- ProcInfo = ProcInfo5,
- ModuleInfo1 = ModuleInfo0
+ ProcInfo = ProcInfo5
),
map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
@@ -506,7 +504,7 @@
(
PurityChanged = yes,
- repuritycheck_proc(ModuleInfo1, PredProcId,
+ repuritycheck_proc(!.ModuleInfo, PredProcId,
PredInfo2, PredInfo)
;
PurityChanged = no,
@@ -514,20 +512,18 @@
),
map__det_update(PredTable0, PredId, PredInfo, PredTable),
- module_info_set_preds(ModuleInfo1, PredTable, ModuleInfo2),
+ module_info_set_preds(PredTable, !ModuleInfo),
% If the determinism of some sub-goals has changed,
% then we re-run determinism analysis, because
% propagating the determinism information through
% the procedure may lead to more efficient code.
- globals__io_get_globals(Globals, IoState0, IoState),
+ globals__io_get_globals(Globals, !IO),
(
DetChanged = yes,
- det_infer_proc(PredId, ProcId, ModuleInfo2, ModuleInfo,
- Globals, _, _, _)
+ det_infer_proc(PredId, ProcId, !ModuleInfo, Globals, _, _, _)
;
- DetChanged = no,
- ModuleInfo = ModuleInfo2
+ DetChanged = no
).
%-----------------------------------------------------------------------------%
Index: compiler/inst_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_util.m,v
retrieving revision 1.26
diff -u -b -r1.26 inst_util.m
--- compiler/inst_util.m 25 Jul 2003 02:27:20 -0000 1.26
+++ compiler/inst_util.m 29 Oct 2003 15:26:54 -0000
@@ -173,7 +173,7 @@
map__det_insert(UnifyInsts0, ThisInstPair, unknown,
UnifyInsts1),
inst_table_set_unify_insts(InstTable0, UnifyInsts1, InstTable1),
- module_info_set_insts(ModuleInfo0, InstTable1, ModuleInfo1),
+ module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1),
% unify the insts
inst_expand(ModuleInfo0, InstA, InstA2),
inst_expand(ModuleInfo0, InstB, InstB2),
@@ -194,7 +194,7 @@
map__det_update(UnifyInsts2, ThisInstPair, known(Inst1, Det),
UnifyInsts),
inst_table_set_unify_insts(InstTable2, UnifyInsts, InstTable),
- module_info_set_insts(ModuleInfo2, InstTable, ModuleInfo)
+ module_info_set_insts(InstTable, ModuleInfo2, ModuleInfo)
),
% avoid expanding recursive insts
( inst_contains_instname(Inst1, ModuleInfo, ThisInstPair) ->
@@ -938,7 +938,7 @@
GroundInsts1),
inst_table_set_ground_insts(InstTable0, GroundInsts1,
InstTable1),
- module_info_set_insts(ModuleInfo0, InstTable1, ModuleInfo1),
+ module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1),
% expand the inst name, and invoke ourself recursively on
% it's expansion
@@ -956,7 +956,7 @@
known(GroundInst, Det), GroundInsts),
inst_table_set_ground_insts(InstTable2, GroundInsts,
InstTable),
- module_info_set_insts(ModuleInfo2, InstTable, ModuleInfo)
+ module_info_set_insts(InstTable, ModuleInfo2, ModuleInfo)
),
% avoid expanding recursive insts
( inst_contains_instname(GroundInst, ModuleInfo, GroundInstKey) ->
@@ -1052,7 +1052,7 @@
AnyInsts1),
inst_table_set_any_insts(InstTable0, AnyInsts1,
InstTable1),
- module_info_set_insts(ModuleInfo0, InstTable1, ModuleInfo1),
+ module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1),
% expand the inst name, and invoke ourself recursively on
% it's expansion
@@ -1070,7 +1070,7 @@
known(AnyInst, Det), AnyInsts),
inst_table_set_any_insts(InstTable2, AnyInsts,
InstTable),
- module_info_set_insts(ModuleInfo2, InstTable, ModuleInfo)
+ module_info_set_insts(InstTable, ModuleInfo2, ModuleInfo)
),
% avoid expanding recursive insts
( inst_contains_instname(AnyInst, ModuleInfo, AnyInstKey) ->
@@ -1211,7 +1211,7 @@
map__det_insert(SharedInsts0, InstName, unknown, SharedInsts1),
inst_table_set_shared_insts(InstTable0, SharedInsts1,
InstTable1),
- module_info_set_insts(ModuleInfo0, InstTable1, ModuleInfo1),
+ module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1),
% expand the inst name, and invoke ourself recursively on
% it's expansion
@@ -1228,7 +1228,7 @@
SharedInsts),
inst_table_set_shared_insts(InstTable2, SharedInsts,
InstTable),
- module_info_set_insts(ModuleInfo2, InstTable, ModuleInfo)
+ module_info_set_insts(InstTable, ModuleInfo2, ModuleInfo)
),
% avoid expanding recursive insts
( inst_contains_instname(SharedInst, ModuleInfo, InstName) ->
@@ -1313,7 +1313,7 @@
NondetLiveInsts1),
inst_table_set_mostly_uniq_insts(InstTable0, NondetLiveInsts1,
InstTable1),
- module_info_set_insts(ModuleInfo0, InstTable1, ModuleInfo1),
+ module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1),
% expand the inst name, and invoke ourself recursively on
% it's expansion
@@ -1331,7 +1331,7 @@
known(NondetLiveInst), NondetLiveInsts),
inst_table_set_mostly_uniq_insts(InstTable2, NondetLiveInsts,
InstTable),
- module_info_set_insts(ModuleInfo2, InstTable, ModuleInfo)
+ module_info_set_insts(InstTable, ModuleInfo2, ModuleInfo)
),
% avoid expanding recursive insts
( inst_contains_instname(NondetLiveInst, ModuleInfo, InstName) ->
@@ -1413,7 +1413,7 @@
MergeInstTable1),
inst_table_set_merge_insts(InstTable0, MergeInstTable1,
InstTable1),
- module_info_set_insts(ModuleInfo0, InstTable1, ModuleInfo1),
+ module_info_set_insts(InstTable1, ModuleInfo0, ModuleInfo1),
% merge the insts
inst_merge_2(InstA, InstB, MaybeType, ModuleInfo1, Inst0,
@@ -1427,7 +1427,7 @@
MergeInstTable3),
inst_table_set_merge_insts(InstTable2, MergeInstTable3,
InstTable3),
- module_info_set_insts(ModuleInfo2, InstTable3, ModuleInfo)
+ module_info_set_insts(InstTable3, ModuleInfo2, ModuleInfo)
),
% avoid expanding recursive insts
( inst_contains_instname(Inst0, ModuleInfo, merge_inst(InstA, InstB)) ->
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.149
diff -u -b -r1.149 intermod.m
--- compiler/intermod.m 24 Oct 2003 11:29:41 -0000 1.149
+++ compiler/intermod.m 30 Oct 2003 03:52:15 -0000
@@ -299,8 +299,8 @@
PredInfo0, PredInfo) },
{ map__det_update(PredTable0, PredId,
PredInfo, PredTable) },
- { module_info_set_preds(ModuleInfo0, PredTable,
- ModuleInfo) },
+ { module_info_set_preds(PredTable,
+ ModuleInfo0, ModuleInfo) },
intermod_info_get_preds(Preds0),
( { pred_info_pragma_goal_type(PredInfo) } ->
% The header code must be written since
@@ -1148,7 +1148,7 @@
module_info_pred_info(ModuleInfo, UnifyPredId, UnifyPredInfo),
pred_info_arg_types(UnifyPredInfo, TVarSet, _, ArgTypes),
init_markers(Markers0),
- add_marker(Markers0, calls_are_fully_qualified, Markers),
+ add_marker(calls_are_fully_qualified, Markers0, Markers),
typecheck__resolve_pred_overloading(ModuleInfo, Markers, ArgTypes,
TVarSet, Pred0, Pred, UserEqPredId),
intermod__add_proc(UserEqPredId, _, Info0, Info).
@@ -2026,13 +2026,12 @@
:- pred adjust_type_status(module_info::in, module_info::out) is det.
-adjust_type_status(ModuleInfo0, ModuleInfo) :-
- module_info_types(ModuleInfo0, Types0),
+adjust_type_status(!ModuleInfo) :-
+ module_info_types(!.ModuleInfo, Types0),
map__to_assoc_list(Types0, TypesAL0),
- list__map_foldl(adjust_type_status_2, TypesAL0, TypesAL,
- ModuleInfo0, ModuleInfo1),
+ list__map_foldl(adjust_type_status_2, TypesAL0, TypesAL, !ModuleInfo),
map__from_assoc_list(TypesAL, Types),
- module_info_set_types(ModuleInfo1, Types, ModuleInfo).
+ module_info_set_types(Types, !ModuleInfo).
:- pred adjust_type_status_2(pair(type_ctor, hlds_type_defn)::in,
pair(type_ctor, hlds_type_defn)::out,
@@ -2062,13 +2061,12 @@
:- pred adjust_class_status(module_info::in, module_info::out) is det.
-adjust_class_status(ModuleInfo0, ModuleInfo) :-
- module_info_classes(ModuleInfo0, Classes0),
+adjust_class_status(!ModuleInfo) :-
+ module_info_classes(!.ModuleInfo, Classes0),
map__to_assoc_list(Classes0, ClassAL0),
- list__map_foldl(adjust_class_status_2, ClassAL0, ClassAL,
- ModuleInfo0, ModuleInfo1),
+ list__map_foldl(adjust_class_status_2, ClassAL0, ClassAL, !ModuleInfo),
map__from_assoc_list(ClassAL, Classes),
- module_info_set_classes(ModuleInfo1, Classes, ModuleInfo).
+ module_info_set_classes(Classes, !ModuleInfo).
:- pred adjust_class_status_2(pair(class_id, hlds_class_defn)::in,
pair(class_id, hlds_class_defn)::out,
@@ -2105,13 +2103,13 @@
:- pred adjust_instance_status(module_info::in, module_info::out) is det.
-adjust_instance_status(ModuleInfo0, ModuleInfo) :-
- module_info_instances(ModuleInfo0, Instances0),
+adjust_instance_status(!ModuleInfo) :-
+ module_info_instances(!.ModuleInfo, Instances0),
map__to_assoc_list(Instances0, InstanceAL0),
list__map_foldl(adjust_instance_status_2, InstanceAL0, InstanceAL,
- ModuleInfo0, ModuleInfo1),
+ !ModuleInfo),
map__from_assoc_list(InstanceAL, Instances),
- module_info_set_instances(ModuleInfo1, Instances, ModuleInfo).
+ module_info_set_instances(Instances, !ModuleInfo).
:- pred adjust_instance_status_2(pair(class_id, list(hlds_instance_defn))::in,
pair(class_id, list(hlds_instance_defn))::out,
@@ -2152,10 +2150,10 @@
:- pred set_list_of_preds_exported(list(pred_id)::in, module_info::in,
module_info::out) is det.
-set_list_of_preds_exported(PredIds, ModuleInfo0, ModuleInfo) :-
- module_info_preds(ModuleInfo0, Preds0),
+set_list_of_preds_exported(PredIds, !ModuleInfo) :-
+ module_info_preds(!.ModuleInfo, Preds0),
set_list_of_preds_exported_2(PredIds, Preds0, Preds),
- module_info_set_preds(ModuleInfo0, Preds, ModuleInfo).
+ module_info_set_preds(Preds, !ModuleInfo).
:- pred set_list_of_preds_exported_2(list(pred_id)::in, pred_table::in,
pred_table::out) is det.
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.84
diff -u -b -r1.84 lambda.m
--- compiler/lambda.m 24 Oct 2003 06:17:40 -0000 1.84
+++ compiler/lambda.m 30 Oct 2003 07:27:54 -0000
@@ -162,21 +162,21 @@
:- pred lambda__process_proc(pred_id, proc_id, module_info, module_info).
:- mode lambda__process_proc(in, in, in, out) is det.
-lambda__process_proc(PredId, ProcId, ModuleInfo0, ModuleInfo) :-
- module_info_preds(ModuleInfo0, PredTable0),
+lambda__process_proc(PredId, ProcId, !ModuleInfo) :-
+ module_info_preds(!.ModuleInfo, PredTable0),
map__lookup(PredTable0, PredId, PredInfo0),
pred_info_procedures(PredInfo0, ProcTable0),
map__lookup(ProcTable0, ProcId, ProcInfo0),
lambda__process_proc_2(ProcInfo0, ProcInfo, PredInfo0, PredInfo1,
- ModuleInfo0, ModuleInfo1),
+ !ModuleInfo),
pred_info_procedures(PredInfo1, ProcTable1),
map__det_update(ProcTable1, ProcId, ProcInfo, ProcTable),
pred_info_set_procedures(ProcTable, PredInfo1, PredInfo),
- module_info_preds(ModuleInfo1, PredTable1),
+ module_info_preds(!.ModuleInfo, PredTable1),
map__det_update(PredTable1, PredId, PredInfo, PredTable),
- module_info_set_preds(ModuleInfo1, PredTable, ModuleInfo).
+ module_info_set_preds(PredTable, !ModuleInfo).
:- pred lambda__process_proc_2(proc_info::in, proc_info::out,
pred_info::in, pred_info::out, module_info::in, module_info::out)
@@ -453,8 +453,9 @@
%
proc_info_set_address_taken(address_is_taken,
Call_ProcInfo, Call_NewProcInfo),
- module_info_set_pred_proc_info(ModuleInfo0, PredId, ProcId,
- Call_PredInfo, Call_NewProcInfo, ModuleInfo)
+ module_info_set_pred_proc_info(PredId, ProcId,
+ Call_PredInfo, Call_NewProcInfo,
+ ModuleInfo0, ModuleInfo)
;
% Prepare to create a new predicate for the lambda
% expression: work out the arguments, module name, predicate
@@ -465,8 +466,8 @@
list__append(ArgVars, Vars, AllArgVars),
module_info_name(ModuleInfo0, ModuleName),
- module_info_next_lambda_count(ModuleInfo0, LambdaCount,
- ModuleInfo1),
+ module_info_next_lambda_count(LambdaCount,
+ ModuleInfo0, ModuleInfo1),
goal_info_get_context(LambdaGoalInfo, OrigContext),
term__context_line(OrigContext, OrigLine),
make_pred_name_with_context(ModuleName, "IntroducedFrom",
@@ -521,7 +522,7 @@
->
markers_to_marker_list(Markers, MarkerList0),
list__filter(
- lambda([Marker::in] is semidet,
+ (pred(Marker::in) is semidet :-
% Pass through only Aditi markers.
% Don't pass through `context' markers, since
% they are useless for non-recursive predicates
@@ -535,13 +536,12 @@
; Marker = aditi_no_memo
)),
MarkerList0, MarkerList),
- LambdaMarkers = list__foldl((func(LMs0, Mrk) = LMs :-
- add_marker(Mrk, LMs0, LMs)),
- MarkerList, LambdaMarkers0)
+ list__foldl(add_marker, MarkerList,
+ LambdaMarkers0, LambdaMarkers)
;
EvalMethod = (aditi_bottom_up)
->
- add_marker(LambdaMarkers0, aditi, LambdaMarkers)
+ add_marker(aditi, LambdaMarkers0, LambdaMarkers)
;
LambdaMarkers = LambdaMarkers0
),
@@ -573,8 +573,8 @@
module_info_get_predicate_table(ModuleInfo1, PredicateTable0),
predicate_table_insert(PredicateTable0, PredInfo,
PredId, PredicateTable),
- module_info_set_predicate_table(ModuleInfo1, PredicateTable,
- ModuleInfo)
+ module_info_set_predicate_table(PredicateTable,
+ ModuleInfo1, ModuleInfo)
),
ConsId = pred_const(PredId, ProcId, EvalMethod),
Functor = functor(ConsId, no, ArgVars),
Index: compiler/loop_inv.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/loop_inv.m,v
retrieving revision 1.5
diff -u -b -r1.5 loop_inv.m
--- compiler/loop_inv.m 24 Oct 2003 06:17:41 -0000 1.5
+++ compiler/loop_inv.m 29 Oct 2003 15:30:03 -0000
@@ -850,8 +850,8 @@
mode_util__recompute_instmap_delta_proc(no, AuxProcInfo2, AuxProcInfo,
ModuleInfo0, ModuleInfo1),
- hlds_module__module_info_set_pred_proc_info(ModuleInfo1,
- AuxPredId, AuxProcId, AuxPredInfo, AuxProcInfo, ModuleInfo).
+ hlds_module__module_info_set_pred_proc_info(AuxPredId, AuxProcId,
+ AuxPredInfo, AuxProcInfo, ModuleInfo1, ModuleInfo).
%------------------------------------------------------------------------------%
@@ -963,8 +963,8 @@
mode_util__recompute_instmap_delta_proc(no, ProcInfo2, ProcInfo,
ModuleInfo0, ModuleInfo1),
- hlds_module__module_info_set_pred_proc_info(ModuleInfo1, PredId, ProcId,
- PredInfo0, ProcInfo, ModuleInfo).
+ hlds_module__module_info_set_pred_proc_info(PredId, ProcId,
+ PredInfo0, ProcInfo, ModuleInfo1, ModuleInfo).
%------------------------------------------------------------------------------%
Index: compiler/magic.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/magic.m,v
retrieving revision 1.38
diff -u -b -r1.38 magic.m
--- compiler/magic.m 24 Oct 2003 06:17:41 -0000 1.38
+++ compiler/magic.m 30 Oct 2003 03:43:12 -0000
@@ -390,19 +390,19 @@
:- pred magic__update_pred_status(pred_id::in,
magic_info::in, magic_info::out) is det.
-magic__update_pred_status(PredId) -->
- magic_info_get_module_info(ModuleInfo0),
- { module_info_pred_info(ModuleInfo0, PredId, PredInfo0) },
- { pred_info_get_markers(PredInfo0, Markers0) },
- ( { check_marker(Markers0, aditi) } ->
- { remove_marker(Markers0, aditi, Markers1) },
- { remove_marker(Markers1, base_relation, Markers) },
- { pred_info_set_markers(Markers, PredInfo0, PredInfo) },
- { module_info_set_pred_info(ModuleInfo0,
- PredId, PredInfo, ModuleInfo) },
- magic_info_set_module_info(ModuleInfo)
+magic__update_pred_status(PredId, !MagicInfo) :-
+ magic_info_get_module_info(ModuleInfo0, !MagicInfo),
+ module_info_pred_info(ModuleInfo0, PredId, PredInfo0),
+ pred_info_get_markers(PredInfo0, Markers0),
+ ( check_marker(Markers0, aditi) ->
+ remove_marker(aditi, Markers0, Markers1),
+ remove_marker(base_relation, Markers1, Markers),
+ pred_info_set_markers(Markers, PredInfo0, PredInfo),
+ module_info_set_pred_info(PredId, PredInfo,
+ ModuleInfo0, ModuleInfo),
+ magic_info_set_module_info(ModuleInfo, !MagicInfo)
;
- []
+ true
).
%-----------------------------------------------------------------------------%
@@ -545,8 +545,8 @@
PredInfo1, PredInfo) },
{ proc_info_set_argmodes(ArgModes, ProcInfo0, ProcInfo1) },
{ proc_info_set_headvars(HeadVars, ProcInfo1, ProcInfo) },
- { module_info_set_pred_proc_info(ModuleInfo0,
- PredProcId, PredInfo, ProcInfo, ModuleInfo) },
+ { module_info_set_pred_proc_info(PredProcId, PredInfo, ProcInfo,
+ ModuleInfo0, ModuleInfo) },
magic_info_set_module_info(ModuleInfo),
magic__interface_from_c([CPredProcId], CPredProcId, PredProcId).
@@ -668,8 +668,8 @@
{ module_info_get_predicate_table(ModuleInfo1, PredTable0) },
{ predicate_table_insert(PredTable0, NewPredInfo, NewPredId,
PredTable) },
- { module_info_set_predicate_table(ModuleInfo0, PredTable,
- ModuleInfo) },
+ { module_info_set_predicate_table(PredTable,
+ ModuleInfo0, ModuleInfo) },
magic_info_set_module_info(ModuleInfo),
%
@@ -827,8 +827,8 @@
MagicTypes, MagicModes, LocalAditiPredProcId)
;
magic_info_get_module_info(ModuleInfo5),
- { module_info_set_pred_proc_info(ModuleInfo5, AditiPredProcId,
- PredInfo, ProcInfo, ModuleInfo) },
+ { module_info_set_pred_proc_info(AditiPredProcId,
+ PredInfo, ProcInfo, ModuleInfo5, ModuleInfo) },
magic_info_set_module_info(ModuleInfo),
{ LocalAditiPredProcId = AditiPredProcId }
),
@@ -932,8 +932,9 @@
{ pred_info_set_import_status(exported,
ExportedPredInfo2, ExportedPredInfo) },
magic_info_get_module_info(ModuleInfo5),
- { module_info_set_pred_proc_info(ModuleInfo5, AditiPredProcId,
- ExportedPredInfo, ExportedProcInfo, ModuleInfo6) },
+ { module_info_set_pred_proc_info(AditiPredProcId,
+ ExportedPredInfo, ExportedProcInfo,
+ ModuleInfo5, ModuleInfo6) },
magic_info_set_module_info(ModuleInfo6).
%-----------------------------------------------------------------------------%
@@ -999,8 +1000,8 @@
->
{ pred_info_set_import_status(exported,
PredInfo0, PredInfo1) },
- { module_info_set_pred_proc_info(ModuleInfo0, CPredProcId,
- PredInfo1, ProcInfo0, ModuleInfo1) },
+ { module_info_set_pred_proc_info(CPredProcId,
+ PredInfo1, ProcInfo0, ModuleInfo0, ModuleInfo1) },
magic_info_set_module_info(ModuleInfo1)
;
{ PredInfo1 = PredInfo0 },
@@ -1019,8 +1020,8 @@
%
{ true_goal(Goal) },
{ proc_info_set_goal(Goal, ProcInfo0, ProcInfo) },
- { module_info_set_pred_proc_info(ModuleInfo1, CPredProcId,
- PredInfo1, ProcInfo, ModuleInfo) },
+ { module_info_set_pred_proc_info(CPredProcId,
+ PredInfo1, ProcInfo, ModuleInfo1, ModuleInfo) },
magic_info_set_module_info(ModuleInfo)
;
{ magic__create_input_join_proc(CPredProcId, AditiPredProcId,
@@ -1133,24 +1134,23 @@
conj_list_to_goal([InputGoal, CallGoal | Tests], GoalInfo,
JoinGoal),
proc_info_set_goal(JoinGoal, JoinProcInfo4, JoinProcInfo),
- module_info_set_pred_proc_info(ModuleInfo1, JoinPredProcId,
- JoinPredInfo, JoinProcInfo, ModuleInfo).
+ module_info_set_pred_proc_info(JoinPredProcId,
+ JoinPredInfo, JoinProcInfo, ModuleInfo1, ModuleInfo).
:- pred magic__build_join_pred_info(pred_proc_id::in, pred_info::in,
proc_info::in, list(prog_var)::in, pred_proc_id::out,
pred_info::out, module_info::in, module_info::out) is det.
magic__build_join_pred_info(CPredProcId, CPredInfo, JoinProcInfo,
- Args, JoinPredProcId, JoinPredInfo1,
- ModuleInfo0, ModuleInfo) :-
+ Args, JoinPredProcId, JoinPredInfo, !ModuleInfo) :-
proc_info_vartypes(JoinProcInfo, JoinVarTypes),
map__apply_to_list(Args, JoinVarTypes, NewArgTypes),
PredModule = pred_info_module(CPredInfo),
- rl__get_c_interface_proc_name(ModuleInfo0, CPredProcId, NewPredName),
+ rl__get_c_interface_proc_name(!.ModuleInfo, CPredProcId, NewPredName),
init_markers(Markers0),
- add_marker(Markers0, aditi, Markers1),
- add_marker(Markers1, aditi_no_memo, Markers2),
- add_marker(Markers2, naive, Markers),
+ add_marker(aditi, Markers0, Markers1),
+ add_marker(aditi_no_memo, Markers1, Markers2),
+ add_marker(naive, Markers2, Markers),
ClassContext = constraints([], []),
pred_info_get_aditi_owner(CPredInfo, User),
varset__init(TVarSet), % must be empty.
@@ -1160,12 +1160,12 @@
pred_info_create(PredModule, qualified(PredModule, NewPredName),
TVarSet, ExistQVars, NewArgTypes, true, DummyContext,
exported, Markers, predicate, ClassContext, User, Assertions,
- JoinProcInfo, JoinProcId, JoinPredInfo1),
+ JoinProcInfo, JoinProcId, JoinPredInfo),
- module_info_get_predicate_table(ModuleInfo0, Preds0),
- predicate_table_insert(Preds0, JoinPredInfo1, JoinPredId, Preds),
+ module_info_get_predicate_table(!.ModuleInfo, Preds0),
+ predicate_table_insert(Preds0, JoinPredInfo, JoinPredId, Preds),
JoinPredProcId = proc(JoinPredId, JoinProcId),
- module_info_set_predicate_table(ModuleInfo0, Preds, ModuleInfo).
+ module_info_set_predicate_table(Preds, !ModuleInfo).
%-----------------------------------------------------------------------------%
@@ -1302,8 +1302,8 @@
{ module_info_get_predicate_table(ModuleInfo0, PredTable0) },
{ predicate_table_insert(PredTable0,
MagicPredInfo, MagicPredId, PredTable) },
- { module_info_set_predicate_table(ModuleInfo0, PredTable,
- ModuleInfo) },
+ { module_info_set_predicate_table(PredTable,
+ ModuleInfo0, ModuleInfo) },
magic_info_set_module_info(ModuleInfo),
% Record that the magic predicate in the magic_info.
@@ -1718,8 +1718,8 @@
{ proc_info_set_goal(Goal, ProcInfo1, ProcInfo) },
magic_info_get_module_info(ModuleInfo1),
- { module_info_set_pred_proc_info(ModuleInfo1, PredProcId,
- PredInfo, ProcInfo, ModuleInfo) },
+ { module_info_set_pred_proc_info(PredProcId,
+ PredInfo, ProcInfo, ModuleInfo1, ModuleInfo) },
magic_info_set_module_info(ModuleInfo)
).
Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.32
diff -u -b -r1.32 magic_util.m
--- compiler/magic_util.m 24 Oct 2003 06:17:41 -0000 1.32
+++ compiler/magic_util.m 30 Oct 2003 03:54:00 -0000
@@ -953,7 +953,7 @@
{ pred_info_set_procedures(MagicProcs,
MagicPredInfo0, MagicPredInfo) },
{ map__det_update(Preds0, MagicPredId, MagicPredInfo, Preds) },
- { module_info_set_preds(ModuleInfo0, Preds, ModuleInfo) },
+ { module_info_set_preds(Preds, ModuleInfo0, ModuleInfo) },
magic_info_set_module_info(ModuleInfo).
%-----------------------------------------------------------------------------%
@@ -1092,10 +1092,7 @@
{ proc_info_inst_varset(ProcInfo, InstVarSet) },
{ pred_info_get_aditi_owner(PredInfo, Owner) },
{ pred_info_get_markers(PredInfo, Markers0) },
- { AddMarkers = lambda([Marker::in, Ms0::in, Ms::out] is det,
- add_marker(Ms0, Marker, Ms)
- ) },
- { list__foldl(AddMarkers, ExtraMarkers, Markers0, Markers) },
+ { list__foldl(add_marker, ExtraMarkers, Markers0, Markers) },
% Add the predicate to the predicate table.
{ conj_list_to_goal(Goals, GoalInfo, SuppGoal) },
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.448
diff -u -b -r1.448 make_hlds.m
--- compiler/make_hlds.m 24 Oct 2003 06:17:41 -0000 1.448
+++ compiler/make_hlds.m 30 Oct 2003 15:16:45 -0000
@@ -50,30 +50,28 @@
prog_context, is_address_taken, pred_info, proc_id).
:- mode add_new_proc(in, in, in, in, in, in, in, in, in, out, out) is det.
- % add_special_pred_for_real(SpecialPredId, ModuleInfo0, TVarSet,
- % Type, TypeCtor, TypeBody, TypeContext, TypeStatus, ModuleInfo).
+ % add_special_pred_for_real(SpecialPredId, TVarSet, Type, TypeCtor,
+ % TypeBody, TypeContext, TypeStatus, !ModuleInfo).
%
% Add declarations and clauses for a special predicate.
% This is used by unify_proc.m to add a unification predicate
% for an imported type for which special predicates are being
% generated only when a unification procedure is requested
% during mode analysis.
-:- pred add_special_pred_for_real(special_pred_id,
- module_info, tvarset, type, type_ctor, hlds_type_body,
- prog_context, import_status, module_info).
-:- mode add_special_pred_for_real(in, in, in, in, in, in, in, in, out) is det.
+:- pred add_special_pred_for_real(special_pred_id::in, tvarset::in, (type)::in,
+ type_ctor::in, hlds_type_body::in, prog_context::in, import_status::in,
+ module_info::in, module_info::out) is det.
- % add_special_pred_decl_for_real(SpecialPredId, ModuleInfo0, TVarSet,
- % Type, TypeCtor, TypeContext, TypeStatus, ModuleInfo).
+ % add_special_pred_decl_for_real(SpecialPredId, TVarSet,
+ % Type, TypeCtor, TypeContext, TypeStatus, !ModuleInfo).
%
% Add declarations for a special predicate.
% This is used by higher_order.m when specializing an in-in
% unification for an imported type for which unification procedures
% are generated lazily.
-:- pred add_special_pred_decl_for_real(special_pred_id,
- module_info, tvarset, type, type_ctor, prog_context,
- import_status, module_info).
-:- mode add_special_pred_decl_for_real(in, in, in, in, in, in, in, out) is det.
+:- pred add_special_pred_decl_for_real(special_pred_id::in,
+ tvarset::in, (type)::in, type_ctor::in, prog_context::in,
+ import_status::in, module_info::in, module_info::out) is det.
:- type qual_info.
@@ -83,8 +81,7 @@
:- pred produce_instance_method_clauses(instance_proc_def::in,
pred_or_func::in, arity::in, list(type)::in, pred_markers::in,
term__context::in, import_status::in, clauses_info::out,
- module_info::in, module_info::out,
- qual_info::in, qual_info::out,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
io__state::di, io__state::uo) is det.
% Move the recompilation_info from the qual_info to the module_info
@@ -140,20 +137,20 @@
:- import_module bag, term, varset, getopt, assoc_list, term_io.
parse_tree_to_hlds(module(Name, Items), MQInfo0, EqvMap, Module, QualInfo,
- InvalidTypes, InvalidModes) -->
- globals__io_get_globals(Globals),
- { mq_info_get_partial_qualifier_info(MQInfo0, PQInfo) },
- { module_info_init(Name, Items, Globals, PQInfo, no, Module0) },
+ InvalidTypes, InvalidModes, !IO) :-
+ globals__io_get_globals(Globals, !IO),
+ mq_info_get_partial_qualifier_info(MQInfo0, PQInfo),
+ module_info_init(Name, Items, Globals, PQInfo, no, Module0),
add_item_list_decls_pass_1(Items,
item_status(local, may_be_unqualified), Module0, Module1,
- no, InvalidModes0),
- globals__io_lookup_bool_option(statistics, Statistics),
- maybe_report_stats(Statistics),
+ no, InvalidModes0, !IO),
+ globals__io_lookup_bool_option(statistics, Statistics, !IO),
+ maybe_report_stats(Statistics, !IO),
check_for_errors(
add_item_list_decls_pass_2(Items,
item_status(local, may_be_unqualified)),
- InvalidTypes1, Module1, Module2),
+ InvalidTypes1, Module1, Module2, !IO),
% Add constructors and special preds to the HLDS.
% This must be done after adding all type and
@@ -161,37 +158,37 @@
% If there were errors in foreign type type declarations,
% doing this may cause a compiler abort.
(
- { InvalidTypes1 = no },
- { module_info_types(Module2, Types) },
- map__foldl2(process_type_defn, Types,
- {no, Module2}, {InvalidTypes2, Module3})
+ InvalidTypes1 = no,
+ module_info_types(Module2, Types),
+ map__foldl3(process_type_defn, Types,
+ no, InvalidTypes2, Module2, Module3, !IO)
;
- { InvalidTypes1 = yes },
- { InvalidTypes2 = yes },
- { Module3 = Module2 }
+ InvalidTypes1 = yes,
+ InvalidTypes2 = yes,
+ Module3 = Module2
),
- maybe_report_stats(Statistics),
+ maybe_report_stats(Statistics, !IO),
% balance the binary trees
- { module_info_optimize(Module3, Module4) },
- maybe_report_stats(Statistics),
- { init_qual_info(MQInfo0, EqvMap, QualInfo0) },
+ module_info_optimize(Module3, Module4),
+ maybe_report_stats(Statistics, !IO),
+ init_qual_info(MQInfo0, EqvMap, QualInfo0),
add_item_list_clauses(Items, local, Module4, Module5,
- QualInfo0, QualInfo),
+ QualInfo0, QualInfo, !IO),
- { qual_info_get_mq_info(QualInfo, MQInfo) },
- { mq_info_get_type_error_flag(MQInfo, InvalidTypes3) },
- { InvalidTypes = InvalidTypes1 `or` InvalidTypes2 `or` InvalidTypes3 },
- { mq_info_get_mode_error_flag(MQInfo, InvalidModes1) },
- { InvalidModes = InvalidModes0 `or` InvalidModes1 },
- { mq_info_get_num_errors(MQInfo, MQ_NumErrors) },
-
- { module_info_num_errors(Module5, NumErrors5) },
- { NumErrors = NumErrors5 + MQ_NumErrors },
- { module_info_set_num_errors(Module5, NumErrors, Module6) },
+ qual_info_get_mq_info(QualInfo, MQInfo),
+ mq_info_get_type_error_flag(MQInfo, InvalidTypes3),
+ InvalidTypes = InvalidTypes1 `or` InvalidTypes2 `or` InvalidTypes3,
+ mq_info_get_mode_error_flag(MQInfo, InvalidModes1),
+ InvalidModes = InvalidModes0 `or` InvalidModes1,
+ mq_info_get_num_errors(MQInfo, MQ_NumErrors),
+
+ module_info_num_errors(Module5, NumErrors5),
+ NumErrors = NumErrors5 + MQ_NumErrors,
+ module_info_set_num_errors(NumErrors, Module5, Module6),
% the predid list is constructed in reverse order, for
% efficiency, so we return it to the correct order here.
- { module_info_reverse_predids(Module6, Module) }.
+ module_info_reverse_predids(Module6, Module).
:- pred check_for_errors(pred(module_info, module_info, io__state, io__state),
bool, module_info, module_info, io__state, io__state).
@@ -237,8 +234,8 @@
--> [].
add_item_list_decls_pass_1([Item - Context | Items], Status0, Module0, Module,
InvalidModes0, InvalidModes) -->
- add_item_decl_pass_1(Item, Context, Status0, Module0,
- Status1, Module1, InvalidModes1),
+ add_item_decl_pass_1(Item, Context, Status0, Status1, Module0,
+ Module1, InvalidModes1),
{ InvalidModes2 = bool__or(InvalidModes0, InvalidModes1) },
add_item_list_decls_pass_1(Items, Status1, Module1, Module,
InvalidModes2, InvalidModes).
@@ -261,15 +258,14 @@
% processed all the mode declarations, since otherwise we can't be
% sure that there isn't a mode declaration for the function.
-:- pred add_item_list_decls_pass_2(item_list, item_status,
- module_info, module_info, io__state, io__state).
-:- mode add_item_list_decls_pass_2(in, in, in, out, di, uo) is det.
+:- pred add_item_list_decls_pass_2(item_list::in, item_status::in,
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
-add_item_list_decls_pass_2([], _, Module, Module) --> [].
-add_item_list_decls_pass_2([Item - Context | Items], Status0, Module0, Module)
- -->
- add_item_decl_pass_2(Item, Context, Status0, Module0, Status1, Module1),
- add_item_list_decls_pass_2(Items, Status1, Module1, Module).
+add_item_list_decls_pass_2([], _, !Module, !IO).
+add_item_list_decls_pass_2([Item - Context | Items], Status0, !Module, !IO) :-
+ add_item_decl_pass_2(Item, Context, Status0, Status1, !Module, !IO),
+ add_item_list_decls_pass_2(Items, Status1, !Module, !IO).
% pass 3:
% Add the clauses one by one to the module.
@@ -278,190 +274,169 @@
% Check that the declarations for field extraction
% and update functions are sensible.
-:- pred add_item_list_clauses(item_list, import_status, module_info,
- module_info, qual_info, qual_info, io__state, io__state).
-:- mode add_item_list_clauses(in, in, in, out, in, out, di, uo) is det.
+:- pred add_item_list_clauses(item_list::in, import_status::in, module_info::in,
+ module_info::out, qual_info::in, qual_info::out,
+ io__state::di, io__state::uo) is det.
-add_item_list_clauses([], _Status, Module, Module, Info, Info) --> [].
-add_item_list_clauses([Item - Context | Items], Status0,
- Module0, Module, Info0, Info) -->
- add_item_clause(Item, Status0, Status1, Context,
- Module0, Module1, Info0, Info1),
- add_item_list_clauses(Items, Status1, Module1, Module, Info1, Info).
+add_item_list_clauses([], _Status, !Module, !Info, !IO).
+add_item_list_clauses([Item - Context | Items], Status0, !Module, !Info,
+ !IO) :-
+ add_item_clause(Item, Status0, Status1, Context, !Module, !Info, !IO),
+ add_item_list_clauses(Items, Status1, !Module, !Info, !IO).
%-----------------------------------------------------------------------------%
% The bool records whether any cyclic insts or modes were
% detected.
-:- pred add_item_decl_pass_1(item, prog_context, item_status, module_info,
- item_status, module_info, bool, io__state, io__state).
-:- mode add_item_decl_pass_1(in, in, in, in, out, out, out, di, uo) is det.
+:- pred add_item_decl_pass_1(item::in, prog_context::in,
+ item_status::in, item_status::out, module_info::in, module_info::out,
+ bool::out, io__state::di, io__state::uo) is det.
% Dispatch on the different types of items.
% skip clauses
-add_item_decl_pass_1(clause(_, _, _, _, _), _, Status, Module,
- Status, Module, no) --> [].
+add_item_decl_pass_1(clause(_, _, _, _, _), _, !Status, !Module, no, !IO).
-add_item_decl_pass_1(type_defn(_, _, _, _, _), _, Status, Module,
- Status, Module, no) --> [].
+add_item_decl_pass_1(type_defn(_, _, _, _, _), _, !Status, !Module, no, !IO).
add_item_decl_pass_1(inst_defn(VarSet, Name, Params, InstDefn, Cond), Context,
- Status, Module0, Status, Module, InvalidMode) -->
- module_add_inst_defn(Module0, VarSet, Name, Params,
- InstDefn, Cond, Context, Status, Module, InvalidMode).
+ !Status, !Module, InvalidMode, !IO) :-
+ module_add_inst_defn(VarSet, Name, Params, InstDefn, Cond, Context,
+ !.Status, !Module, InvalidMode, !IO).
add_item_decl_pass_1(mode_defn(VarSet, Name, Params, ModeDefn, Cond), Context,
- Status, Module0, Status, Module, InvalidMode) -->
- module_add_mode_defn(Module0, VarSet, Name, Params, ModeDefn,
- Cond, Context, Status, Module, InvalidMode).
+ !Status, !Module, InvalidMode, !IO) :-
+ module_add_mode_defn(VarSet, Name, Params, ModeDefn,
+ Cond, Context, !.Status, !Module, InvalidMode, !IO).
add_item_decl_pass_1(pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
PredOrFunc, PredName, TypesAndModes, _WithType, _WithInst,
MaybeDet, Cond, Purity, ClassContext),
- Context, Status, Module0, Status, Module, no) -->
- { init_markers(Markers) },
- module_add_pred_or_func(Module0, TypeVarSet, InstVarSet, ExistQVars,
- PredOrFunc, PredName, TypesAndModes, MaybeDet, Cond,
- Purity, ClassContext, Markers, Context, Status, _, Module).
+ Context, !Status, !Module, no, !IO) :-
+ init_markers(Markers),
+ module_add_pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
+ PredOrFunc, PredName, TypesAndModes, MaybeDet, Cond, Purity,
+ ClassContext, Markers, Context, !.Status, _, !Module, !IO).
-add_item_decl_pass_1(
- pred_or_func_mode(VarSet, MaybePredOrFunc, PredName,
+add_item_decl_pass_1(pred_or_func_mode(VarSet, MaybePredOrFunc, PredName,
Modes, _WithInst, MaybeDet, Cond),
- Context, Status, Module0, Status, Module, no) -->
- ( { MaybePredOrFunc = yes(PredOrFunc) } ->
- { Status = item_status(ImportStatus, _) },
- { IsClassMethod = no },
- module_add_mode(Module0, VarSet, PredName, Modes,
- MaybeDet, Cond, ImportStatus, Context, PredOrFunc,
- IsClassMethod, _, Module)
+ Context, !Status, !Module, no, !IO) :-
+ ( MaybePredOrFunc = yes(PredOrFunc) ->
+ !.Status = item_status(ImportStatus, _),
+ IsClassMethod = no,
+ module_add_mode(VarSet, PredName, Modes, MaybeDet, Cond,
+ ImportStatus, Context, PredOrFunc, IsClassMethod, _,
+ !Module, !IO)
;
% equiv_type.m should have either set the pred_or_func
% or removed the item from the list.
- { unexpected(this_file,
- "add_item_decl_pass_1: no pred_or_func on mode declaration") }
+ unexpected(this_file, "add_item_decl_pass_1: " ++
+ "no pred_or_func on mode declaration")
).
-add_item_decl_pass_1(pragma(_), _, Status, Module, Status, Module, no) --> [].
+add_item_decl_pass_1(pragma(_), _, !Status, !Module, no, !IO).
-add_item_decl_pass_1(promise(_, _, _, _), _, Status, Module, Status, Module,
- no) --> [].
+add_item_decl_pass_1(promise(_, _, _, _), _, !Status, !Module, no, !IO).
add_item_decl_pass_1(module_defn(_VarSet, ModuleDefn), Context,
- Status0, Module0, Status, Module, no) -->
- ( { module_defn_update_import_status(ModuleDefn, Status1) } ->
- { Status = Status1 },
- { Module = Module0 }
- ; { ModuleDefn = import(module(Specifiers)) } ->
- { Status = Status0 },
- { Status = item_status(IStat, _) },
+ !Status, !Module, no, !IO) :-
+ ( module_defn_update_import_status(ModuleDefn, Status1) ->
+ !:Status = Status1
+ ; ModuleDefn = import(module(Specifiers)) ->
+ !.Status = item_status(IStat, _),
(
- { status_defined_in_this_module(IStat, yes)
+ ( status_defined_in_this_module(IStat, yes)
; IStat = imported(ancestor)
- }
+ )
->
- { module_add_imported_module_specifiers(Specifiers,
- Module0, Module) }
+ module_add_imported_module_specifiers(Specifiers,
+ !Module)
;
- { module_add_indirectly_imported_module_specifiers(
- Specifiers, Module0, Module) }
+ module_add_indirectly_imported_module_specifiers(
+ Specifiers, !Module)
)
- ; { ModuleDefn = use(module(Specifiers)) } ->
- { Status = Status0 },
- { Status = item_status(IStat, _) },
+ ; ModuleDefn = use(module(Specifiers)) ->
+ !.Status = item_status(IStat, _),
(
- { status_defined_in_this_module(IStat, yes)
+ ( status_defined_in_this_module(IStat, yes)
; IStat = imported(ancestor)
- }
+ )
->
- { module_add_imported_module_specifiers(Specifiers,
- Module0, Module) }
+ module_add_imported_module_specifiers(Specifiers,
+ !Module)
;
- { module_add_indirectly_imported_module_specifiers(
- Specifiers, Module0, Module) }
+ module_add_indirectly_imported_module_specifiers(
+ Specifiers, !Module)
)
- ; { ModuleDefn = include_module(_) } ->
- { Status = Status0 },
- { Module = Module0 }
- ; { ModuleDefn = external(External) } ->
- ( { External = name_arity(Name, Arity) } ->
- { Status = Status0 },
+ ; ModuleDefn = include_module(_) ->
+ true
+ ; ModuleDefn = external(External) ->
+ ( External = name_arity(Name, Arity) ->
module_mark_as_external(Name, Arity, Context,
- Module0, Module)
- ;
- { Status = Status0 },
- { Module = Module0 },
- prog_out__write_context(Context),
- report_warning("Warning: `external' declaration requires arity.\n")
- )
- ; { ModuleDefn = module(_ModuleName) } ->
- report_unexpected_decl("module", Context),
- { Status = Status0 },
- { Module = Module0 }
- ; { ModuleDefn = end_module(_ModuleName) } ->
- report_unexpected_decl("end_module", Context),
- { Status = Status0 },
- { Module = Module0 }
- ; { ModuleDefn = version_numbers(_, _) } ->
- { Status = Status0 },
- { Module = Module0 }
- ; { ModuleDefn = transitively_imported } ->
- { Status = Status0 },
- { Module = Module0 }
+ !Module, !IO)
;
- { Status = Status0 },
- { Module = Module0 },
- prog_out__write_context(Context),
- report_warning("Warning: declaration not yet implemented.\n")
+ prog_out__write_context(Context, !IO),
+ report_warning("Warning: `external' declaration " ++
+ "requires arity.\n", !IO)
+ )
+ ; ModuleDefn = module(_ModuleName) ->
+ report_unexpected_decl("module", Context, !IO)
+ ; ModuleDefn = end_module(_ModuleName) ->
+ report_unexpected_decl("end_module", Context, !IO)
+ ; ModuleDefn = version_numbers(_, _) ->
+ true
+ ; ModuleDefn = transitively_imported ->
+ true
+ ;
+ prog_out__write_context(Context, !IO),
+ report_warning("Warning: declaration not yet implemented.\n",
+ !IO)
).
-add_item_decl_pass_1(nothing(_), _, Status, Module, Status, Module, no) --> [].
+add_item_decl_pass_1(nothing(_), _, !Status, !Module, no, !IO).
add_item_decl_pass_1(typeclass(Constraints, Name, Vars, Interface, VarSet),
- Context, Status, Module0, Status, Module, no) -->
- module_add_class_defn(Module0, Constraints, Name, Vars, Interface,
- VarSet, Context, Status, Module).
+ Context, !Status, !Module, no, !IO) :-
+ module_add_class_defn(Constraints, Name, Vars, Interface,
+ VarSet, Context, !.Status, !Module, !IO).
% We add instance declarations on the second pass so that we don't add
% an instance declaration before its class declaration.
-add_item_decl_pass_1(instance(_, _, _, _, _,_), _, Status, Module, Status,
- Module, no) --> [].
+add_item_decl_pass_1(instance(_, _, _, _, _,_), _, !Status, !Module, no, !IO).
%-----------------------------------------------------------------------------%
% dispatch on the different types of items
-:- pred add_item_decl_pass_2(item, prog_context, item_status,
- module_info, item_status, module_info,
- io__state, io__state).
-:- mode add_item_decl_pass_2(in, in, in, in, out, out, di, uo) is det.
+:- pred add_item_decl_pass_2(item::in, prog_context::in, item_status::in,
+ item_status::out, module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
add_item_decl_pass_2(module_defn(_VarSet, ModuleDefn), _Context,
- Status0, Module, Status, Module) -->
- { module_defn_update_import_status(ModuleDefn, Status1) ->
- Status = Status1
+ !Status, !Module, !IO) :-
+ ( module_defn_update_import_status(ModuleDefn, Status1) ->
+ !:Status = Status1
;
- Status = Status0
- }.
+ true
+ ).
add_item_decl_pass_2(type_defn(VarSet, Name, Args, TypeDefn, Cond), Context,
- Status, Module0, Status, Module) -->
- module_add_type_defn(Module0, VarSet, Name, Args, TypeDefn,
- Cond, Context, Status, Module).
+ !Status, !Module, !IO) :-
+ module_add_type_defn(VarSet, Name, Args, TypeDefn,
+ Cond, Context, !.Status, !Module, !IO).
-add_item_decl_pass_2(pragma(Pragma), Context, Status, Module0, Status, Module)
- -->
+add_item_decl_pass_2(pragma(Pragma), Context, !Status, !Module, !IO) :-
%
% check for invalid pragmas in the `interface' section
%
- { Status = item_status(ImportStatus, _) },
- { pragma_allowed_in_interface(Pragma, Allowed) },
- ( { Allowed = no } ->
+ !.Status = item_status(ImportStatus, _),
+ pragma_allowed_in_interface(Pragma, Allowed),
+ ( Allowed = no ->
check_not_exported(ImportStatus, Context,
- "`pragma' declaration")
+ "`pragma' declaration", !IO)
;
- []
+ true
),
%
@@ -470,190 +445,174 @@
(
% ignore `pragma source_file' declarations - they're dealt
% with elsewhere
- { Pragma = source_file(_) },
- { Module = Module0 }
+ Pragma = source_file(_)
;
- { Pragma = foreign_code(Lang, Body_Code) },
- { module_add_foreign_body_code(Lang, Body_Code, Context,
- Module0, Module) }
- ;
- { Pragma = foreign_decl(Lang, C_Header) },
- { module_add_foreign_decl(Lang, C_Header, Context,
- Module0, Module) }
- ;
- { Pragma = foreign_import_module(Lang, Import) },
- { module_add_foreign_import_module(Lang, Import, Context,
- Module0, Module) }
+ Pragma = foreign_code(Lang, Body_Code),
+ module_add_foreign_body_code(Lang, Body_Code, Context,
+ !Module)
+ ;
+ Pragma = foreign_decl(Lang, C_Header),
+ module_add_foreign_decl(Lang, C_Header, Context, !Module)
+ ;
+ Pragma = foreign_import_module(Lang, Import),
+ module_add_foreign_import_module(Lang, Import, Context,
+ !Module)
;
% Handle pragma foreign procs later on (when we process
% clauses).
- { Pragma = foreign_proc(_, _, _, _, _, _) },
- { Module = Module0 }
+ Pragma = foreign_proc(_, _, _, _, _, _)
;
% Note that we check during process_type_defn that we have
% defined a foreign_type which is usable by the back-end
% we are compiling on.
- { Pragma = foreign_type(ForeignType, TVarSet, Name, Args,
- UserEqComp) },
- add_pragma_foreign_type(Context, Status, ForeignType,
- TVarSet, Name, Args, UserEqComp, Module0, Module)
+ Pragma = foreign_type(ForeignType, TVarSet, Name, Args,
+ UserEqComp),
+ add_pragma_foreign_type(Context, !.Status, ForeignType,
+ TVarSet, Name, Args, UserEqComp, !Module, !IO)
;
% Handle pragma tabled decls later on (when we process
% clauses).
- { Pragma = tabled(_, _, _, _, _) },
- { Module = Module0 }
+ Pragma = tabled(_, _, _, _, _)
;
- { Pragma = inline(Name, Arity) },
- 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,
- ImportStatus, Context, no_inline, [inline], Module)
- ;
- { Pragma = obsolete(Name, Arity) },
- add_pred_marker(Module0, "obsolete", Name, Arity, ImportStatus,
- Context, obsolete, [], Module)
+ Pragma = inline(Name, Arity),
+ add_pred_marker("inline", Name, Arity, ImportStatus, Context,
+ inline, [no_inline], !Module, !IO)
+ ;
+ Pragma = no_inline(Name, Arity),
+ add_pred_marker("no_inline", Name, Arity, ImportStatus,
+ Context, no_inline, [inline], !Module, !IO)
+ ;
+ Pragma = obsolete(Name, Arity),
+ add_pred_marker("obsolete", Name, Arity, ImportStatus,
+ Context, obsolete, [], !Module, !IO)
;
% Handle pragma import decls later on (when we process
% clauses and pragma c_code).
- { Pragma = import(_, _, _, _, _) },
- { Module = Module0 }
+ Pragma = import(_, _, _, _, _)
;
- { Pragma = export(Name, PredOrFunc, Modes, C_Function) },
+ Pragma = export(Name, PredOrFunc, Modes, C_Function),
add_pragma_export(Name, PredOrFunc, Modes, C_Function,
- Context, Module0, Module)
+ Context, !Module, !IO)
;
% Used for inter-module unused argument elimination.
% This can only appear in .opt files.
- { Pragma = unused_args(PredOrFunc, SymName,
- Arity, ModeNum, UnusedArgs) },
- ( { ImportStatus \= opt_imported } ->
- prog_out__write_context(Context),
- io__write_string(
- "Error: illegal use of pragma `unused_args'.\n"),
- { module_info_incr_errors(Module0, Module) }
+ Pragma = unused_args(PredOrFunc, SymName, Arity, ModeNum,
+ UnusedArgs),
+ ( ImportStatus \= opt_imported ->
+ prog_out__write_context(Context, !IO),
+ io__write_string("Error: illegal use of pragma " ++
+ "`unused_args'.\n", !IO),
+ module_info_incr_errors(!Module)
;
add_pragma_unused_args(PredOrFunc, SymName, Arity,
- ModeNum, UnusedArgs, Context, Module0, Module)
+ ModeNum, UnusedArgs, Context, !Module, !IO)
)
;
% Handle pragma type_spec decls later on (when we process
% clauses).
- { Pragma = type_spec(_, _, _, _, _, _, _, _) },
- { Module = Module0 }
+ Pragma = type_spec(_, _, _, _, _, _, _, _)
;
% Handle pragma fact_table decls later on (when we process
% clauses -- since these decls take the place of clauses).
- { Pragma = fact_table(_, _, _) },
- { Module = Module0 }
+ Pragma = fact_table(_, _, _)
;
% Handle pragma reserve_tag decls later on (when we process
% clauses -- they need to be handled after the type definitions
% have been added).
- { Pragma = reserve_tag(_, _) },
- { Module = Module0 }
+ Pragma = reserve_tag(_, _)
;
- { 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 = aditi_index(PredName, Arity, Index) },
- add_base_relation_index(Module0, PredName, Arity, Index,
- ImportStatus, Context, 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 = aditi_memo(Name, Arity) },
- add_pred_marker(Module0, "aditi_memo", Name, Arity,
- ImportStatus, Context, aditi_memo,
- [aditi_no_memo], Module)
- ;
- { Pragma = aditi_no_memo(PredName, Arity) },
- add_pred_marker(Module0, "aditi_no_memo", PredName, Arity,
- ImportStatus, Context, aditi_no_memo,
- [aditi_memo], 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,
- ImportStatus, Context, promised_pure, [], Module)
- ;
- { Pragma = promise_semipure(Name, Arity) },
- add_pred_marker(Module0, "promise_semipure", Name, Arity,
- ImportStatus, Context, promised_semipure, [], Module)
+ Pragma = aditi(PredName, Arity),
+ maybe_enable_aditi_compilation(!.Status, Context, !Module,
+ !IO),
+ add_pred_marker("aditi", PredName, Arity, ImportStatus,
+ Context, aditi, [], !Module, !IO),
+ add_stratified_pred("aditi", PredName, Arity, Context,
+ !Module, !IO)
+ ;
+ Pragma = base_relation(PredName, Arity),
+ maybe_enable_aditi_compilation(!.Status, Context, !Module,
+ !IO),
+ add_pred_marker("aditi", PredName, Arity, ImportStatus,
+ Context, aditi, [], !Module, !IO),
+ add_pred_marker("base_relation", PredName, Arity, ImportStatus,
+ Context, base_relation, [], !Module, !IO),
+ module_mark_as_external(PredName, Arity, Context, !Module, !IO)
+ ;
+ Pragma = aditi_index(PredName, Arity, Index),
+ add_base_relation_index(PredName, Arity, Index, ImportStatus,
+ Context, !Module, !IO)
+ ;
+ Pragma = naive(PredName, Arity),
+ add_pred_marker("naive", PredName, Arity, ImportStatus,
+ Context, naive, [psn], !Module, !IO)
+ ;
+ Pragma = psn(PredName, Arity),
+ add_pred_marker("psn", PredName, Arity, ImportStatus,
+ Context, psn, [naive], !Module, !IO)
+ ;
+ Pragma = aditi_memo(Name, Arity),
+ add_pred_marker("aditi_memo", Name, Arity, ImportStatus,
+ Context, aditi_memo, [aditi_no_memo], !Module, !IO)
+ ;
+ Pragma = aditi_no_memo(PredName, Arity),
+ add_pred_marker("aditi_no_memo", PredName, Arity, ImportStatus,
+ Context, aditi_no_memo, [aditi_memo], !Module, !IO)
+ ;
+ Pragma = supp_magic(PredName, Arity),
+ add_pred_marker("supp_magic", PredName, Arity, ImportStatus,
+ Context, supp_magic, [context], !Module, !IO)
+ ;
+ Pragma = context(PredName, Arity),
+ add_pred_marker("context", PredName, Arity, ImportStatus,
+ Context, context, [supp_magic], !Module, !IO)
+ ;
+ Pragma = owner(PredName, Arity, Owner),
+ set_pred_owner(PredName, Arity, Owner, ImportStatus,
+ Context, !Module, !IO)
+ ;
+ Pragma = promise_pure(Name, Arity),
+ add_pred_marker("promise_pure", Name, Arity, ImportStatus,
+ Context, promised_pure, [], !Module, !IO)
+ ;
+ Pragma = promise_semipure(Name, Arity),
+ add_pred_marker("promise_semipure", Name, Arity, ImportStatus,
+ Context, promised_semipure, [], !Module, !IO)
;
% Handle pragma termination_info decls later on, in pass 3 --
% we need to add function default modes before handling
% these pragmas
- { Pragma = termination_info(_, _, _, _, _) },
- { Module = Module0 }
+ Pragma = termination_info(_, _, _, _, _)
;
- { Pragma = terminates(Name, Arity) },
- add_pred_marker(Module0, "terminates", Name, Arity,
+ Pragma = terminates(Name, Arity),
+ add_pred_marker("terminates", Name, Arity,
ImportStatus, Context, terminates,
- [check_termination, does_not_terminate], Module)
+ [check_termination, does_not_terminate], !Module, !IO)
;
- { Pragma = does_not_terminate(Name, Arity) },
- add_pred_marker(Module0, "does_not_terminate", Name, Arity,
+ Pragma = does_not_terminate(Name, Arity),
+ add_pred_marker("does_not_terminate", Name, Arity,
ImportStatus, Context, does_not_terminate,
- [check_termination, terminates], Module)
+ [check_termination, terminates], !Module, !IO)
;
- { Pragma = check_termination(Name, Arity) },
- add_pred_marker(Module0, "check_termination", Name, Arity,
+ Pragma = check_termination(Name, Arity),
+ add_pred_marker("check_termination", Name, Arity,
ImportStatus, Context, check_termination,
- [terminates, does_not_terminate],
- Module)
+ [terminates, does_not_terminate], !Module, !IO)
).
-add_item_decl_pass_2(
- pred_or_func(_TypeVarSet, _InstVarSet, _ExistQVars,
- PredOrFunc, SymName, TypesAndModes,
- _WithType, _WithInst, _MaybeDet,
- _Cond, _Purity, _ClassContext),
- _Context, Status, Module0, Status, Module) -->
+add_item_decl_pass_2(pred_or_func(_TypeVarSet, _InstVarSet, _ExistQVars,
+ PredOrFunc, SymName, TypesAndModes, _WithType, _WithInst,
+ _MaybeDet, _Cond, _Purity, _ClassContext),
+ _Context, !Status, !Module, !IO) :-
%
% add default modes for function declarations, if necessary
%
- {
- PredOrFunc = predicate,
- Module = Module0
+ (
+ PredOrFunc = predicate
;
PredOrFunc = function,
list__length(TypesAndModes, Arity),
adjust_func_arity(function, FuncArity, Arity),
- module_info_get_predicate_table(Module0, PredTable0),
+ module_info_get_predicate_table(!.Module, PredTable0),
(
predicate_table_search_func_sym_arity(PredTable0,
is_fully_qualified, SymName,
@@ -661,38 +620,31 @@
->
predicate_table_get_preds(PredTable0, Preds0),
maybe_add_default_func_modes(PredIds, Preds0, Preds),
- predicate_table_set_preds(PredTable0,
- Preds, PredTable),
- module_info_set_predicate_table(Module0,
- PredTable, Module)
+ predicate_table_set_preds(PredTable0, Preds,
+ PredTable),
+ module_info_set_predicate_table(PredTable, !Module)
;
error("make_hlds.m: can't find func declaration")
)
- }.
-add_item_decl_pass_2(promise(_, _, _, _), _, Status, Module, Status, Module)
- --> [].
-add_item_decl_pass_2(clause(_, _, _, _, _), _, Status, Module, Status,
- Module) --> [].
-add_item_decl_pass_2(inst_defn(_, _, _, _, _), _, Status, Module,
- Status, Module) --> [].
-add_item_decl_pass_2(mode_defn(_, _, _, _, _), _, Status, Module,
- Status, Module) --> [].
+ ).
+add_item_decl_pass_2(promise(_, _, _, _), _, !Status, !Module, !IO).
+add_item_decl_pass_2(clause(_, _, _, _, _), _, !Status, !Module, !IO).
+add_item_decl_pass_2(inst_defn(_, _, _, _, _), _, !Status, !Module, !IO).
+add_item_decl_pass_2(mode_defn(_, _, _, _, _), _, !Status, !Module, !IO).
add_item_decl_pass_2(pred_or_func_mode(_, _, _, _, _, _, _), _,
- Status, Module, Status, Module) --> [].
-add_item_decl_pass_2(nothing(_), _, Status, Module, Status, Module) --> [].
-add_item_decl_pass_2(typeclass(_, _, _, _, _)
- , _, Status, Module, Status, Module) --> [].
+ !Status, !Module, !IO).
+add_item_decl_pass_2(nothing(_), _, !Status, !Module, !IO).
+add_item_decl_pass_2(typeclass(_, _, _, _, _) , _, !Status, !Module, !IO).
add_item_decl_pass_2(instance(Constraints, Name, Types, Body, VarSet,
- InstanceModuleName), Context,
- Status, Module0, Status, Module) -->
- { Status = item_status(ImportStatus, _) },
- { Body = abstract ->
+ InstanceModuleName), Context, !Status, !Module, !IO) :-
+ !.Status = item_status(ImportStatus, _),
+ ( Body = abstract ->
make_status_abstract(ImportStatus, BodyStatus)
;
BodyStatus = ImportStatus
- },
- module_add_instance_defn(Module0, InstanceModuleName, Constraints,
- Name, Types, Body, VarSet, BodyStatus, Context, Module).
+ ),
+ module_add_instance_defn(InstanceModuleName, Constraints, Name, Types,
+ Body, VarSet, BodyStatus, Context, !Module, !IO).
%------------------------------------------------------------------------------
@@ -722,64 +674,60 @@
% needs to remove the `aditi' and `base_relation' markers
% so that the procedures are not ignored by the code
% generation annotation passes (e.g. arg_info.m).
-:- pred maybe_enable_aditi_compilation(item_status, term__context,
- module_info, module_info, io__state, io__state).
-:- mode maybe_enable_aditi_compilation(in, in, in, out, di, uo) is det.
+:- pred maybe_enable_aditi_compilation(item_status::in, term__context::in,
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
-maybe_enable_aditi_compilation(_Status, Context, Module0, Module) -->
- 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) }
+maybe_enable_aditi_compilation(_Status, Context, !Module, !IO) :-
+ globals__io_lookup_bool_option(aditi, Aditi, !IO),
+ ( Aditi = no ->
+ prog_out__write_context(Context, !IO),
+ io__write_string("Error: compilation of Aditi procedures\n",
+ !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" requires the `--aditi' option.\n", !IO),
+ io__set_exit_status(1, !IO),
+ module_info_incr_errors(!Module)
;
% There are Aditi procedures - enable Aditi code generation.
- { module_info_set_do_aditi_compilation(Module0, Module) }
+ module_info_set_do_aditi_compilation(!Module)
).
%-----------------------------------------------------------------------------%
% dispatch on the different types of items
-:- pred add_item_clause(item, import_status, import_status, prog_context,
- module_info, module_info, qual_info, qual_info, io__state, io__state).
-:- mode add_item_clause(in, in, out, in, in, out, in, out, di, uo) is det.
+:- pred add_item_clause(item::in, import_status::in, import_status::out,
+ prog_context::in, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, io__state::di, io__state::uo) is det.
add_item_clause(clause(VarSet, PredOrFunc, PredName, Args, Body),
- Status, Status, Context, Module0, Module, Info0, Info) -->
- check_not_exported(Status, Context, "clause"),
- { GoalType = none }, % at this stage we only need know that it's not
+ !Status, Context, !Module, !Info, !IO) :-
+ check_not_exported(!.Status, Context, "clause", !IO),
+ GoalType = none, % at this stage we only need know that it's not
% a promise declaration
- module_add_clause(Module0, VarSet, PredOrFunc, PredName,
- Args, Body, Status, Context, GoalType, Module, Info0, Info).
-add_item_clause(type_defn(_, _, _, _, _), Status, Status, _,
- Module, Module, Info, Info) --> [].
-add_item_clause(inst_defn(_, _, _, _, _), Status, Status, _,
- Module, Module, Info, Info) --> [].
-add_item_clause(mode_defn(_, _, _, _, _), Status, Status, _,
- Module, Module, Info, Info) --> [].
-add_item_clause(
- pred_or_func(_, _, _, PredOrFunc, SymName, TypesAndModes,
+ module_add_clause(VarSet, PredOrFunc, PredName, Args, Body, !.Status,
+ Context, GoalType, !Module, !Info, !IO).
+add_item_clause(type_defn(_, _, _, _, _), !Status, _, !Module, !Info, !IO).
+add_item_clause(inst_defn(_, _, _, _, _), !Status, _, !Module, !Info, !IO).
+add_item_clause(mode_defn(_, _, _, _, _), !Status, _, !Module, !Info, !IO).
+add_item_clause(pred_or_func(_, _, _, PredOrFunc, SymName, TypesAndModes,
_WithType, _WithInst, _, _, _, _),
- Status, Status, Context, Module, Module, Info, Info) -->
+ !Status, Context, !Module, !Info, !IO) :-
(
- { PredOrFunc = predicate }
+ PredOrFunc = predicate
;
- { PredOrFunc = function},
- { list__length(TypesAndModes, PredArity) },
- { adjust_func_arity(function, FuncArity, PredArity) },
+ PredOrFunc = function,
+ list__length(TypesAndModes, PredArity),
+ adjust_func_arity(function, FuncArity, PredArity),
maybe_check_field_access_function(SymName, FuncArity,
- Status, Context, Module)
+ !.Status, Context, !.Module, !IO)
).
-add_item_clause(pred_or_func_mode(_, _, _, _, _, _, _), Status, Status, _,
- Module, Module, Info, Info) --> [].
-add_item_clause(module_defn(_, Defn), Status0, Status, _,
- Module0, Module, Info0, Info) -->
- { Defn = version_numbers(ModuleName, ModuleVersionNumbers) ->
+add_item_clause(pred_or_func_mode(_, _, _, _, _, _, _), !Status, _,
+ !Module, !Info, !IO).
+add_item_clause(module_defn(_, Defn), !Status, _, !Module, !Info, !IO) :-
+ ( Defn = version_numbers(ModuleName, ModuleVersionNumbers) ->
%
% Record the version numbers for each imported module
% if smart recompilation is enabled.
@@ -787,96 +735,86 @@
apply_to_recompilation_info(
(pred(RecompInfo0::in, RecompInfo::out) is det :-
RecompInfo = RecompInfo0 ^ version_numbers ^
- map__elem(ModuleName) := ModuleVersionNumbers
+ map__elem(ModuleName) :=
+ ModuleVersionNumbers
),
- transform_info(Module0, Info0),
- transform_info(Module, Info)),
- Status = Status0
+ transform_info(!.Module, !.Info),
+ transform_info(!:Module, !:Info))
; module_defn_update_import_status(Defn, ItemStatus1) ->
- ItemStatus1 = item_status(Status1, NeedQual),
- qual_info_get_mq_info(Info0, MQInfo0),
+ ItemStatus1 = item_status(!:Status, NeedQual),
+ qual_info_get_mq_info(!.Info, MQInfo0),
mq_info_set_need_qual_flag(MQInfo0, NeedQual, MQInfo),
- qual_info_set_mq_info(Info0, MQInfo, Info),
- Module = Module0,
- Status = Status1
+ qual_info_set_mq_info(MQInfo, !Info)
;
- Module = Module0,
- Info = Info0,
- Status = Status0
- }.
-add_item_clause(pragma(Pragma), Status, Status, Context,
- Module0, Module, Info0, Info) -->
+ true
+ ).
+add_item_clause(pragma(Pragma), !Status, Context, !Module, !Info, !IO) :-
(
- { Pragma = foreign_proc(Attributes, Pred, PredOrFunc,
- Vars, VarSet, PragmaImpl) }
+ Pragma = foreign_proc(Attributes, Pred, PredOrFunc,
+ Vars, VarSet, PragmaImpl)
->
- module_add_pragma_foreign_proc(Attributes,
- Pred, PredOrFunc, Vars, VarSet, PragmaImpl,
- Status, Context, Module0, Module, Info0, Info)
+ module_add_pragma_foreign_proc(Attributes, Pred, PredOrFunc,
+ Vars, VarSet, PragmaImpl, !.Status, Context,
+ !Module, !Info, !IO)
;
- { Pragma = import(Name, PredOrFunc, Modes, Attributes,
- C_Function) }
+ Pragma = import(Name, PredOrFunc, Modes, Attributes,
+ C_Function)
->
- module_add_pragma_import(Name, PredOrFunc, Modes,
- Attributes, C_Function, Status, Context,
- Module0, Module, Info0, Info)
+ module_add_pragma_import(Name, PredOrFunc, Modes, Attributes,
+ C_Function, !.Status, Context, !Module, !Info, !IO)
;
- { Pragma = fact_table(Pred, Arity, File) }
+ Pragma = fact_table(Pred, Arity, File)
->
- module_add_pragma_fact_table(Pred, Arity, File,
- Status, Context, Module0, Module, Info0, Info)
+ module_add_pragma_fact_table(Pred, Arity, File, !.Status,
+ Context, !Module, !Info, !IO)
;
- { Pragma = tabled(Type, Name, Arity, PredOrFunc, Mode) }
+ Pragma = tabled(Type, Name, Arity, PredOrFunc, Mode)
->
- globals__io_lookup_bool_option(type_layout, TypeLayout),
+ globals__io_lookup_bool_option(type_layout, TypeLayout, !IO),
(
- { TypeLayout = yes }
- ->
+ TypeLayout = yes,
module_add_pragma_tabled(Type, Name, Arity, PredOrFunc,
- Mode, Status, Context, Module0, Module)
+ Mode, !.Status, Context, !Module, !IO)
;
- { module_info_incr_errors(Module0, Module) },
- prog_out__write_context(Context),
- io__write_string("Error: `:- pragma "),
- { EvalMethodS = eval_method_to_string(Type) },
- io__write_string(EvalMethodS),
- io__write_string(
-"' declaration requires the type_ctor_layout\n"),
- prog_out__write_context(Context),
- io__write_string(
-" structures. Use the --type-layout flag to enable them.\n")
- ),
- { Info = Info0 }
+ TypeLayout = no,
+ module_info_incr_errors(!Module),
+ prog_out__write_context(Context, !IO),
+ io__write_string("Error: `:- pragma ", !IO),
+ EvalMethodS = eval_method_to_string(Type),
+ io__write_string(EvalMethodS, !IO),
+ io__write_string("' declaration requires the " ++
+ "type_ctor_layout\n", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" structures. Use " ++
+ "the --type-layout flag to enable them.\n",
+ !IO)
+ )
;
- { Pragma = type_spec(_, _, _, _, _, _, _, _) }
+ Pragma = type_spec(_, _, _, _, _, _, _, _)
->
- add_pragma_type_spec(Pragma, Context, Module0, Module,
- Info0, Info)
+ add_pragma_type_spec(Pragma, Context, !Module, !Info, !IO)
;
- { Pragma = termination_info(PredOrFunc, SymName, ModeList,
- MaybeArgSizeInfo, MaybeTerminationInfo) }
+ Pragma = termination_info(PredOrFunc, SymName, ModeList,
+ MaybeArgSizeInfo, MaybeTerminationInfo)
->
add_pragma_termination_info(PredOrFunc, SymName, ModeList,
MaybeArgSizeInfo, MaybeTerminationInfo, Context,
- Module0, Module),
- { Info = Info0 }
+ !Module, !IO)
;
- { Pragma = reserve_tag(TypeName, TypeArity) }
+ Pragma = reserve_tag(TypeName, TypeArity)
->
- add_pragma_reserve_tag(TypeName, TypeArity, Status,
- Context, Module0, Module),
- { Info = Info0 }
+ add_pragma_reserve_tag(TypeName, TypeArity, !.Status,
+ Context, !Module, !IO)
;
% don't worry about any pragma declarations other than the
% clause-like pragmas (c_code, tabling and fact_table),
% foreign_type and the termination_info pragma here,
% since they've already been handled earlier, in pass 2
- { Module = Module0 },
- { Info = Info0 }
+ true
).
add_item_clause(promise(PromiseType, Goal, VarSet, UnivVars),
- Status, Status, Context, Module0, Module, Info0, Info) -->
+ !Status, Context, !Module, !Info, !IO) :-
%
% If the outermost universally quantified variables
% are placed in the head of the dummy predicate, the
@@ -884,30 +822,35 @@
% type variables as this implicity adds a universal
% quantification of the typevariables needed.
%
- { term__var_list_to_term_list(UnivVars, HeadVars) },
+ term__var_list_to_term_list(UnivVars, HeadVars),
% extra error checking for promise ex declarations
- ( { PromiseType \= true } ->
- check_promise_ex_decl(UnivVars, PromiseType, Goal, Context)
+ ( PromiseType \= true ->
+ check_promise_ex_decl(UnivVars, PromiseType, Goal, Context,
+ !IO)
;
- []
+ true
),
% add as dummy predicate
- add_promise_clause(PromiseType, HeadVars, VarSet, Goal, Context, Status,
- Module0, Module, Info0, Info).
+ add_promise_clause(PromiseType, HeadVars, VarSet, Goal, Context,
+ !.Status, !Module, !Info, !IO).
+
+add_item_clause(nothing(_), !Status, _, !Module, !Info, !IO).
+add_item_clause(typeclass(_, _, _, _, _), !Status, _, !Module, !Info, !IO).
+add_item_clause(instance(_, _, _, _, _, _), !Status, _, !Module, !Info, !IO).
+
+:- pred add_promise_clause(promise_type::in, list(term(prog_var_type))::in,
+ prog_varset::in, goal::in, prog_context::in, import_status::in,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ io__state::di, io__state::uo) is det.
-:- pred add_promise_clause(promise_type, list(term(prog_var_type)), prog_varset,
- goal, prog_context, import_status, module_info, module_info,
- qual_info, qual_info, io__state, io__state).
-:- mode add_promise_clause(in, in, in, in, in, in, in, out, in, out,
- di, uo) is det.
add_promise_clause(PromiseType, HeadVars, VarSet, Goal, Context, Status,
- Module0, Module, Info0, Info) -->
- { term__context_line(Context, Line) },
- { term__context_file(Context, File) },
- { string__format(prog_out__promise_to_string(PromiseType) ++
- "__%d__%s", [i(Line), s(File)], Name) },
+ !Module, !Info, !IO) :-
+ term__context_line(Context, Line),
+ term__context_file(Context, File),
+ string__format(prog_out__promise_to_string(PromiseType) ++
+ "__%d__%s", [i(Line), s(File)], Name),
%
% Promise declarations are recorded as a predicate with a
% goal_type of promise(X), where X is of promise_type. This
@@ -921,38 +864,29 @@
% promise__lineno_filename(A, B, R) :-
% ( R = A + B <=> R = B + A ).
%
- { GoalType = promise(PromiseType) },
- { module_info_name(Module0, ModuleName) },
- module_add_clause(Module0, VarSet, predicate,
- qualified(ModuleName, Name),
+ GoalType = promise(PromiseType) ,
+ module_info_name(!.Module, ModuleName),
+ module_add_clause(VarSet, predicate, qualified(ModuleName, Name),
HeadVars, Goal, Status, Context, GoalType,
- Module, Info0, Info).
-
-add_item_clause(nothing(_), Status, Status, _,
- Module, Module, Info, Info) --> [].
-add_item_clause(typeclass(_, _, _, _, _),
- Status, Status, _, Module, Module, Info, Info) --> [].
-add_item_clause(instance(_, _, _, _, _, _),
- Status, Status, _, Module, Module, Info, Info) --> [].
+ !Module, !Info, !IO).
%-----------------------------------------------------------------------------%
-:- pred check_not_exported(import_status, prog_context, string,
- io__state, io__state).
-:- mode check_not_exported(in, in, in, di, uo) is det.
+:- pred check_not_exported(import_status::in, prog_context::in, string::in,
+ io__state::di, io__state::uo) is det.
-check_not_exported(Status, Context, Message) -->
+check_not_exported(Status, Context, Message, !IO) :-
%
% check that clauses are not exported
%
- ( { Status = exported } ->
- prog_out__write_context(Context),
- { string__append_list(
+ ( Status = exported ->
+ prog_out__write_context(Context, !IO),
+ string__append_list(
["Warning: ", Message, " in module interface.\n"],
- WarningMessage) },
- report_warning(WarningMessage)
+ WarningMessage),
+ report_warning(WarningMessage, !IO)
;
- []
+ true
).
%-----------------------------------------------------------------------------%
@@ -984,8 +918,8 @@
ProcId, C_Function, Context) },
{ PragmaExportedProcs =
[NewExportedProc|PragmaExportedProcs0]},
- { module_info_set_pragma_exported_procs(Module0,
- PragmaExportedProcs, Module) }
+ { module_info_set_pragma_exported_procs(
+ PragmaExportedProcs, Module0, Module) }
;
undefined_mode_error(Name, Arity, Context,
"`:- pragma export' declaration"),
@@ -999,17 +933,16 @@
%-----------------------------------------------------------------------------%
-:- pred add_pragma_foreign_type(prog_context, item_status,
- foreign_language_type, tvarset, sym_name, list(type_param),
- maybe(unify_compare), module_info, module_info, io__state, io__state).
-:- mode add_pragma_foreign_type(in, in, in, in, in, in, in,
- in, out, di, uo) is det.
+:- pred add_pragma_foreign_type(prog_context::in, item_status::in,
+ foreign_language_type::in, tvarset::in, sym_name::in,
+ list(type_param)::in, maybe(unify_compare)::in,
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
add_pragma_foreign_type(Context, item_status(ImportStatus, NeedQual),
- ForeignType, TVarSet, Name, Args,
- UserEqComp, Module0, Module) -->
- { IsSolverType = non_solver_type },
- { ForeignType = il(ILForeignType),
+ ForeignType, TVarSet, Name, Args, UserEqComp, !Module, !IO) :-
+ IsSolverType = non_solver_type,
+ ( ForeignType = il(ILForeignType),
Body = foreign_type(
foreign_type_body(yes(ILForeignType - UserEqComp),
no, no), IsSolverType)
@@ -1021,48 +954,44 @@
Body = foreign_type(foreign_type_body(no, no,
yes(JavaForeignType - UserEqComp)),
IsSolverType)
- },
- { Cond = true },
+ ),
+ Cond = true,
- { Arity = list__length(Args) },
- { TypeCtor = Name - Arity },
- { module_info_types(Module0, Types) },
- { TypeStr = error_util__describe_sym_name_and_arity(Name / Arity) },
- (
- { map__search(Types, TypeCtor, OldDefn) }
- ->
- { hlds_data__get_type_defn_status(OldDefn, OldStatus) },
- { hlds_data__get_type_defn_body(OldDefn, OldBody) },
- (
- { OldBody = abstract_type(_) },
- { status_is_exported_to_non_submodules(OldStatus,
- no) },
- { status_is_exported_to_non_submodules(ImportStatus,
- yes) }
+ Arity = list__length(Args),
+ TypeCtor = Name - Arity,
+ module_info_types(!.Module, Types),
+ TypeStr = error_util__describe_sym_name_and_arity(Name / Arity),
+ ( map__search(Types, TypeCtor, OldDefn) ->
+ hlds_data__get_type_defn_status(OldDefn, OldStatus),
+ hlds_data__get_type_defn_body(OldDefn, OldBody),
+ (
+ OldBody = abstract_type(_),
+ status_is_exported_to_non_submodules(OldStatus, no),
+ status_is_exported_to_non_submodules(ImportStatus, yes)
->
- { ErrorPieces = [
+ ErrorPieces = [
words("Error: pragma foreign_type "),
fixed(TypeStr),
words(
"must have the same visibility as the type declaration.")
- ] },
- error_util__write_error_pieces(Context, 0, ErrorPieces),
- { module_info_incr_errors(Module0, Module) }
+ ],
+ error_util__write_error_pieces(Context, 0,
+ ErrorPieces, !IO),
+ module_info_incr_errors(!Module)
;
- { module_info_contains_foreign_type(Module0, Module1) },
- module_add_type_defn_2(Module1, TVarSet, Name,
- Args, Body, Cond, Context,
- item_status(ImportStatus, NeedQual),
- Module)
+ module_info_contains_foreign_type(!Module),
+ module_add_type_defn_2(TVarSet, Name, Args, Body, Cond,
+ Context, item_status(ImportStatus, NeedQual),
+ !Module, !IO)
)
;
- { ErrorPieces = [
+ ErrorPieces = [
words("Error: type "),
fixed(TypeStr),
words("defined as foreign_type without being declared.")
- ] },
- error_util__write_error_pieces(Context, 0, ErrorPieces),
- { module_info_incr_errors(Module0, Module) }
+ ],
+ error_util__write_error_pieces(Context, 0, ErrorPieces, !IO),
+ module_info_incr_errors(!Module)
).
%-----------------------------------------------------------------------------%
@@ -1072,152 +1001,146 @@
:- mode add_pragma_reserve_tag(in, in, in, in, in, out, di, uo) is det.
add_pragma_reserve_tag(TypeName, TypeArity, PragmaStatus, Context,
- Module0, Module) -->
- { TypeCtor = TypeName - TypeArity },
- { module_info_types(Module0, Types0) },
- { TypeStr = error_util__describe_sym_name_and_arity(
- TypeName / TypeArity) },
- { ErrorPieces1 = [
+ !Module, !IO) :-
+ TypeCtor = TypeName - TypeArity,
+ module_info_types(!.Module, Types0),
+ TypeStr = error_util__describe_sym_name_and_arity(
+ TypeName / TypeArity),
+ ErrorPieces1 = [
words("In"),
fixed("`pragma reserve_tag'"),
words("declaration for"),
fixed(TypeStr ++ ":")
- ] },
- (
- { map__search(Types0, TypeCtor, TypeDefn0) }
- ->
- { hlds_data__get_type_defn_body(TypeDefn0, TypeBody0) },
- { hlds_data__get_type_defn_status(TypeDefn0, TypeStatus) },
+ ],
+ ( map__search(Types0, TypeCtor, TypeDefn0) ->
+ hlds_data__get_type_defn_body(TypeDefn0, TypeBody0),
+ hlds_data__get_type_defn_status(TypeDefn0, TypeStatus),
(
- not {
+ not (
TypeStatus = PragmaStatus
;
TypeStatus = abstract_exported,
( PragmaStatus = local
; PragmaStatus = exported_to_submodules
)
- }
+ )
->
error_util__write_error_pieces(Context, 0,
- ErrorPieces1),
- { ErrorPieces2 = [
+ ErrorPieces1, !IO),
+ ErrorPieces2 = [
words("error: `reserve_tag' declaration must"),
words("have the same visibility as the"),
words("type definition.")
- ] },
+ ],
error_util__write_error_pieces_not_first_line(Context,
- 0, ErrorPieces2),
- io__set_exit_status(1),
- { module_info_incr_errors(Module0, Module) }
+ 0, ErrorPieces2, !IO),
+ io__set_exit_status(1, !IO),
+ module_info_incr_errors(!Module)
;
- { TypeBody0 = du_type(Body, _CtorTags0, _IsEnum0,
+ TypeBody0 = du_type(Body, _CtorTags0, _IsEnum0,
EqualityPred, ReservedTag0, IsSolverType,
- IsForeign) }
+ IsForeign)
->
(
- { ReservedTag0 = yes },
+ ReservedTag0 = yes,
% make doubly sure that we don't get any
% spurious warnings with intermodule
% optimization...
- { TypeStatus \= opt_imported }
+ TypeStatus \= opt_imported
->
error_util__write_error_pieces(Context, 0,
- ErrorPieces1),
- { ErrorPieces2 = [
+ ErrorPieces1, !IO),
+ ErrorPieces2 = [
words("warning: multiple"),
fixed("`pragma reserved_tag'"),
words("declarations for the same type.")
- ] },
+ ],
error_util__write_error_pieces_not_first_line(
- Context, 0, ErrorPieces2)
+ Context, 0, ErrorPieces2, !IO)
;
- []
+ true
),
%
% We passed all the semantic checks.
% Mark the type has having a reserved tag,
% and recompute the constructor tags.
%
- { ReservedTag = yes },
- { module_info_globals(Module0, Globals) },
- { assign_constructor_tags(Body, TypeCtor, ReservedTag,
- Globals, CtorTags, IsEnum) },
- { TypeBody = du_type(Body, CtorTags, IsEnum,
+ ReservedTag = yes,
+ module_info_globals(!.Module, Globals),
+ assign_constructor_tags(Body, TypeCtor, ReservedTag,
+ Globals, CtorTags, IsEnum),
+ TypeBody = du_type(Body, CtorTags, IsEnum,
EqualityPred, ReservedTag, IsSolverType,
- IsForeign) },
- { hlds_data__set_type_defn_body(TypeDefn0, TypeBody,
- TypeDefn) },
- { map__set(Types0, TypeCtor, TypeDefn, Types) },
- { module_info_set_types(Module0, Types, Module) }
+ IsForeign),
+ hlds_data__set_type_defn_body(TypeDefn0, TypeBody,
+ TypeDefn),
+ map__set(Types0, TypeCtor, TypeDefn, Types),
+ module_info_set_types(Types, !Module)
;
error_util__write_error_pieces(Context, 0,
- ErrorPieces1),
- { ErrorPieces2 = [
+ ErrorPieces1, !IO),
+ ErrorPieces2 = [
words("error:"),
fixed(TypeStr),
words("is not a discriminated union type.")
- ] },
+ ],
error_util__write_error_pieces_not_first_line(Context,
- 0, ErrorPieces2),
- io__set_exit_status(1),
- { module_info_incr_errors(Module0, Module) }
+ 0, ErrorPieces2, !IO),
+ io__set_exit_status(1, !IO),
+ module_info_incr_errors(!Module)
)
;
- error_util__write_error_pieces(Context, 0,
- ErrorPieces1),
- { ErrorPieces2 = [
+ error_util__write_error_pieces(Context, 0, ErrorPieces1, !IO),
+ ErrorPieces2 = [
words("error: undefined type"),
fixed(TypeStr ++ ".")
- ] },
+ ],
error_util__write_error_pieces_not_first_line(Context,
- 0, ErrorPieces2),
- io__set_exit_status(1),
- { module_info_incr_errors(Module0, Module) }
+ 0, ErrorPieces2, !IO),
+ io__set_exit_status(1, !IO),
+ module_info_incr_errors(!Module)
).
%-----------------------------------------------------------------------------%
-:- pred add_pragma_unused_args(pred_or_func, sym_name, arity, mode_num,
- list(int), prog_context, module_info, module_info,
- io__state, io__state).
-:- mode add_pragma_unused_args(in, in, in, in, in, in, in, out, di, uo) is det.
+:- pred add_pragma_unused_args(pred_or_func::in, sym_name::in, arity::in,
+ mode_num::in, list(int)::in, prog_context::in,
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
add_pragma_unused_args(PredOrFunc, SymName, Arity, ModeNum, UnusedArgs,
- Context, Module0, Module) -->
- { module_info_get_predicate_table(Module0, Preds) },
+ Context, !Module, !IO) :-
+ module_info_get_predicate_table(!.Module, Preds),
(
- { predicate_table_search_pf_sym_arity(Preds,
+ predicate_table_search_pf_sym_arity(Preds,
is_fully_qualified, PredOrFunc, SymName,
- Arity, [PredId]) }
+ Arity, [PredId])
->
- { module_info_unused_arg_info(Module0, UnusedArgInfo0) },
+ module_info_unused_arg_info(!.Module, UnusedArgInfo0),
% convert the mode number to a proc_id
- { proc_id_to_int(ProcId, ModeNum) },
- { map__set(UnusedArgInfo0, proc(PredId, ProcId), UnusedArgs,
- UnusedArgInfo) },
- { module_info_set_unused_arg_info(Module0, UnusedArgInfo,
- Module) }
+ proc_id_to_int(ProcId, ModeNum),
+ map__set(UnusedArgInfo0, proc(PredId, ProcId), UnusedArgs,
+ UnusedArgInfo),
+ module_info_set_unused_arg_info(UnusedArgInfo, !Module)
;
- prog_out__write_context(Context),
- io__write_string(
-"Internal compiler error: unknown predicate in `pragma unused_args'.\n"),
- { module_info_incr_errors(Module0, Module) }
+ prog_out__write_context(Context, !IO),
+ io__write_string("Internal compiler error: " ++
+ "unknown predicate in `pragma unused_args'.\n", !IO),
+ module_info_incr_errors(!Module)
).
%-----------------------------------------------------------------------------%
-:- pred add_pragma_type_spec(pragma_type, term__context,
- module_info, module_info, qual_info, qual_info,
- io__state, io__state).
-:- mode add_pragma_type_spec(in(type_spec), in, in, out,
- in, out, di, uo) is det.
+:- pred add_pragma_type_spec(pragma_type::in(type_spec), term__context::in,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ io__state::di, io__state::uo) is det.
-add_pragma_type_spec(Pragma, Context, Module0, Module, Info0, Info) -->
- { Pragma = type_spec(SymName, _, Arity, MaybePredOrFunc, _, _, _, _) },
- { module_info_get_predicate_table(Module0, Preds) },
+add_pragma_type_spec(Pragma, Context, !Module, !Info, !IO) :-
+ Pragma = type_spec(SymName, _, Arity, MaybePredOrFunc, _, _, _, _),
+ module_info_get_predicate_table(!.Module, Preds),
(
- { MaybePredOrFunc = yes(PredOrFunc) ->
+ ( MaybePredOrFunc = yes(PredOrFunc) ->
adjust_func_arity(PredOrFunc, Arity, PredArity),
predicate_table_search_pf_sym_arity(Preds,
is_fully_qualified, PredOrFunc,
@@ -1225,50 +1148,50 @@
;
predicate_table_search_sym_arity(Preds,
is_fully_qualified, SymName, Arity, PredIds)
- },
- { PredIds \= [] }
+ ),
+ PredIds \= []
->
list__foldl2(add_pragma_type_spec_2(Pragma, Context),
- PredIds, transform_info(Module0, Info0),
- transform_info(Module, Info))
+ PredIds, transform_info(!.Module, !.Info),
+ transform_info(!:Module, !:Info), !IO)
;
- { Info = Info0 },
undefined_pred_or_func_error(SymName, Arity, Context,
- "`:- pragma type_spec' declaration"),
- { module_info_incr_errors(Module0, Module) }
+ "`:- pragma type_spec' declaration", !IO),
+ module_info_incr_errors(!Module)
).
-:- pred add_pragma_type_spec_2(pragma_type, prog_context, pred_id,
- transform_info, transform_info, io__state, io__state).
-:- mode add_pragma_type_spec_2(in(type_spec), in, in, in, out, di, uo) is det.
+:- pred add_pragma_type_spec_2(pragma_type::in(type_spec), prog_context::in,
+ pred_id::in, transform_info::in, transform_info::out,
+ io__state::di, io__state::uo) is det.
add_pragma_type_spec_2(Pragma0, Context, PredId,
- transform_info(ModuleInfo0, Info0), TransformInfo) -->
- { Pragma0 = type_spec(SymName, SpecName, Arity, _,
- MaybeModes, Subst, TVarSet0, ExpandedItems) },
- { module_info_pred_info(ModuleInfo0, PredId, PredInfo0) },
- handle_pragma_type_spec_subst(Context, Subst, TVarSet0, PredInfo0,
- TVarSet, Types, ExistQVars, ClassContext, SubstOk,
- ModuleInfo0, ModuleInfo1),
- ( { SubstOk = yes(RenamedSubst) } ->
- { pred_info_procedures(PredInfo0, Procs0) },
+ transform_info(ModuleInfo0, Info0), TransformInfo, !IO) :-
+ Pragma0 = type_spec(SymName, SpecName, Arity, _, MaybeModes, Subst,
+ TVarSet0, ExpandedItems),
+ module_info_pred_info(ModuleInfo0, PredId, PredInfo0),
+ handle_pragma_type_spec_subst(Context, Subst, PredInfo0,
+ TVarSet0, TVarSet, Types, ExistQVars, ClassContext, SubstOk,
+ ModuleInfo0, ModuleInfo1, !IO),
+ ( SubstOk = yes(RenamedSubst) ->
+ pred_info_procedures(PredInfo0, Procs0),
handle_pragma_type_spec_modes(SymName, Arity, Context,
MaybeModes, ProcIds, Procs0, Procs, ModesOk,
- ModuleInfo1, ModuleInfo2),
+ ModuleInfo1, ModuleInfo2, !IO),
globals__io_lookup_bool_option(user_guided_type_specialization,
- DoTypeSpec),
- globals__io_lookup_bool_option(smart_recompilation, Smart),
- {
+ DoTypeSpec, !IO),
+ globals__io_lookup_bool_option(smart_recompilation, Smart, !IO),
+ (
ModesOk = yes,
% Even if we aren't doing type specialization, we need
- % to create the interface procedures for local predicates
- % to check the type-class correctness of the requested
- % specializations.
- %
- % If we're doing smart recompilation we need to record the
- % pragmas even if we aren't doing type specialization to
- % avoid problems with differing output for the recompilation
- % tests in debugging grades.
+ % to create the interface procedures for local
+ % predicates to check the type-class correctness of
+ % the requested specializations.
+ %
+ % If we're doing smart recompilation we need to record
+ % the pragmas even if we aren't doing type
+ % specialization to avoid problems with differing
+ % output for the recompilation tests in debugging
+ % grades.
%
( DoTypeSpec = yes
; \+ pred_info_is_imported(PredInfo0)
@@ -1277,8 +1200,9 @@
->
%
% Build a clause to call the old predicate with the
- % specified types to force the specialization. For imported
- % predicates this forces the creation of the proper interface.
+ % specified types to force the specialization.
+ % For imported predicates this forces the creation
+ % of the proper interface.
%
PredOrFunc = pred_info_is_pred_or_func(PredInfo0),
adjust_func_arity(PredOrFunc, Arity, PredArity),
@@ -1286,37 +1210,40 @@
make_n_fresh_vars("HeadVar__", PredArity,
Args, ArgVarSet0, ArgVarSet),
% XXX We could use explicit type qualifications here
- % for the argument types, but explicit type qualification
- % doesn't work correctly with type inference due to
- % a bug somewhere in typecheck.m -- the explicitly declared
- % types are not kept in sync with the predicate's tvarset
- % after the first pass of type checking.
- % map__from_corresponding_lists(Args, Types, VarTypes0).
+ % for the argument types, but explicit type
+ % qualification doesn't work correctly with type
+ % inference due to a bug somewhere in typecheck.m
+ % -- the explicitly declared types are not kept in
+ % sync with the predicate's tvarset after the first
+ % pass of type checking.
+ % map__from_corresponding_lists(Args, Types, VarTypes0)
map__init(VarTypes0),
goal_info_init(GoalInfo0),
set__list_to_set(Args, NonLocals),
- goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo1),
+ goal_info_set_nonlocals(GoalInfo0, NonLocals,
+ GoalInfo1),
goal_info_set_context(GoalInfo1, Context, GoalInfo),
%
- % We don't record the called predicate as used --
- % it is only used if there is some other call.
- % This call is only used to make higher_order.m generate
+ % We don't record the called predicate as used -- it
+ % is only used if there is some other call. This call
+ % is only used to make higher_order.m generate
% the interface for the type specialized procedure, and
% will be removed by higher_order.m after that is done.
%
- do_construct_pred_or_func_call(PredId, PredOrFunc, SymName,
- Args, GoalInfo, Goal),
+ do_construct_pred_or_func_call(PredId, PredOrFunc,
+ SymName, Args, GoalInfo, Goal),
Clause = clause(ProcIds, Goal, mercury, Context),
map__init(TI_VarMap),
map__init(TCI_VarMap),
map__init(TVarNameMap),
HasForeignClauses = no,
- Clauses = clauses_info(ArgVarSet, VarTypes0, TVarNameMap,
- VarTypes0, Args, [Clause], TI_VarMap, TCI_VarMap,
- HasForeignClauses),
+ Clauses = clauses_info(ArgVarSet, VarTypes0,
+ TVarNameMap, VarTypes0, Args, [Clause],
+ TI_VarMap, TCI_VarMap, HasForeignClauses),
pred_info_get_markers(PredInfo0, Markers0),
- add_marker(Markers0, calls_are_fully_qualified, Markers),
+ add_marker(calls_are_fully_qualified,
+ Markers0, Markers),
map__init(Proofs),
( pred_info_is_imported(PredInfo0) ->
@@ -1331,12 +1258,14 @@
ExistQVars, Types, true, Context, Clauses,
Status, Markers, none, PredOrFunc,
ClassContext, Proofs, Owner, NewPredInfo0),
- pred_info_set_procedures(Procs, NewPredInfo0, NewPredInfo),
- module_info_get_predicate_table(ModuleInfo2, PredTable0),
+ pred_info_set_procedures(Procs,
+ NewPredInfo0, NewPredInfo),
+ module_info_get_predicate_table(ModuleInfo2,
+ PredTable0),
predicate_table_insert(PredTable0, NewPredInfo,
NewPredId, PredTable),
- module_info_set_predicate_table(ModuleInfo2,
- PredTable, ModuleInfo3),
+ module_info_set_predicate_table(PredTable,
+ ModuleInfo2, ModuleInfo3),
%
% Record the type specialisation in the module_info.
@@ -1347,15 +1276,18 @@
list__map(lambda([ProcId::in, PredProcId::out] is det, (
PredProcId = proc(PredId, ProcId)
)), ProcIds, PredProcIds),
- set__insert_list(ProcsToSpec0, PredProcIds, ProcsToSpec),
+ set__insert_list(ProcsToSpec0, PredProcIds,
+ ProcsToSpec),
set__insert(ForceVersions0, NewPredId, ForceVersions),
( Status = opt_imported ->
- % For imported predicates dead_proc_elim.m needs
- % to know that if the original predicate is used,
- % the predicate to force the production of the
- % specialised interface is also used.
- multi_map__set(SpecMap0, PredId, NewPredId, SpecMap)
+ % For imported predicates dead_proc_elim.m
+ % needs to know that if the original predicate
+ % is used, the predicate to force the
+ % production of the specialised interface is
+ % also used.
+ multi_map__set(SpecMap0, PredId, NewPredId,
+ SpecMap)
;
SpecMap = SpecMap0
),
@@ -1366,12 +1298,13 @@
multi_map__set(PragmaMap0, PredId, Pragma, PragmaMap),
TypeSpecInfo = type_spec_info(ProcsToSpec,
ForceVersions, SpecMap, PragmaMap),
- module_info_set_type_spec_info(ModuleInfo3,
- TypeSpecInfo, ModuleInfo),
+ module_info_set_type_spec_info(TypeSpecInfo,
+ ModuleInfo3, ModuleInfo),
TransformInfo1 = transform_info(ModuleInfo, Info0),
( status_is_imported(Status, yes) ->
- ItemType = pred_or_func_to_item_type(PredOrFunc),
+ ItemType =
+ pred_or_func_to_item_type(PredOrFunc),
apply_to_recompilation_info(
recompilation__record_expanded_items(
item_id(ItemType, SymName - Arity),
@@ -1382,9 +1315,9 @@
)
;
TransformInfo = transform_info(ModuleInfo2, Info0)
- }
+ )
;
- { TransformInfo = transform_info(ModuleInfo1, Info0) }
+ TransformInfo = transform_info(ModuleInfo1, Info0)
).
% Check that the type substitution for a `:- pragma type_spec'
@@ -1395,125 +1328,127 @@
% Type substitutions are also invalid if the replacement types are
% not ground, however this is a (hopefully temporary) limitation
% of the current implementation, so it only results in a warning.
-:- pred handle_pragma_type_spec_subst(prog_context, assoc_list(tvar, type),
- tvarset, pred_info, tvarset, list(type), existq_tvars,
- class_constraints, maybe(tsubst), module_info, module_info,
- io__state, io__state).
-:- mode handle_pragma_type_spec_subst(in, in, in, in, out, out, out, out, out,
- in, out, di, uo) is det.
+:- pred handle_pragma_type_spec_subst(prog_context::in,
+ assoc_list(tvar, type)::in, pred_info::in, tvarset::in, tvarset::out,
+ list(type)::out, existq_tvars::out, class_constraints::out,
+ maybe(tsubst)::out, module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
-handle_pragma_type_spec_subst(Context, Subst, TVarSet0, PredInfo0,
- TVarSet, Types, ExistQVars, ClassContext, SubstOk,
- ModuleInfo0, ModuleInfo) -->
- { assoc_list__keys(Subst, VarsToSub) },
+handle_pragma_type_spec_subst(Context, Subst, PredInfo0, TVarSet0, TVarSet,
+ Types, ExistQVars, ClassContext, SubstOk, !ModuleInfo, !IO) :-
+ assoc_list__keys(Subst, VarsToSub),
(
- { Subst = [] }
+ Subst = []
->
- { error("handle_pragma_type_spec_subst: empty substitution") }
+ error("handle_pragma_type_spec_subst: empty substitution")
;
- { find_duplicate_list_elements(VarsToSub, MultiSubstVars0) },
- { MultiSubstVars0 \= [] }
+ find_duplicate_list_elements(VarsToSub, MultiSubstVars0),
+ MultiSubstVars0 \= []
->
- { list__sort_and_remove_dups(MultiSubstVars0, MultiSubstVars) },
+ list__sort_and_remove_dups(MultiSubstVars0, MultiSubstVars),
report_multiple_subst_vars(PredInfo0, Context,
- TVarSet0, MultiSubstVars),
- { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
- io__set_exit_status(1),
- { ExistQVars = [] },
- { Types = [] },
- { ClassContext = constraints([], []) },
- { varset__init(TVarSet) },
- { SubstOk = no }
- ;
- { pred_info_typevarset(PredInfo0, CalledTVarSet) },
- { varset__create_name_var_map(CalledTVarSet, NameVarIndex0) },
- { list__filter(lambda([Var::in] is semidet, (
+ TVarSet0, MultiSubstVars, !IO),
+ module_info_incr_errors(!ModuleInfo),
+ io__set_exit_status(1, !IO),
+ ExistQVars = [],
+ Types = [],
+ ClassContext = constraints([], []),
+ varset__init(TVarSet),
+ SubstOk = no
+ ;
+ pred_info_typevarset(PredInfo0, CalledTVarSet),
+ varset__create_name_var_map(CalledTVarSet, NameVarIndex0),
+ list__filter((pred(Var::in) is semidet :-
varset__lookup_name(TVarSet0, Var, VarName),
\+ map__contains(NameVarIndex0, VarName)
- )), VarsToSub, UnknownVarsToSub) },
- ( { UnknownVarsToSub = [] } ->
+ ), VarsToSub, UnknownVarsToSub),
+ ( UnknownVarsToSub = [] ->
% Check that the substitution is not recursive.
- { set__list_to_set(VarsToSub, VarsToSubSet) },
+ set__list_to_set(VarsToSub, VarsToSubSet),
- { assoc_list__values(Subst, SubstTypes0) },
- { term__vars_list(SubstTypes0, TVarsInSubstTypes0) },
- { set__list_to_set(TVarsInSubstTypes0, TVarsInSubstTypes) },
-
- { set__intersect(TVarsInSubstTypes, VarsToSubSet,
- RecSubstTVars0) },
- { set__to_sorted_list(RecSubstTVars0, RecSubstTVars) },
-
- ( { RecSubstTVars = [] } ->
- { map__init(TVarRenaming0) },
- { list__append(VarsToSub, TVarsInSubstTypes0,
- VarsToReplace) },
-
- { get_new_tvars(VarsToReplace, TVarSet0, CalledTVarSet,
- TVarSet, NameVarIndex0, _,
- TVarRenaming0, TVarRenaming) },
-
- % Check that none of the existentially quantified
- % variables were substituted.
- { map__apply_to_list(VarsToSub, TVarRenaming,
- RenamedVarsToSub) },
- { pred_info_get_exist_quant_tvars(PredInfo0, ExistQVars) },
- { list__filter(lambda([RenamedVar::in] is semidet, (
+ assoc_list__values(Subst, SubstTypes0),
+ term__vars_list(SubstTypes0, TVarsInSubstTypes0),
+ set__list_to_set(TVarsInSubstTypes0,
+ TVarsInSubstTypes),
+
+ set__intersect(TVarsInSubstTypes, VarsToSubSet,
+ RecSubstTVars0),
+ set__to_sorted_list(RecSubstTVars0, RecSubstTVars),
+
+ ( RecSubstTVars = [] ->
+ map__init(TVarRenaming0),
+ list__append(VarsToSub, TVarsInSubstTypes0,
+ VarsToReplace),
+
+ get_new_tvars(VarsToReplace, TVarSet0,
+ CalledTVarSet, TVarSet, NameVarIndex0,
+ _, TVarRenaming0, TVarRenaming),
+
+ % Check that none of the existentially
+ % quantified variables were substituted.
+ map__apply_to_list(VarsToSub, TVarRenaming,
+ RenamedVarsToSub),
+ pred_info_get_exist_quant_tvars(PredInfo0,
+ ExistQVars),
+ list__filter((pred(RenamedVar::in) is semidet
+ :-
list__member(RenamedVar, ExistQVars)
- )), RenamedVarsToSub, SubExistQVars) },
- ( { SubExistQVars = [] } ->
- {
+ ), RenamedVarsToSub, SubExistQVars),
+ ( SubExistQVars = [] ->
map__init(TypeSubst0),
- term__apply_variable_renaming_to_list(SubstTypes0,
- TVarRenaming, SubstTypes),
- assoc_list__from_corresponding_lists(RenamedVarsToSub,
- SubstTypes, SubAL),
- list__foldl(
- lambda([(TVar - Type)::in, TSubst0::in,
- TSubst::out] is det, (
- map__set(TSubst0, TVar, Type, TSubst)
- )), SubAL, TypeSubst0, TypeSubst),
+ term__apply_variable_renaming_to_list(
+ SubstTypes0, TVarRenaming,
+ SubstTypes),
+ assoc_list__from_corresponding_lists(
+ RenamedVarsToSub, SubstTypes,
+ SubAL),
+ list__foldl((pred((TVar - Type)::in,
+ TSubst0::in,
+ TSubst::out) is det :-
+ map__set(TSubst0, TVar, Type,
+ TSubst)
+ ), SubAL, TypeSubst0, TypeSubst),
% Apply the substitution.
pred_info_arg_types(PredInfo0, Types0),
pred_info_get_class_context(PredInfo0,
ClassContext0),
- term__apply_rec_substitution_to_list(Types0,
- TypeSubst, Types),
- apply_rec_subst_to_constraints(TypeSubst,
- ClassContext0, ClassContext),
- SubstOk = yes(TypeSubst),
- ModuleInfo = ModuleInfo0
- }
- ;
- report_subst_existq_tvars(PredInfo0, Context,
- SubExistQVars),
- io__set_exit_status(1),
- { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
- { Types = [] },
- { ClassContext = constraints([], []) },
- { SubstOk = no }
+ term__apply_rec_substitution_to_list(
+ Types0, TypeSubst, Types),
+ apply_rec_subst_to_constraints(
+ TypeSubst, ClassContext0,
+ ClassContext),
+ SubstOk = yes(TypeSubst)
+ ;
+ report_subst_existq_tvars(PredInfo0,
+ Context, SubExistQVars, !IO),
+ io__set_exit_status(1, !IO),
+ module_info_incr_errors(!ModuleInfo),
+ Types = [],
+ ClassContext = constraints([], []),
+ SubstOk = no
)
;
report_recursive_subst(PredInfo0, Context,
- TVarSet0, RecSubstTVars),
- io__set_exit_status(1),
- { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
- { ExistQVars = [] },
- { Types = [] },
- { ClassContext = constraints([], []) },
- { varset__init(TVarSet) },
- { SubstOk = no }
+ TVarSet0, RecSubstTVars, !IO),
+ io__set_exit_status(1, !IO),
+ module_info_incr_errors(!ModuleInfo),
+ ExistQVars = [],
+ Types = [],
+ ClassContext = constraints([], []),
+ varset__init(TVarSet),
+ SubstOk = no
)
;
report_unknown_vars_to_subst(PredInfo0, Context,
- TVarSet0, UnknownVarsToSub),
- { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
- io__set_exit_status(1),
- { ExistQVars = [] },
- { Types = [] },
- { ClassContext = constraints([], []) },
- { varset__init(TVarSet) },
- { SubstOk = no }
+ TVarSet0, UnknownVarsToSub, !IO),
+ module_info_incr_errors(!ModuleInfo),
+ io__set_exit_status(1, !IO),
+ ExistQVars = [],
+ Types = [],
+ ClassContext = constraints([], []),
+ varset__init(TVarSet),
+ SubstOk = no
)
).
@@ -1670,105 +1605,106 @@
%-----------------------------------------------------------------------------%
-:- pred add_pragma_termination_info(pred_or_func, sym_name, list(mode),
- maybe(pragma_arg_size_info), maybe(pragma_termination_info),
- prog_context, module_info, module_info, io__state, io__state).
-:- mode add_pragma_termination_info(in, in, in, in, in, in, in, out, di, uo)
- is det.
+:- pred add_pragma_termination_info(pred_or_func::in, sym_name::in,
+ list(mode)::in, maybe(pragma_arg_size_info)::in,
+ maybe(pragma_termination_info)::in,
+ prog_context::in, module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
add_pragma_termination_info(PredOrFunc, SymName, ModeList,
MaybePragmaArgSizeInfo, MaybePragmaTerminationInfo,
- Context, Module0, Module) -->
- { module_info_get_predicate_table(Module0, Preds) },
- { list__length(ModeList, Arity) },
- (
- { predicate_table_search_pf_sym_arity(Preds, is_fully_qualified,
- PredOrFunc, SymName, Arity, PredIds) },
- { PredIds \= [] }
- ->
- ( { PredIds = [PredId] } ->
- { module_info_preds(Module0, PredTable0) },
- { map__lookup(PredTable0, PredId, PredInfo0) },
- { pred_info_procedures(PredInfo0, ProcTable0)},
- { map__to_assoc_list(ProcTable0, ProcList) },
- (
- { get_procedure_matching_declmodes(ProcList,
- ModeList, Module0, ProcId) }
- ->
- { add_context_to_arg_size_info(MaybePragmaArgSizeInfo,
- Context, MaybeArgSizeInfo) },
- { add_context_to_termination_info(
+ Context, !Module, !IO) :-
+ module_info_get_predicate_table(!.Module, Preds),
+ list__length(ModeList, Arity),
+ (
+ predicate_table_search_pf_sym_arity(Preds, is_fully_qualified,
+ PredOrFunc, SymName, Arity, PredIds),
+ PredIds \= []
+ ->
+ ( PredIds = [PredId] ->
+ module_info_preds(!.Module, PredTable0),
+ map__lookup(PredTable0, PredId, PredInfo0),
+ pred_info_procedures(PredInfo0, ProcTable0),
+ map__to_assoc_list(ProcTable0, ProcList),
+ (
+ get_procedure_matching_declmodes(ProcList,
+ ModeList, !.Module, ProcId)
+ ->
+ add_context_to_arg_size_info(
+ MaybePragmaArgSizeInfo,
+ Context, MaybeArgSizeInfo),
+ add_context_to_termination_info(
MaybePragmaTerminationInfo, Context,
- MaybeTerminationInfo) },
- { map__lookup(ProcTable0, ProcId, ProcInfo0) },
- { proc_info_set_maybe_arg_size_info(MaybeArgSizeInfo,
- ProcInfo0, ProcInfo1) },
- { proc_info_set_maybe_termination_info(
- MaybeTerminationInfo, ProcInfo1, ProcInfo) },
- { map__det_update(ProcTable0, ProcId, ProcInfo,
- ProcTable) },
- { pred_info_set_procedures(ProcTable,
- PredInfo0, PredInfo) },
- { map__det_update(PredTable0, PredId, PredInfo,
- PredTable) },
- { module_info_set_preds(Module0, PredTable,
- Module) }
- ;
- { module_info_incr_errors(Module0, Module) },
- prog_out__write_context(Context),
- io__write_string(
- "Error: `:- pragma termination_info' "),
- io__write_string(
- "declaration for undeclared mode of "),
+ MaybeTerminationInfo),
+ map__lookup(ProcTable0, ProcId, ProcInfo0),
+ proc_info_set_maybe_arg_size_info(
+ MaybeArgSizeInfo,
+ ProcInfo0, ProcInfo1),
+ proc_info_set_maybe_termination_info(
+ MaybeTerminationInfo,
+ ProcInfo1, ProcInfo),
+ map__det_update(ProcTable0, ProcId, ProcInfo,
+ ProcTable),
+ pred_info_set_procedures(ProcTable,
+ PredInfo0, PredInfo),
+ map__det_update(PredTable0, PredId, PredInfo,
+ PredTable),
+ module_info_set_preds(PredTable, !Module)
+ ;
+ module_info_incr_errors(!Module),
+ prog_out__write_context(Context, !IO),
+ io__write_string("Error: `:- pragma " ++
+ "termination_info' ", !IO),
+ io__write_string("declaration for " ++
+ "undeclared mode of ", !IO),
hlds_out__write_simple_call_id(PredOrFunc,
- SymName/Arity),
- io__write_string(".\n")
+ SymName/Arity, !IO),
+ io__write_string(".\n", !IO)
)
;
- prog_out__write_context(Context),
- io__write_string("Error: ambiguous predicate name "),
- hlds_out__write_simple_call_id(PredOrFunc, SymName/Arity),
- io__nl,
- prog_out__write_context(Context),
- io__write_string(
- " in `pragma termination_info'.\n"),
- { module_info_incr_errors(Module0, Module) }
+ prog_out__write_context(Context, !IO),
+ io__write_string("Error: ambiguous predicate name ",
+ !IO),
+ hlds_out__write_simple_call_id(PredOrFunc,
+ SymName/Arity, !IO),
+ io__nl(!IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" in `pragma termination_info'.\n",
+ !IO),
+ module_info_incr_errors(!Module)
)
;
% XXX This happens in `.trans_opt' files sometimes --
% so just ignore it
- { Module = Module0 }
- /***
- **** undefined_pred_or_func_error(
- **** SymName, Arity, Context,
- **** "`:- pragma termination_info' declaration"),
- **** { module_info_incr_errors(Module0, Module) }
- ***/
+ true
+ % undefined_pred_or_func_error(SymName, Arity, Context,
+ % "`:- pragma termination_info' declaration",
+ % !IO),
+ % module_info_incr_errors(!Module)
).
%-----------------------------------------------------------------------------%
-:- pred add_stratified_pred(module_info, string, sym_name, arity,
- term__context, module_info, io__state, io__state).
+:- pred add_stratified_pred(string, sym_name, arity,
+ term__context, module_info, 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) },
+add_stratified_pred(PragmaName, Name, Arity, Context, !Module, !IO) :-
+ module_info_get_predicate_table(!.Module, PredTable0),
(
- { predicate_table_search_sym_arity(PredTable0,
- is_fully_qualified, Name, Arity, PredIds) }
+ predicate_table_search_sym_arity(PredTable0,
+ is_fully_qualified, Name, Arity, PredIds)
->
- { module_info_stratified_preds(Module0, StratPredIds0) },
- { set__insert_list(StratPredIds0, PredIds, StratPredIds) },
- { module_info_set_stratified_preds(Module0, StratPredIds,
- Module) }
+ module_info_stratified_preds(!.Module, StratPredIds0),
+ set__insert_list(StratPredIds0, PredIds, StratPredIds),
+ module_info_set_stratified_preds(StratPredIds, !Module)
;
- { string__append_list(
+ string__append_list(
["`:- pragma ", PragmaName, "' declaration"],
- Description) },
- undefined_pred_or_func_error(Name, Arity, Context,
Description),
- { module_info_incr_errors(Module0, Module) }
+ undefined_pred_or_func_error(Name, Arity, Context,
+ Description, !IO),
+ module_info_incr_errors(!Module)
).
%-----------------------------------------------------------------------------%
@@ -1780,176 +1716,171 @@
% 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,
- import_status, prog_context, marker, list(marker), module_info,
- io__state, io__state).
-:- mode add_pred_marker(in, in, in, in, in, in, in, in, out, di, uo) is det.
+:- pred add_pred_marker(string::in, sym_name::in, arity::in, import_status::in,
+ prog_context::in, marker::in, list(marker)::in,
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
-add_pred_marker(Module0, PragmaName, Name, Arity, Status, Context, Marker,
- ConflictMarkers, Module) -->
- ( { marker_must_be_exported(Marker) } ->
- { MustBeExported = yes }
+add_pred_marker(PragmaName, Name, Arity, Status, Context, Marker,
+ ConflictMarkers, !Module, !IO) :-
+ ( marker_must_be_exported(Marker) ->
+ MustBeExported = yes
+ ;
+ MustBeExported = no
+ ),
+ do_add_pred_marker(PragmaName, Name, Arity, Status, MustBeExported,
+ Context, add_marker_pred_info(Marker), !Module, PredIds, !IO),
+ module_info_preds(!.Module, Preds),
+ pragma_check_markers(Preds, PredIds, ConflictMarkers, Conflict),
+ ( Conflict = yes ->
+ pragma_conflict_error(Name, Arity, Context, PragmaName, !IO),
+ module_info_incr_errors(!Module)
;
- { 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 }
+ true
).
-:- pred set_pred_owner(module_info, sym_name, arity, string, import_status,
- prog_context, module_info, io__state, io__state).
-:- mode set_pred_owner(in, in, in, in, in, in, out, di, uo) is det.
+:- pred set_pred_owner(sym_name::in, arity::in, string::in, import_status::in,
+ prog_context::in, module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
-set_pred_owner(Module0, Name, Arity, Owner, Status, Context, Module) -->
- { SetOwner =
- lambda([PredInfo0::in, PredInfo::out] is det, (
+set_pred_owner(Name, Arity, Owner, Status, Context, !Module, !IO) :-
+ SetOwner = (pred(PredInfo0::in, PredInfo::out) is det :-
pred_info_set_aditi_owner(Owner, PredInfo0, PredInfo)
- )) },
- { MarkerMustBeExported = yes },
- do_add_pred_marker(Module0, "owner", Name, Arity, Status,
- MarkerMustBeExported, Context, SetOwner, Module, _).
-
-:- pred add_base_relation_index(module_info, sym_name, arity, index_spec,
- import_status, prog_context, module_info, io__state, io__state).
-:- mode add_base_relation_index(in, in, in, in, in, in, out, di, uo) is det.
-
-add_base_relation_index(Module0, Name, Arity, Index, Status,
- Context, Module) -->
- { AddIndex =
- lambda([PredInfo0::in, PredInfo::out] is det, (
+ ),
+ MarkerMustBeExported = yes,
+ do_add_pred_marker("owner", Name, Arity, Status,
+ MarkerMustBeExported, Context, SetOwner, !Module, _, !IO).
+
+:- pred add_base_relation_index(sym_name::in, arity::in, index_spec::in,
+ import_status::in, prog_context::in, module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
+
+add_base_relation_index(Name, Arity, Index, Status, Context, !Module, !IO) :-
+ AddIndex = (pred(PredInfo0::in, PredInfo::out) is det :-
pred_info_get_indexes(PredInfo0, Indexes0),
Indexes = [Index | Indexes0],
pred_info_set_indexes(Indexes, PredInfo0, PredInfo)
- )) },
- { MarkerMustBeExported = yes },
- do_add_pred_marker(Module0, "aditi_index", Name, Arity, Status,
- MarkerMustBeExported, Context, AddIndex, Module, PredIds),
- { Index = index_spec(_, Attrs) },
- list__foldl(check_index_attribute(Name, Arity, Context), Attrs),
- list__foldl(check_index_attribute_pred(Module, Name,
- Arity, Context, Attrs), PredIds).
+ ),
+ MarkerMustBeExported = yes,
+ do_add_pred_marker("aditi_index", Name, Arity, Status,
+ MarkerMustBeExported, Context, AddIndex, !Module,
+ PredIds, !IO),
+ Index = index_spec(_, Attrs),
+ list__foldl(check_index_attribute(Name, Arity, Context), Attrs, !IO),
+ list__foldl(check_index_attribute_pred(!.Module, Name, Arity, Context,
+ Attrs), PredIds, !IO).
% Check that the index attributes are legal for the predicate's arity.
-:- pred check_index_attribute(sym_name, arity, term__context, int,
- io__state, io__state).
-:- mode check_index_attribute(in, in, in, in, di, uo) is det.
+:- pred check_index_attribute(sym_name::in, arity::in, term__context::in,
+ int::in, io__state::di, io__state::uo) is det.
-check_index_attribute(Name, Arity, Context, Attr) -->
- ( { Attr > 0, Attr =< Arity } ->
- []
+check_index_attribute(Name, Arity, Context, Attr, !IO) :-
+ ( ( Attr > 0, Attr =< Arity ) ->
+ true
;
- prog_out__write_context(Context),
+ prog_out__write_context(Context, !IO),
io__write_string(
- "In `:- pragma aditi_index' declaration for `"),
- prog_out__write_sym_name_and_arity(Name/Arity),
- io__write_string("':\n"),
- prog_out__write_context(Context),
- io__write_string(" attribute "),
- io__write_int(Attr),
- io__write_string(" is out of range.\n"),
- io__set_exit_status(1)
+ "In `:- pragma aditi_index' declaration for `", !IO),
+ prog_out__write_sym_name_and_arity(Name/Arity, !IO),
+ io__write_string("':\n", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" attribute ", !IO),
+ io__write_int(Attr, !IO),
+ io__write_string(" is out of range.\n", !IO),
+ io__set_exit_status(1, !IO)
).
% Check that a relation with an index specified is a base relation
% and that the indexed attributes do not include aditi__states.
-:- pred check_index_attribute_pred(module_info, sym_name, arity, term__context,
- list(int), pred_id, io__state, io__state).
-:- mode check_index_attribute_pred(in, in, in, in, in, in, di, uo) is det.
-
-check_index_attribute_pred(ModuleInfo, Name, Arity, Context, Attrs, PredId) -->
- { module_info_pred_info(ModuleInfo, PredId, PredInfo) },
- { pred_info_get_markers(PredInfo, Markers) },
- { PredOrFunc = pred_info_is_pred_or_func(PredInfo) },
- ( { check_marker(Markers, base_relation) } ->
- []
+:- pred check_index_attribute_pred(module_info::in, sym_name::in, arity::in,
+ term__context::in, list(int)::in, pred_id::in,
+ io__state::di, io__state::uo) is det.
+
+check_index_attribute_pred(ModuleInfo, Name, Arity, Context, Attrs, PredId,
+ !IO) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_get_markers(PredInfo, Markers),
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ ( check_marker(Markers, base_relation) ->
+ true
;
- prog_out__write_context(Context),
+ prog_out__write_context(Context, !IO),
io__write_string(
- "Error: `:- pragma aditi_index' declaration"),
- io__nl,
- prog_out__write_context(Context),
- io__write_string(" for "),
- hlds_out__write_simple_call_id(PredOrFunc, Name/Arity),
- io__write_string(" without preceding\n"),
- prog_out__write_context(Context),
+ "Error: `:- pragma aditi_index' declaration", !IO),
+ io__nl(!IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" for ", !IO),
+ hlds_out__write_simple_call_id(PredOrFunc, Name/Arity, !IO),
+ io__write_string(" without preceding\n", !IO),
+ prog_out__write_context(Context, !IO),
io__write_string(
- " `:- pragma base_relation' declaration.\n"),
- io__set_exit_status(1)
+ " `:- pragma base_relation' declaration.\n", !IO),
+ io__set_exit_status(1, !IO)
),
- { pred_info_arg_types(PredInfo, ArgTypes) },
- { AttrIsAditiState =
- lambda([Attr::in] is semidet, (
+ pred_info_arg_types(PredInfo, ArgTypes),
+ AttrIsAditiState = (pred(Attr::in) is semidet :-
list__index0(ArgTypes, Attr, ArgType),
type_is_aditi_state(ArgType)
- )) },
- { list__filter(AttrIsAditiState, Attrs, AditiStateAttrs) },
+ ),
+ list__filter(AttrIsAditiState, Attrs, AditiStateAttrs),
- ( { AditiStateAttrs = [AditiStateAttr | _] } ->
+ ( AditiStateAttrs = [AditiStateAttr | _] ->
% Indexing on aditi__state attributes is pretty silly,
% since they're removed by magic.m.
- prog_out__write_context(Context),
+ prog_out__write_context(Context, !IO),
io__write_string(
- "In `:- pragma aditi_index' declaration for "),
- hlds_out__write_simple_call_id(PredOrFunc, Name/Arity),
- io__write_string(":\n"),
- prog_out__write_context(Context),
- io__write_string(" attribute "),
- io__write_int(AditiStateAttr),
- io__write_string(" is an aditi__state.\n"),
- io__set_exit_status(1)
+ "In `:- pragma aditi_index' declaration for ", !IO),
+ hlds_out__write_simple_call_id(PredOrFunc, Name/Arity, !IO),
+ io__write_string(":\n", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" attribute ", !IO),
+ io__write_int(AditiStateAttr, !IO),
+ io__write_string(" is an aditi__state.\n", !IO),
+ io__set_exit_status(1, !IO)
;
- []
+ true
).
:- 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.
+:- pred do_add_pred_marker(string::in, sym_name::in, arity::in,
+ import_status::in, bool::in, term__context::in,
+ add_marker_pred_info::in(add_marker_pred_info),
+ module_info::in, module_info::out, list(pred_id)::out,
+ io__state::di, io__state::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) },
+do_add_pred_marker(PragmaName, Name, Arity, Status, MustBeExported, Context,
+ UpdatePredInfo, !Module, PredIds, !IO) :-
+ ( get_matching_pred_ids(!.Module, Name, Arity, PredIds0) ->
+ PredIds = PredIds0,
+ module_info_get_predicate_table(!.Module, PredTable0),
+ predicate_table_get_preds(PredTable0, Preds0),
- { pragma_add_marker(Preds0, PredIds, UpdatePredInfo,
- Status, MustBeExported, Preds, WrongStatus) },
+ pragma_add_marker(PredIds, UpdatePredInfo, Status,
+ MustBeExported, Preds0, Preds, WrongStatus),
(
- { WrongStatus = yes }
+ WrongStatus = yes
->
- pragma_status_error(Name, Arity, Context, PragmaName),
- { module_info_incr_errors(Module0, Module1) }
+ pragma_status_error(Name, Arity, Context, PragmaName,
+ !IO),
+ module_info_incr_errors(!Module)
;
- { Module1 = Module0 }
+ true
),
- { predicate_table_set_preds(PredTable0, Preds,
- PredTable) },
- { module_info_set_predicate_table(Module1, PredTable,
- Module) }
+ predicate_table_set_preds(PredTable0, Preds,
+ PredTable),
+ module_info_set_predicate_table(PredTable, !Module)
;
- { PredIds = [] },
- { string__append_list(
+ PredIds = [],
+ string__append_list(
["`:- pragma ", PragmaName, "' declaration"],
- Description) },
- undefined_pred_or_func_error(Name, Arity, Context,
Description),
- { module_info_incr_errors(Module0, Module) }
+ undefined_pred_or_func_error(Name, Arity, Context,
+ Description, !IO),
+ module_info_incr_errors(!Module)
).
:- pred get_matching_pred_ids(module_info, sym_name, arity, list(pred_id)).
@@ -1991,43 +1922,42 @@
:- pred module_mark_preds_as_external(list(pred_id), module_info, module_info).
:- mode module_mark_preds_as_external(in, in, out) is det.
-module_mark_preds_as_external([], Module, Module).
-module_mark_preds_as_external([PredId | PredIds], Module0, Module) :-
- module_info_preds(Module0, Preds0),
+module_mark_preds_as_external([], !Module).
+module_mark_preds_as_external([PredId | PredIds], !Module) :-
+ module_info_preds(!.Module, Preds0),
map__lookup(Preds0, PredId, PredInfo0),
pred_info_mark_as_external(PredInfo0, PredInfo),
map__det_update(Preds0, PredId, PredInfo, Preds),
- module_info_set_preds(Module0, Preds, Module1),
- module_mark_preds_as_external(PredIds, Module1, Module).
+ module_info_set_preds(Preds, !Module),
+ module_mark_preds_as_external(PredIds, !Module).
%-----------------------------------------------------------------------------%
-:- pred module_add_inst_defn(module_info, inst_varset, sym_name, list(inst_var),
+:- pred module_add_inst_defn(inst_varset, sym_name, list(inst_var),
inst_defn, condition, prog_context, item_status,
- module_info, bool, io__state, io__state).
-:- mode module_add_inst_defn(in, in, in, in, in, in, in, in,
- out, out, di, uo) is det.
+ module_info, module_info, bool, io__state, io__state).
+:- mode module_add_inst_defn(in, in, in, in, in, in, in,
+ in, out, out, di, uo) is det.
-module_add_inst_defn(Module0, VarSet, Name, Args, InstDefn, Cond,
- Context, item_status(Status, _NeedQual),
- Module, InvalidMode) -->
+module_add_inst_defn(VarSet, Name, Args, InstDefn, Cond, Context,
+ item_status(Status, _NeedQual), !Module, InvalidMode, !IO) :-
%
% add the definition of this inst to the HLDS inst table
%
- { module_info_insts(Module0, InstTable0) },
- { inst_table_get_user_insts(InstTable0, Insts0) },
+ module_info_insts(!.Module, InstTable0),
+ inst_table_get_user_insts(InstTable0, Insts0),
insts_add(Insts0, VarSet, Name, Args, InstDefn, Cond,
- Context, Status, Insts),
- { inst_table_set_user_insts(InstTable0, Insts, InstTable) },
- { module_info_set_insts(Module0, InstTable, Module) },
+ Context, Status, Insts, !IO),
+ inst_table_set_user_insts(InstTable0, Insts, InstTable),
+ module_info_set_insts(InstTable, !Module),
%
% check if the inst is infinitely recursive (at the top level)
%
- { Arity = list__length(Args) },
- { InstId = Name - Arity },
- { TestArgs = list__duplicate(Arity, not_reached) },
+ Arity = list__length(Args),
+ InstId = Name - Arity,
+ TestArgs = list__duplicate(Arity, not_reached),
check_for_cyclic_inst(Insts, InstId, InstId, TestArgs, [], Context,
- InvalidMode).
+ InvalidMode, !IO).
:- pred insts_add(user_inst_table, inst_varset, sym_name, list(inst_var),
inst_defn, condition, prog_context, import_status,
@@ -2095,19 +2025,19 @@
%-----------------------------------------------------------------------------%
-:- pred module_add_mode_defn(module_info, inst_varset, sym_name,
- list(inst_var), mode_defn, condition, prog_context,
- item_status, module_info, bool, io__state, io__state).
-:- mode module_add_mode_defn(in, in, in, in, in, in, in,
- in, out, out, di, uo) is det.
+:- pred module_add_mode_defn(inst_varset, sym_name, list(inst_var), mode_defn,
+ condition, prog_context, item_status, module_info, module_info,
+ bool, io__state, io__state).
+:- mode module_add_mode_defn(in, in, in, in, in, in,
+ in, in, out, out, di, uo) is det.
-module_add_mode_defn(Module0, VarSet, Name, Params, ModeDefn, Cond,
+module_add_mode_defn(VarSet, Name, Params, ModeDefn, Cond,
Context, item_status(Status, _NeedQual),
- Module, InvalidMode) -->
- { module_info_modes(Module0, Modes0) },
+ !Module, InvalidMode, !IO) :-
+ module_info_modes(!.Module, Modes0),
modes_add(Modes0, VarSet, Name, Params, ModeDefn,
- Cond, Context, Status, Modes, InvalidMode),
- { module_info_set_modes(Module0, Modes, Module) }.
+ Cond, Context, Status, Modes, InvalidMode, !IO),
+ module_info_set_modes(Modes, !Module).
:- pred modes_add(mode_table, inst_varset, sym_name, list(inst_var),
mode_defn, condition, prog_context, import_status,
@@ -2211,33 +2141,33 @@
% e.g. `:- type t.', which is parsed as an type definition for
% t which defines t as an abstract_type.
-:- pred module_add_type_defn(module_info, tvarset, sym_name, list(type_param),
+:- pred module_add_type_defn(tvarset, sym_name, list(type_param),
type_defn, condition, prog_context, item_status,
- module_info, io__state, io__state).
+ module_info, module_info, io__state, io__state).
:- mode module_add_type_defn(in, in, in, in, in,
in, in, in, out, di, uo) is det.
-module_add_type_defn(Module0, TVarSet, Name, Args, TypeDefn, Cond, Context,
- item_status(Status0, NeedQual), Module) -->
- globals__io_get_globals(Globals),
- { list__length(Args, Arity) },
- { TypeCtor = Name - Arity },
- { convert_type_defn(TypeDefn, TypeCtor, Globals, Body) },
- module_add_type_defn_2(Module0, TVarSet, Name, Args, Body, Cond,
- Context, item_status(Status0, NeedQual), Module).
+module_add_type_defn(TVarSet, Name, Args, TypeDefn, Cond, Context,
+ item_status(Status0, NeedQual), !Module, !IO) :-
+ globals__io_get_globals(Globals, !IO),
+ list__length(Args, Arity),
+ TypeCtor = Name - Arity,
+ convert_type_defn(TypeDefn, TypeCtor, Globals, Body),
+ module_add_type_defn_2(TVarSet, Name, Args, Body, Cond,
+ Context, item_status(Status0, NeedQual), !Module, !IO).
-:- pred module_add_type_defn_2(module_info, tvarset, sym_name, list(type_param),
+:- pred module_add_type_defn_2(tvarset, sym_name, list(type_param),
hlds_type_body, condition, prog_context, item_status,
- module_info, io__state, io__state).
+ module_info, module_info, io__state, io__state).
:- mode module_add_type_defn_2(in, in, in, in, in,
in, in, in, out, di, uo) is det.
-module_add_type_defn_2(Module0, TVarSet, Name, Args, Body0, _Cond, Context,
- item_status(Status0, NeedQual), Module) -->
- { module_info_types(Module0, Types0) },
- { list__length(Args, Arity) },
- { TypeCtor = Name - Arity },
- {
+module_add_type_defn_2(TVarSet, Name, Args, Body0, _Cond, Context,
+ item_status(Status0, NeedQual), !Module, !IO) :-
+ module_info_types(!.Module, Types0),
+ list__length(Args, Arity),
+ TypeCtor = Name - Arity,
+ (
(
Body0 = abstract_type(_)
;
@@ -2252,147 +2182,141 @@
make_status_abstract(Status0, Status1)
;
Status1 = Status0
- },
+ ),
(
% the type is exported if *any* occurrence is exported,
% even a previous abstract occurrence
- { map__search(Types0, TypeCtor, OldDefn0) }
+ map__search(Types0, TypeCtor, OldDefn0)
->
- { hlds_data__get_type_defn_status(OldDefn0, OldStatus) },
- { combine_status(Status1, OldStatus, Status) },
- { hlds_data__get_type_defn_body(OldDefn0, OldBody0) },
- { combine_is_solver_type(OldBody0, OldBody, Body0, Body) },
- ( { is_solver_type_is_inconsistent(OldBody, Body) } ->
+ hlds_data__get_type_defn_status(OldDefn0, OldStatus),
+ combine_status(Status1, OldStatus, Status),
+ hlds_data__get_type_defn_body(OldDefn0, OldBody0),
+ combine_is_solver_type(OldBody0, OldBody, Body0, Body),
+ ( is_solver_type_is_inconsistent(OldBody, Body) ->
% The existing definition has an is_solver_type
% annotation which is different to the current
% definition.
- { module_info_incr_errors(Module0, Module1) },
- { Pieces0 = [words("In definition of type"),
+ module_info_incr_errors(!Module),
+ Pieces0 = [words("In definition of type"),
fixed(describe_sym_name_and_arity(
Name / Arity) ++ ":"), nl,
words("error: all definitions of a type must"),
words("have consistent `solver'"),
- words("annotations")] },
- error_util__write_error_pieces(Context, 0, Pieces0),
- { MaybeOldDefn = no }
- ;
- { hlds_data__set_type_defn_body(OldDefn0, OldBody,
- OldDefn) },
- { MaybeOldDefn = yes(OldDefn) },
- { Module1 = Module0 }
- )
- ;
- { MaybeOldDefn = no },
- { Status = Status1 },
- { Body = Body0 },
- { Module1 = Module0 }
+ words("annotations")],
+ error_util__write_error_pieces(Context, 0, Pieces0,
+ !IO),
+ MaybeOldDefn = no
+ ;
+ hlds_data__set_type_defn_body(OldDefn0, OldBody,
+ OldDefn),
+ MaybeOldDefn = yes(OldDefn)
+ )
+ ;
+ MaybeOldDefn = no,
+ Status = Status1,
+ Body = Body0
),
- { hlds_data__set_type_defn(TVarSet, Args, Body, Status,
- NeedQual, Context, T) },
+ hlds_data__set_type_defn(TVarSet, Args, Body, Status,
+ NeedQual, Context, T),
(
% if there was an existing non-abstract definition for the type
- { MaybeOldDefn = yes(T2) },
- { hlds_data__get_type_defn_tvarset(T2, TVarSet_2) },
- { hlds_data__get_type_defn_tparams(T2, Params_2) },
- { hlds_data__get_type_defn_body(T2, Body_2) },
- { hlds_data__get_type_defn_context(T2, OrigContext) },
- { hlds_data__get_type_defn_status(T2, OrigStatus) },
- { hlds_data__get_type_defn_need_qualifier(T2,
- OrigNeedQual) },
- { Body_2 \= abstract_type(_) }
+ MaybeOldDefn = yes(T2),
+ hlds_data__get_type_defn_tvarset(T2, TVarSet_2),
+ hlds_data__get_type_defn_tparams(T2, Params_2),
+ hlds_data__get_type_defn_body(T2, Body_2),
+ hlds_data__get_type_defn_context(T2, OrigContext),
+ hlds_data__get_type_defn_status(T2, OrigStatus),
+ hlds_data__get_type_defn_need_qualifier(T2, OrigNeedQual),
+ Body_2 \= abstract_type(_)
->
- globals__io_get_target(Target),
+ globals__io_get_target(Target, !IO),
globals__io_lookup_bool_option(make_optimization_interface,
- MakeOptInt),
+ MakeOptInt, !IO),
(
% then if this definition was abstract, ignore it
% (but update the status of the old defn if necessary)
- { Body = abstract_type(_) }
- ->
- {
- Status = OrigStatus
+ Body = abstract_type(_)
->
- Module = Module1
+ ( Status = OrigStatus ->
+ true
;
hlds_data__set_type_defn(TVarSet_2, Params_2,
Body_2, Status, OrigNeedQual,
OrigContext, T3),
map__det_update(Types0, TypeCtor, T3, Types),
- module_info_set_types(Module1, Types, Module)
- }
+ module_info_set_types(Types, !Module)
+ )
;
- { merge_foreign_type_bodies(Target, MakeOptInt,
- Body, Body_2, NewBody) }
+ merge_foreign_type_bodies(Target, MakeOptInt,
+ Body, Body_2, NewBody)
->
(
- { check_foreign_type_visibility(OrigStatus,
- Status1) }
+ check_foreign_type_visibility(OrigStatus,
+ Status1)
->
- { hlds_data__set_type_defn(TVarSet_2, Params_2,
+ hlds_data__set_type_defn(TVarSet_2, Params_2,
NewBody, Status, NeedQual,
- Context, T3) },
- { map__det_update(Types0,
- TypeCtor, T3, Types) },
- { module_info_set_types(Module1,
- Types, Module) }
+ Context, T3),
+ map__det_update(Types0, TypeCtor, T3, Types),
+ module_info_set_types(Types, !Module)
;
- { module_info_incr_errors(Module1, Module) },
- { Pieces = [words("In definition of type"),
+ module_info_incr_errors(!Module),
+ Pieces = [words("In definition of type"),
fixed(describe_sym_name_and_arity(
Name / Arity) ++ ":"), nl,
words("error: all definitions of a"),
words("type must have the same"),
- words("visibility")] },
+ words("visibility")],
error_util__write_error_pieces(Context, 0,
- Pieces)
+ Pieces, !IO)
)
;
% otherwise issue an error message if the second
% definition wasn't read while reading .opt files.
- { Status = opt_imported }
+ Status = opt_imported
->
- { Module = Module1 }
+ true
;
- { module_info_incr_errors(Module1, Module) },
- multiple_def_error(Status, Name, Arity, "type", Context,
- OrigContext, _)
+ module_info_incr_errors(!Module),
+ multiple_def_error(Status, Name, Arity, "type",
+ Context, OrigContext, _, !IO)
)
;
- { map__set(Types0, TypeCtor, T, Types) },
- { module_info_set_types(Module1, Types, Module) },
+ map__set(Types0, TypeCtor, T, Types),
+ module_info_set_types(Types, !Module),
(
% XXX we can't handle abstract exported
% polymorphic equivalence types with monomorphic
% bodies, because the compiler stuffs up the
% type_info handling -- the caller passes type_infos,
% but the callee expects no type_infos
- { Body = eqv_type(EqvType) },
- { Status = abstract_exported },
- { term__contains_var_list(Args, Var) },
- { \+ term__contains_var(EqvType, Var) }
- ->
- prog_out__write_context(Context),
- io__write_string(
- "Sorry, not implemented: polymorphic equivalence type,\n"),
- prog_out__write_context(Context),
- io__write_string(
- " with monomorphic definition, exported as abstract type.\n"),
+ Body = eqv_type(EqvType),
+ Status = abstract_exported,
+ term__contains_var_list(Args, Var),
+ \+ term__contains_var(EqvType, Var)
+ ->
+ prog_out__write_context(Context, !IO),
+ io__write_string("Sorry, not implemented: " ++
+ "polymorphic equivalence type,\n", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" with monomorphic definition, " ++
+ "exported as abstract type.\n", !IO),
globals__io_lookup_bool_option(verbose_errors,
- VerboseErrors),
- ( { VerboseErrors = yes } ->
+ VerboseErrors, !IO),
+ ( VerboseErrors = yes ->
io__write_strings([
"\tA quick work-around is just export the type as a concrete type,\n",
"\tby putting the type definition in the interface section.\n",
"\tA better work-around is to use a ""wrapper"" type, with just one\n",
"\tfunctor that has just one arg, instead of an equivalence type.\n",
"\t(There's no performance penalty for this -- the compiler will\n",
- "\toptimize the wrapper away.)\n"])
+ "\toptimize the wrapper away.)\n"], !IO)
;
- []
+ true
),
- io__set_exit_status(1)
+ io__set_exit_status(1, !IO)
;
- []
+ true
)
).
@@ -2439,7 +2363,6 @@
maybe_get_body_is_solver_type(abstract_type(IsSolverType), IsSolverType).
maybe_get_body_is_solver_type(foreign_type(_, IsSolverType), IsSolverType).
-
% check_foreign_type_visibility(OldStatus, NewDefnStatus).
%
% Check that the visibility of the new definition for
@@ -2461,77 +2384,73 @@
% Add the constructors and special preds for a type to the HLDS.
:- pred process_type_defn(type_ctor::in, hlds_type_defn::in,
- {bool, module_info}::in, {bool, module_info}::out,
+ bool::in, bool::out, module_info::in, module_info::out,
io__state::di, io__state::uo) is det.
-process_type_defn(TypeCtor, TypeDefn, {FoundError0, Module0},
- {FoundError, Module}) -->
- { hlds_data__get_type_defn_context(TypeDefn, Context) },
- { hlds_data__get_type_defn_tvarset(TypeDefn, TVarSet) },
- { hlds_data__get_type_defn_tparams(TypeDefn, Args) },
- { hlds_data__get_type_defn_body(TypeDefn, Body) },
- { hlds_data__get_type_defn_status(TypeDefn, Status) },
- { hlds_data__get_type_defn_need_qualifier(TypeDefn, NeedQual) },
-
- (
- { ConsList = Body ^ du_type_ctors },
- { ReservedTag = Body ^ du_type_reserved_tag },
- { module_info_ctors(Module0, Ctors0) },
- { module_info_get_partial_qualifier_info(Module0, PQInfo) },
+process_type_defn(TypeCtor, TypeDefn, !FoundError, !Module, !IO) :-
+ hlds_data__get_type_defn_context(TypeDefn, Context),
+ hlds_data__get_type_defn_tvarset(TypeDefn, TVarSet),
+ hlds_data__get_type_defn_tparams(TypeDefn, Args),
+ hlds_data__get_type_defn_body(TypeDefn, Body),
+ hlds_data__get_type_defn_status(TypeDefn, Status),
+ hlds_data__get_type_defn_need_qualifier(TypeDefn, NeedQual),
+ (
+ ConsList = Body ^ du_type_ctors,
+ ReservedTag = Body ^ du_type_reserved_tag,
+ module_info_ctors(!.Module, Ctors0),
+ module_info_get_partial_qualifier_info(!.Module, PQInfo),
check_for_errors(
- (pred(M0::in, M::out, di, uo) is det -->
- { module_info_ctor_field_table(M0, CtorFields0) },
- ctors_add(ConsList, TypeCtor, TVarSet, NeedQual,
- PQInfo, Context, Status,
- CtorFields0, CtorFields, Ctors0, Ctors),
- { module_info_set_ctors(M0, Ctors, M1) },
- { module_info_set_ctor_field_table(M1,
- CtorFields, M) }
- ), FoundError1, Module0, Module1),
+ (pred(M0::in, M::out, IO0::di, IO::uo) is det :-
+ module_info_ctor_field_table(M0, CtorFields0),
+ ctors_add(ConsList, TypeCtor, TVarSet,
+ NeedQual, PQInfo, Context, Status,
+ CtorFields0, CtorFields, Ctors0, Ctors,
+ IO0, IO),
+ module_info_set_ctors(Ctors, M0, M1),
+ module_info_set_ctor_field_table(CtorFields,
+ M1, M)
+ ), NewFoundError, !Module, !IO),
- globals__io_get_globals(Globals),
- {
+ globals__io_get_globals(Globals, !IO),
+ (
type_constructors_should_be_no_tag(ConsList,
ReservedTag, Globals, Name, CtorArgType, _)
->
NoTagType = no_tag_type(Args, Name, CtorArgType),
- module_info_no_tag_types(Module1, NoTagTypes0),
+ module_info_no_tag_types(!.Module, NoTagTypes0),
map__set(NoTagTypes0, TypeCtor, NoTagType, NoTagTypes),
- module_info_set_no_tag_types(Module1,
- NoTagTypes, Module2)
+ module_info_set_no_tag_types(NoTagTypes, !Module)
;
- Module2 = Module1
- }
+ true
+ )
+ ;
+ Body = abstract_type(_),
+ NewFoundError = no
;
- { Body = abstract_type(_) },
- { FoundError1 = no },
- { Module2 = Module0 }
- ;
- { Body = eqv_type(_) },
- { FoundError1 = no },
- { Module2 = Module0 }
- ;
- { Body = foreign_type(ForeignTypeBody, _) },
- check_foreign_type(TypeCtor, ForeignTypeBody,
- Context, FoundError1, Module0, Module2)
+ Body = eqv_type(_),
+ NewFoundError = no
+ ;
+ Body = foreign_type(ForeignTypeBody, _),
+ check_foreign_type(TypeCtor, ForeignTypeBody, Context,
+ NewFoundError, !Module, !IO)
),
- { FoundError = FoundError0 `and` FoundError1 },
- {
- FoundError = yes
+ !:FoundError = !.FoundError `and` NewFoundError,
+ (
+ !.FoundError = yes
->
- Module = Module2
+ true
;
% Equivalence types are fully expanded on the IL and Java
% backends, so the special predicates aren't required.
- are_equivalence_types_expanded(Module2),
+ are_equivalence_types_expanded(!.Module),
Body = eqv_type(_)
->
- Module = Module2
+ true
;
construct_type(TypeCtor, Args, Type),
- add_special_preds(Module2, TVarSet, Type, TypeCtor,
- Body, Context, Status, Module)
- }.
+ add_special_preds(TVarSet, Type, TypeCtor, Body, Context,
+ Status, !Module)
+ ).
% check_foreign_type ensures that if we are generating code for
% a specific backend that the foreign type has a representation
@@ -2541,21 +2460,20 @@
io::di, io::uo) is det.
check_foreign_type(TypeCtor, ForeignTypeBody, Context, FoundError,
- Module0, Module) -->
- { TypeCtor = Name - Arity },
- { module_info_globals(Module0, Globals) },
- generating_code(GeneratingCode),
- { globals__get_target(Globals, Target) },
- ( { have_foreign_type_for_backend(Target, ForeignTypeBody, yes) } ->
- { FoundError = no },
- { Module = Module0 }
- ; { GeneratingCode = yes } ->
+ !Module, !IO) :-
+ TypeCtor = Name - Arity,
+ module_info_globals(!.Module, Globals),
+ generating_code(GeneratingCode, !IO),
+ globals__get_target(Globals, Target),
+ ( have_foreign_type_for_backend(Target, ForeignTypeBody, yes) ->
+ FoundError = no
+ ; GeneratingCode = yes ->
%
% If we're not generating code the error may only have
% occurred because the grade options weren't passed.
%
- io_lookup_bool_option(very_verbose, VeryVerbose),
- { VeryVerbose = yes ->
+ io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ ( VeryVerbose = yes ->
VerboseErrorPieces = [
nl,
words("There are representations for"),
@@ -2564,27 +2482,23 @@
]
;
VerboseErrorPieces = []
- },
- { Target = c, LangStr = "C"
+ ),
+ ( Target = c, LangStr = "C"
; Target = il, LangStr = "IL"
; Target = java, LangStr = "Java"
; Target = asm, LangStr = "C"
- },
- { TypeStr =
- error_util__describe_sym_name_and_arity(
- Name/Arity) },
- { ErrorPieces = [
+ ),
+ TypeStr = error_util__describe_sym_name_and_arity(Name/Arity),
+ ErrorPieces = [
words("Error: no"), words(LangStr),
words("`pragma foreign_type' declaration for"),
fixed(TypeStr) | VerboseErrorPieces
- ] },
- error_util__write_error_pieces(Context,
- 0, ErrorPieces),
- { FoundError = yes },
- { module_info_incr_errors(Module0, Module) }
+ ],
+ error_util__write_error_pieces(Context, 0, ErrorPieces, !IO),
+ FoundError = yes,
+ module_info_incr_errors(!Module)
;
- { FoundError = yes },
- { Module = Module0 }
+ FoundError = yes
).
% Do the options imply that we will generate code for a specific
@@ -2959,24 +2873,23 @@
%-----------------------------------------------------------------------------%
-:- pred module_add_pred_or_func(module_info, tvarset, inst_varset,
- existq_tvars, pred_or_func, sym_name, list(type_and_mode),
- maybe(determinism), condition, purity, class_constraints,
- pred_markers, prog_context, item_status,
- maybe(pair(pred_id, proc_id)), module_info,
- io__state, io__state).
-:- mode module_add_pred_or_func(in, in, in, in, in, in, in, in, in, in, in, in,
- in, in, out, out, di, uo) is det.
+:- pred module_add_pred_or_func(tvarset::in, inst_varset::in, existq_tvars::in,
+ pred_or_func::in, sym_name::in, list(type_and_mode)::in,
+ maybe(determinism)::in, condition::in, purity::in,
+ class_constraints::in, pred_markers::in, prog_context::in,
+ item_status::in, maybe(pair(pred_id, proc_id))::out,
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
-module_add_pred_or_func(Module0, TypeVarSet, InstVarSet, ExistQVars,
+module_add_pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
PredOrFunc, PredName, TypesAndModes, MaybeDet, Cond, Purity,
ClassContext, Markers, Context, item_status(Status, NeedQual),
- MaybePredProcId, Module) -->
- { split_types_and_modes(TypesAndModes, Types, MaybeModes0) },
- add_new_pred(Module0, TypeVarSet, ExistQVars, PredName, Types, Cond,
- Purity, ClassContext, Markers, Context, Status, NeedQual,
- PredOrFunc, Module1),
- {
+ MaybePredProcId, !Module, !IO) :-
+ split_types_and_modes(TypesAndModes, Types, MaybeModes0),
+ add_new_pred(TypeVarSet, ExistQVars, PredName, Types, Cond, Purity,
+ ClassContext, Markers, Context, Status, NeedQual, PredOrFunc,
+ !Module, !IO),
+ (
PredOrFunc = predicate,
MaybeModes0 = yes(Modes0),
@@ -3003,53 +2916,49 @@
MaybeModes = yes(ArgModes)
;
MaybeModes = MaybeModes0
- },
-
+ ),
(
- { MaybeModes = yes(Modes) },
- { check_marker(Markers, class_method) ->
+ MaybeModes = yes(Modes),
+ ( check_marker(Markers, class_method) ->
IsClassMethod = yes
;
IsClassMethod = no
- },
- module_add_mode(Module1, InstVarSet, PredName, Modes, MaybeDet,
+ ),
+ module_add_mode(InstVarSet, PredName, Modes, MaybeDet,
Cond, Status, Context, PredOrFunc, IsClassMethod,
- PredProcId, Module),
- { MaybePredProcId = yes(PredProcId) }
+ PredProcId, !Module, !IO),
+ MaybePredProcId = yes(PredProcId)
;
- { MaybeModes = no },
- { Module = Module1 },
- { MaybePredProcId = no }
+ MaybeModes = no,
+ MaybePredProcId = no
).
-:- pred module_add_class_defn(module_info, list(class_constraint), sym_name,
- list(tvar), class_interface, tvarset, prog_context,
- item_status, module_info, io__state, io__state).
-:- mode module_add_class_defn(in, in, in, in, in, in, in, in, out,
- di, uo) is det.
+:- pred module_add_class_defn(list(class_constraint)::in, sym_name::in,
+ list(tvar)::in, class_interface::in, tvarset::in, prog_context::in,
+ item_status::in, module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
-module_add_class_defn(Module0, Constraints, Name, Vars, Interface, VarSet,
- Context, Status, Module) -->
- { module_info_classes(Module0, Classes0) },
- { module_info_superclasses(Module0, SuperClasses0) },
- { list__length(Vars, ClassArity) },
- { ClassId = class_id(Name, ClassArity) },
- { Status = item_status(ImportStatus0, _) },
- { Interface = abstract ->
+module_add_class_defn(Constraints, Name, Vars, Interface, VarSet,
+ Context, Status, !Module, !IO) :-
+ module_info_classes(!.Module, Classes0),
+ module_info_superclasses(!.Module, SuperClasses0),
+ list__length(Vars, ClassArity),
+ ClassId = class_id(Name, ClassArity),
+ Status = item_status(ImportStatus0, _),
+ ( Interface = abstract ->
make_status_abstract(ImportStatus0, ImportStatus1)
;
ImportStatus1 = ImportStatus0
- },
+ ),
(
% the typeclass is exported if *any* occurrence is exported,
% even a previous abstract occurrence
- { map__search(Classes0, ClassId, OldDefn) }
+ map__search(Classes0, ClassId, OldDefn)
->
- { OldDefn = hlds_class_defn(OldStatus, OldConstraints,
- OldVars, OldInterface, OldMethods,
- OldVarSet, OldContext) },
- { combine_status(ImportStatus1, OldStatus, ImportStatus) },
- {
+ OldDefn = hlds_class_defn(OldStatus, OldConstraints, OldVars,
+ OldInterface, OldMethods, OldVarSet, OldContext),
+ combine_status(ImportStatus1, OldStatus, ImportStatus),
+ (
OldInterface = concrete(_),
ClassMethods0 = OldMethods,
ClassInterface = OldInterface
@@ -3057,53 +2966,51 @@
OldInterface = abstract,
ClassMethods0 = [],
ClassInterface = Interface
- },
+ ),
(
- \+ { superclass_constraints_are_identical(OldVars,
+ \+ superclass_constraints_are_identical(OldVars,
OldVarSet, OldConstraints, Vars, VarSet,
- Constraints) }
+ Constraints)
->
% Always report the error, even in `.opt' files.
- { DummyStatus = local },
+ DummyStatus = local,
multiple_def_error(DummyStatus, Name, ClassArity,
- "typeclass", Context, OldContext, _),
- prog_out__write_context(Context),
+ "typeclass", Context, OldContext, _, !IO),
+ prog_out__write_context(Context, !IO),
io__write_string(
- " The superclass constraints do not match.\n"),
- io__set_exit_status(1),
- { ErrorOrPrevDef = yes }
+ " The superclass constraints do not match.\n", !IO),
+ io__set_exit_status(1, !IO),
+ ErrorOrPrevDef = yes
;
- { Interface = concrete(_) },
- { OldInterface = concrete(_) }
+ Interface = concrete(_),
+ OldInterface = concrete(_)
->
multiple_def_error(ImportStatus, Name, ClassArity,
- "typeclass", Context, OldContext, _),
- { ErrorOrPrevDef = yes }
+ "typeclass", Context, OldContext, _, !IO),
+ ErrorOrPrevDef = yes
;
- { ErrorOrPrevDef = no }
+ ErrorOrPrevDef = no
),
- { IsNewDefn = no }
+ IsNewDefn = no
;
- { IsNewDefn = yes `with_type` bool },
- { ErrorOrPrevDef = no `with_type` bool },
- { ClassMethods0 = [] },
- { ClassInterface = Interface },
- { ImportStatus = ImportStatus1 }
+ IsNewDefn = yes `with_type` bool,
+ ErrorOrPrevDef = no `with_type` bool,
+ ClassMethods0 = [],
+ ClassInterface = Interface,
+ ImportStatus = ImportStatus1
),
- ( { ErrorOrPrevDef = no } ->
+ ( ErrorOrPrevDef = no ->
(
- { Interface = concrete(Methods) },
- module_add_class_interface(Module0, Name, Vars,
- Methods, Status, PredProcIds0, Module1),
+ Interface = concrete(Methods),
+ module_add_class_interface(Name, Vars, Methods,
+ Status, PredProcIds0, !Module, !IO),
% Get rid of the `no's from the list of maybes
- { IsYes =
- (pred(Maybe::in, PredProcId::out) is semidet :-
- (
+ IsYes = (pred(Maybe::in, PredProcId::out) is semidet :-
Maybe = yes(Pred - Proc),
PredProcId = hlds_class_proc(Pred, Proc)
- )) },
- { list__filter_map(IsYes, PredProcIds0, PredProcIds1) },
+ ),
+ list__filter_map(IsYes, PredProcIds0, PredProcIds1),
%
% The list must be sorted on pred_id and then
@@ -3111,54 +3018,45 @@
% when it is generating the corresponding list
% of pred_proc_ids for instance definitions.
%
- { list__sort(PredProcIds1, ClassMethods) }
+ list__sort(PredProcIds1, ClassMethods)
;
- { Interface = abstract },
- { ClassMethods = ClassMethods0 },
- { Module1 = Module0 }
+ Interface = abstract,
+ ClassMethods = ClassMethods0
),
- { Defn = hlds_class_defn(ImportStatus, Constraints, Vars,
- ClassInterface, ClassMethods, VarSet, Context) },
- { map__set(Classes0, ClassId, Defn, Classes) },
- { module_info_set_classes(Module1, Classes, Module2) },
+ Defn = hlds_class_defn(ImportStatus, Constraints, Vars,
+ ClassInterface, ClassMethods, VarSet, Context),
+ map__set(Classes0, ClassId, Defn, Classes),
+ module_info_set_classes(Classes, !Module),
- ( { IsNewDefn = yes } ->
+ ( IsNewDefn = yes ->
% insert an entry into the super class table
% for each super class of this class
- { AddSuper =
- (pred(Super::in, Ss0::in, Ss::out) is det :-
- (
- Super = constraint(SuperName,
- SuperTypes),
- list__length(SuperTypes,
- SuperClassArity),
+ AddSuper = (pred(Super::in, Ss0::in, Ss::out) is det :-
+ Super = constraint(SuperName, SuperTypes),
+ list__length(SuperTypes, SuperClassArity),
SuperClassId = class_id(SuperName,
SuperClassArity),
- SubClassDetails =
- subclass_details(SuperTypes,
+ SubClassDetails = subclass_details(SuperTypes,
ClassId, Vars, VarSet),
multi_map__set(Ss0, SuperClassId,
SubClassDetails, Ss)
- )
- ) },
- { list__foldl(AddSuper, Constraints,
- SuperClasses0, SuperClasses) },
+ ),
+ list__foldl(AddSuper, Constraints,
+ SuperClasses0, SuperClasses),
- { module_info_set_superclasses(Module2,
- SuperClasses, Module3) },
+ module_info_set_superclasses(SuperClasses, !Module),
% When we find the class declaration, make an
% entry for the instances.
- { module_info_instances(Module3, Instances0) },
- { map__det_insert(Instances0, ClassId, [], Instances) },
- { module_info_set_instances(Module3,
- Instances, Module) }
+ module_info_instances(!.Module, Instances0),
+ map__det_insert(Instances0, ClassId, [], Instances),
+ module_info_set_instances(Instances, !Module)
;
- { Module = Module2 }
+ true
)
;
- { Module = Module0 }
+ true
).
:- pred superclass_constraints_are_identical(list(tvar), tvarset,
@@ -3179,69 +3077,68 @@
OldConstraints1, OldConstraints),
OldConstraints = Constraints.
-:- pred module_add_class_interface(module_info, sym_name, list(tvar),
- list(class_method), item_status, list(maybe(pair(pred_id, proc_id))),
- module_info, io__state, io__state).
-:- mode module_add_class_interface(in, in, in, in, in, out, out, di, uo) is det.
-
-module_add_class_interface(Module0, Name, Vars, Methods, Status, PredProcIds,
- Module) -->
- module_add_class_interface_2(Module0, Name, Vars, Methods, Status,
- PredProcIds0, Module1),
- check_method_modes(Methods, PredProcIds0,
- PredProcIds, Module1, Module).
-
-:- pred module_add_class_interface_2(module_info, sym_name, list(tvar),
- list(class_method), item_status, list(maybe(pair(pred_id, proc_id))),
- module_info, io__state, io__state).
-:- mode module_add_class_interface_2(in, in, in, in, in, out, out,
- di, uo) is det.
+:- pred module_add_class_interface(sym_name::in, list(tvar)::in,
+ list(class_method)::in, item_status::in,
+ list(maybe(pair(pred_id, proc_id)))::out,
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
-module_add_class_interface_2(Module, _, _, [], _, [], Module) --> [].
-module_add_class_interface_2(Module0, Name, Vars, [M|Ms], Status, [P|Ps],
- Module) -->
- module_add_class_method(M, Name, Vars, Status, P, Module0, Module1),
- module_add_class_interface_2(Module1, Name, Vars, Ms, Status, Ps,
- Module).
+module_add_class_interface(Name, Vars, Methods, Status, PredProcIds,
+ !Module, !IO) :-
+ module_add_class_interface_2(Name, Vars, Methods, Status, PredProcIds0,
+ !Module, !IO),
+ check_method_modes(Methods, PredProcIds0, PredProcIds,
+ !Module, !IO).
+
+:- pred module_add_class_interface_2(sym_name::in, list(tvar)::in,
+ list(class_method)::in, item_status::in,
+ list(maybe(pair(pred_id, proc_id)))::out,
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
-:- pred module_add_class_method(class_method, sym_name, list(tvar),
- item_status, maybe(pair(pred_id, proc_id)), module_info, module_info,
- io__state, io__state).
-:- mode module_add_class_method(in, in, in, in, out, in, out, di, uo) is det.
+module_add_class_interface_2(_, _, [], _, [], !Module, !IO).
+module_add_class_interface_2(Name, Vars, [M | Ms], Status, [P | Ps],
+ !Module, !IO) :-
+ module_add_class_method(M, Name, Vars, Status, P, !Module, !IO),
+ module_add_class_interface_2(Name, Vars, Ms, Status, Ps, !Module, !IO).
+
+:- pred module_add_class_method(class_method::in, sym_name::in, list(tvar)::in,
+ item_status::in, maybe(pair(pred_id, proc_id))::out,
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
module_add_class_method(Method, Name, Vars, Status, MaybePredIdProcId,
- Module0, Module) -->
+ !Module, !IO) :-
(
- { Method = pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
+ Method = pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
PredOrFunc, PredName, TypesAndModes, _WithType,
_WithInst, MaybeDet, Cond, Purity, ClassContext,
- Context) },
- { term__var_list_to_term_list(Vars, VarTerms) },
- { ClassContext = constraints(UnivCnstrs, ExistCnstrs) },
- { NewUnivCnstrs = [constraint(Name, VarTerms) | UnivCnstrs] },
- { NewClassContext = constraints(NewUnivCnstrs, ExistCnstrs) },
- { init_markers(Markers0) },
- { add_marker(Markers0, class_method, Markers) },
- module_add_pred_or_func(Module0, TypeVarSet, InstVarSet,
+ Context),
+ term__var_list_to_term_list(Vars, VarTerms),
+ ClassContext = constraints(UnivCnstrs, ExistCnstrs),
+ NewUnivCnstrs = [constraint(Name, VarTerms) | UnivCnstrs],
+ NewClassContext = constraints(NewUnivCnstrs, ExistCnstrs),
+ init_markers(Markers0),
+ add_marker(class_method, Markers0, Markers),
+ module_add_pred_or_func(TypeVarSet, InstVarSet,
ExistQVars, PredOrFunc, PredName, TypesAndModes,
MaybeDet, Cond, Purity, NewClassContext, Markers,
- Context, Status, MaybePredIdProcId, Module)
+ Context, Status, MaybePredIdProcId, !Module, !IO)
;
- { Method = pred_or_func_mode(VarSet, MaybePredOrFunc, PredName,
- Modes, _WithInst, MaybeDet, Cond, Context) },
- ( { MaybePredOrFunc = yes(PredOrFunc) } ->
- { Status = item_status(ImportStatus, _) },
- { IsClassMethod = yes },
- module_add_mode(Module0, VarSet, PredName, Modes,
- MaybeDet, Cond, ImportStatus, Context,
- PredOrFunc, IsClassMethod, PredIdProcId,
- Module),
- { MaybePredIdProcId = yes(PredIdProcId) }
+ Method = pred_or_func_mode(VarSet, MaybePredOrFunc, PredName,
+ Modes, _WithInst, MaybeDet, Cond, Context),
+ ( MaybePredOrFunc = yes(PredOrFunc) ->
+ Status = item_status(ImportStatus, _),
+ IsClassMethod = yes,
+ module_add_mode(VarSet, PredName, Modes, MaybeDet,
+ Cond, ImportStatus, Context, PredOrFunc,
+ IsClassMethod, PredIdProcId, !Module, !IO),
+ MaybePredIdProcId = yes(PredIdProcId)
;
% equiv_type.m should have either set the
% pred_or_func or removed the item from the list.
- { unexpected(this_file,
- "module_add_class_method: no pred_or_func on mode declaration") }
+ unexpected(this_file, "module_add_class_method: " ++
+ "no pred_or_func on mode declaration")
)
).
@@ -3249,104 +3146,96 @@
% - functions without mode declarations: add a default mode
% - predicates without mode declarations: report an error
% - mode declarations with no determinism: report an error
-:- pred check_method_modes(list(class_method),
- list(maybe(pair(pred_id, proc_id))),
- list(maybe(pair(pred_id, proc_id))), module_info, module_info,
- io__state, io__state).
-:- mode check_method_modes(in, in, out, in, out, di, uo) is det.
+:- pred check_method_modes(list(class_method)::in,
+ list(maybe(pair(pred_id, proc_id)))::in,
+ list(maybe(pair(pred_id, proc_id)))::out,
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
-check_method_modes([], PredProcIds, PredProcIds, Module, Module) --> [].
-check_method_modes([M|Ms], PredProcIds0, PredProcIds, Module0, Module) -->
+check_method_modes([], !PredProcIds, !Module, !IO).
+check_method_modes([Method | Methods], !PredProcIds, !Module, !IO) :-
(
- { M = pred_or_func(_, _, _, PorF, QualName, TypesAndModes,
- _WithType, _WithInst, _, _, _, _, _) }
+ Method = pred_or_func(_, _, _, PorF, QualName, TypesAndModes,
+ _WithType, _WithInst, _, _, _, _, _)
->
- { QualName = qualified(ModuleName0, Name0) ->
+ ( QualName = qualified(ModuleName0, Name0) ->
ModuleName = ModuleName0,
Name = Name0
;
% The class interface should be fully module qualified
% by prog_io.m at the time it is read in.
- error(
- "add_default_class_method_func_modes: unqualified func")
- },
-
- { list__length(TypesAndModes, PredArity) },
- { module_info_get_predicate_table(Module0, PredTable) },
+ error("add_default_class_method_func_modes: " ++
+ "unqualified func")
+ ),
+ list__length(TypesAndModes, PredArity),
+ module_info_get_predicate_table(!.Module, PredTable),
(
- { predicate_table_search_pf_m_n_a(PredTable,
+ predicate_table_search_pf_m_n_a(PredTable,
is_fully_qualified, PorF, ModuleName,
- Name, PredArity, [PredId]) }
+ Name, PredArity, [PredId])
->
- { module_info_pred_info(Module0, PredId, PredInfo0) },
+ module_info_pred_info(!.Module, PredId, PredInfo0),
(
- { PorF = function },
- { maybe_add_default_func_mode(PredInfo0,
- PredInfo, MaybeProc) },
- {
- MaybeProc = no,
- PredProcIds1 = PredProcIds0,
- Module1 = Module0
+ PorF = function,
+ maybe_add_default_func_mode(PredInfo0,
+ PredInfo, MaybeProc),
+ (
+ MaybeProc = no
;
MaybeProc = yes(ProcId),
NewPredProc = yes(PredId - ProcId),
- PredProcIds1 = [NewPredProc |
- PredProcIds0],
- module_info_set_pred_info(Module0,
- PredId, PredInfo, Module1)
- }
+ !:PredProcIds = [NewPredProc |
+ !.PredProcIds],
+ module_info_set_pred_info(PredId,
+ PredInfo, !Module)
+ )
;
- { PorF = predicate },
- { pred_info_procedures(PredInfo0, Procs) },
- ( { map__is_empty(Procs) } ->
+ PorF = predicate,
+ pred_info_procedures(PredInfo0, Procs),
+ ( map__is_empty(Procs) ->
pred_method_with_no_modes_error(
- PredInfo0)
+ PredInfo0, !IO)
;
- []
- ),
- { Module1 = Module0 },
- { PredProcIds1 = PredProcIds0 }
+ true
+ )
)
;
- { error("handle_methods_with_no_modes") }
+ error("handle_methods_with_no_modes")
)
;
- { PredProcIds1 = PredProcIds0 },
- { Module1 = Module0 }
+ true
),
- check_method_modes(Ms, PredProcIds1, PredProcIds, Module1, Module).
+ check_method_modes(Methods, !PredProcIds, !Module, !IO).
-:- pred module_add_instance_defn(module_info, module_name,
- list(class_constraint), sym_name, list(type), instance_body,
- tvarset, import_status, prog_context, module_info,
- io__state, io__state).
-:- mode module_add_instance_defn(in, in, in, in, in, in, in, in, in, out,
- di, uo) is det.
+:- pred module_add_instance_defn(module_name::in, list(class_constraint)::in,
+ sym_name::in, list(type)::in, instance_body::in, tvarset::in,
+ import_status::in, prog_context::in,
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
-module_add_instance_defn(Module0, InstanceModuleName, Constraints, ClassName,
- Types, Body0, VarSet, Status, Context, Module) -->
- { module_info_classes(Module0, Classes) },
- { module_info_instances(Module0, Instances0) },
- { list__length(Types, ClassArity) },
- { ClassId = class_id(ClassName, ClassArity) },
- { Body = expand_bang_state_var_args_in_instance_method_heads(Body0) },
+module_add_instance_defn(InstanceModuleName, Constraints, ClassName,
+ Types, Body0, VarSet, Status, Context, !Module, !IO) :-
+ module_info_classes(!.Module, Classes),
+ module_info_instances(!.Module, Instances0),
+ list__length(Types, ClassArity),
+ ClassId = class_id(ClassName, ClassArity),
+ Body = expand_bang_state_var_args_in_instance_method_heads(Body0),
(
- { map__search(Classes, ClassId, _) }
+ map__search(Classes, ClassId, _)
->
- { map__init(Empty) },
- { NewInstanceDefn = hlds_instance_defn(InstanceModuleName,
+ map__init(Empty),
+ NewInstanceDefn = hlds_instance_defn(InstanceModuleName,
Status, Context, Constraints, Types, Body, no,
- VarSet, Empty) },
- { map__lookup(Instances0, ClassId, InstanceDefns) },
+ VarSet, Empty),
+ map__lookup(Instances0, ClassId, InstanceDefns),
check_for_overlapping_instances(NewInstanceDefn, InstanceDefns,
- ClassId),
- { map__det_update(Instances0, ClassId,
- [NewInstanceDefn | InstanceDefns], Instances) },
- { module_info_set_instances(Module0, Instances, Module) }
+ ClassId, !IO),
+ map__det_update(Instances0, ClassId,
+ [NewInstanceDefn | InstanceDefns], Instances),
+ module_info_set_instances(Instances, !Module)
;
undefined_type_class_error(ClassName, ClassArity, Context,
- "instance declaration"),
- { Module = Module0 }
+ "instance declaration", !IO)
).
:- pred check_for_overlapping_instances(hlds_instance_defn,
@@ -3390,98 +3279,91 @@
%-----------------------------------------------------------------------------%
-:- pred add_new_pred(module_info, tvarset, existq_tvars, sym_name, list(type),
- condition, purity, class_constraints, pred_markers,
- prog_context, import_status, need_qualifier,
- pred_or_func, module_info, io__state, io__state).
-:- mode add_new_pred(in, in, in, in, in, in, in, in, in, in, in, in, in, out,
- di, uo) is det.
+:- pred add_new_pred(tvarset::in, existq_tvars::in, sym_name::in,
+ list(type)::in, condition::in, purity::in, class_constraints::in,
+ pred_markers::in, prog_context::in, import_status::in,
+ need_qualifier::in, pred_or_func::in,
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
% NB. Predicates are also added in lambda.m, which converts
% lambda expressions into separate predicates, so any changes may need
% to be reflected there too.
-add_new_pred(Module0, TVarSet, ExistQVars, PredName, Types, Cond, Purity,
+add_new_pred(TVarSet, ExistQVars, PredName, Types, Cond, Purity,
ClassContext, Markers0, Context, ItemStatus, NeedQual,
- PredOrFunc, Module) -->
+ PredOrFunc, !Module, !IO) :-
% Only preds with opt_imported clauses are tagged as opt_imported, so
% that the compiler doesn't look for clauses for other preds read in
% from optimization interfaces.
- { ItemStatus = opt_imported ->
+ ( ItemStatus = opt_imported ->
Status = imported(interface)
;
Status = ItemStatus
- },
+ ),
check_tvars_in_constraints(ClassContext, Types, TVarSet,
- PredOrFunc, PredName, Context, Module0, Module1),
+ PredOrFunc, PredName, Context, !Module, !IO),
- { module_info_name(Module1, ModuleName) },
- { list__length(Types, Arity) },
+ module_info_name(!.Module, ModuleName),
+ list__length(Types, Arity),
(
- { PredName = unqualified(_PName) },
- { module_info_incr_errors(Module1, Module) },
- unqualified_pred_error(PredName, Arity, Context)
+ PredName = unqualified(_PName),
+ module_info_incr_errors(!Module),
+ unqualified_pred_error(PredName, Arity, Context, !IO)
% All predicate names passed into this predicate should have
% been qualified by prog_io.m, when they were first read.
;
- { PredName = qualified(MNameOfPred, PName) },
- { module_info_get_predicate_table(Module1, PredicateTable0) },
- { clauses_info_init(Arity, ClausesInfo) },
- { map__init(Proofs) },
- { purity_to_markers(Purity, PurityMarkers) },
- { markers_to_marker_list(PurityMarkers, MarkersList) },
- { AddMarker = lambda(
- [M::in, TheMarkers0::in, TheMarkers::out] is det,
- (
- 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,
- ExistQVars, Types,
- Cond, Context, ClausesInfo, Status, Markers,
- none, PredOrFunc, ClassContext, Proofs,
- Owner, PredInfo0) },
+ PredName = qualified(MNameOfPred, PName),
+ module_info_get_predicate_table(!.Module, PredicateTable0),
+ clauses_info_init(Arity, ClausesInfo),
+ map__init(Proofs),
+ purity_to_markers(Purity, PurityMarkers),
+ markers_to_marker_list(PurityMarkers, MarkersList),
+ list__foldl(add_marker, MarkersList, Markers0, Markers),
+ globals__io_lookup_string_option(aditi_user, Owner, !IO),
+ pred_info_init(ModuleName, PredName, Arity, TVarSet,
+ ExistQVars, Types, Cond, Context, ClausesInfo, Status,
+ Markers, none, PredOrFunc, ClassContext, Proofs,
+ Owner, PredInfo0),
(
- { predicate_table_search_pf_m_n_a(PredicateTable0,
+ predicate_table_search_pf_m_n_a(PredicateTable0,
is_fully_qualified, PredOrFunc, MNameOfPred,
- PName, Arity, [OrigPred|_]) }
+ PName, Arity, [OrigPred|_])
->
- { module_info_pred_info(Module1, OrigPred,
- OrigPredInfo) },
- { pred_info_context(OrigPredInfo, OrigContext) },
- { hlds_out__pred_or_func_to_str(PredOrFunc,
- DeclString) },
- { adjust_func_arity(PredOrFunc, OrigArity, Arity) },
+ module_info_pred_info(!.Module, OrigPred,
+ OrigPredInfo),
+ pred_info_context(OrigPredInfo, OrigContext),
+ hlds_out__pred_or_func_to_str(PredOrFunc,
+ DeclString),
+ adjust_func_arity(PredOrFunc, OrigArity, Arity),
multiple_def_error(ItemStatus, PredName, OrigArity,
- DeclString, Context, OrigContext, FoundError),
- { FoundError = yes ->
- module_info_incr_errors(Module1, Module)
- ;
- Module = Module1
- }
- ;
- { module_info_get_partial_qualifier_info(Module1,
- PQInfo) },
- { predicate_table_insert(PredicateTable0, PredInfo0,
- NeedQual, PQInfo, PredId, PredicateTable1) },
- (
- { pred_info_is_builtin(PredInfo0) }
- ->
- { add_builtin(PredId, Types,
- PredInfo0, PredInfo) },
- { predicate_table_get_preds(PredicateTable1,
- Preds1) },
- { map__det_update(Preds1, PredId, PredInfo,
- Preds) },
- { predicate_table_set_preds(PredicateTable1,
- Preds, PredicateTable) }
+ DeclString, Context, OrigContext, FoundError,
+ !IO),
+ ( FoundError = yes ->
+ module_info_incr_errors(!Module)
+ ;
+ true
+ )
+ ;
+ module_info_get_partial_qualifier_info(!.Module,
+ PQInfo),
+ predicate_table_insert(PredicateTable0, PredInfo0,
+ NeedQual, PQInfo, PredId, PredicateTable1),
+ ( pred_info_is_builtin(PredInfo0) ->
+ add_builtin(PredId, Types,
+ PredInfo0, PredInfo),
+ predicate_table_get_preds(PredicateTable1,
+ Preds1),
+ map__det_update(Preds1, PredId, PredInfo,
+ Preds),
+ predicate_table_set_preds(PredicateTable1,
+ Preds, PredicateTable)
;
- { PredicateTable = PredicateTable1 }
+ PredicateTable = PredicateTable1
),
- { module_info_set_predicate_table(Module1,
- PredicateTable, Module) }
+ module_info_set_predicate_table(PredicateTable,
+ !Module)
)
).
@@ -3711,14 +3593,14 @@
% inline code for calls to these predicates.
%
pred_info_get_markers(!.PredInfo, Markers0),
- add_marker(Markers0, no_inline, Markers),
+ add_marker(no_inline, Markers0, Markers),
pred_info_set_markers(Markers, !PredInfo).
%-----------------------------------------------------------------------------%
-:- pred add_special_preds(module_info, tvarset, type, type_ctor,
- hlds_type_body, prog_context, import_status, module_info).
-:- mode add_special_preds(in, in, in, in, in, in, in, out) is det.
+:- pred add_special_preds(tvarset::in, (type)::in, type_ctor::in,
+ hlds_type_body::in, prog_context::in, import_status::in,
+ module_info::in, module_info::out) is det.
% The only place that the index predicate for a type can ever
% be called from is the compare predicate for that type.
@@ -3755,19 +3637,18 @@
% predicates to be defined only for the kinds of types which do not
% lead unify_proc__generate_index_clauses to abort.
-add_special_preds(Module0, TVarSet, Type, TypeCtor, Body, Context, Status,
- Module) :-
+add_special_preds(TVarSet, Type, TypeCtor, Body, Context, Status, !Module) :-
(
- special_pred_is_generated_lazily(Module0,
- TypeCtor, Body, Status)
+ special_pred_is_generated_lazily(!.Module, TypeCtor, Body,
+ Status)
->
- Module = Module0
+ true
;
- can_generate_special_pred_clauses_for_type(Module0, TypeCtor,
+ can_generate_special_pred_clauses_for_type(!.Module, TypeCtor,
Body)
->
- add_special_pred(unify, Module0, TVarSet, Type, TypeCtor,
- Body, Context, Status, Module1),
+ add_special_pred(unify, TVarSet, Type, TypeCtor, Body, Context,
+ Status, !Module),
(
status_defined_in_this_module(Status, yes)
->
@@ -3775,7 +3656,7 @@
Ctors = Body ^ du_type_ctors,
Body ^ du_type_is_enum = no,
Body ^ du_type_usereq = no,
- module_info_globals(Module0, Globals),
+ module_info_globals(!.Module, Globals),
globals__lookup_int_option(Globals,
compare_specialization, CompareSpec),
list__length(Ctors, CtorCount),
@@ -3785,66 +3666,61 @@
;
SpecialPredIds = [compare]
),
- add_special_pred_list(SpecialPredIds,
- Module1, TVarSet, Type, TypeCtor,
- Body, Context, Status, Module)
+ add_special_pred_list(SpecialPredIds, TVarSet, Type,
+ TypeCtor, Body, Context, Status, !Module)
;
% Never add clauses for comparison predicates
% for imported types -- they will never be used.
- module_info_get_special_pred_map(Module1,
+ module_info_get_special_pred_map(!.Module,
SpecialPreds),
( map__contains(SpecialPreds, compare - TypeCtor) ->
- Module = Module1
+ true
;
- add_special_pred_decl(compare, Module1,
- TVarSet, Type, TypeCtor, Body,
- Context, Status, Module)
+ add_special_pred_decl(compare, TVarSet, Type,
+ TypeCtor, Body, Context, Status,
+ !Module)
)
)
;
SpecialPredIds = [unify, compare],
- add_special_pred_decl_list(SpecialPredIds, Module0, TVarSet,
- Type, TypeCtor, Body, Context, Status, Module)
+ add_special_pred_decl_list(SpecialPredIds, TVarSet, Type,
+ TypeCtor, Body, Context, Status, !Module)
).
-:- pred add_special_pred_list(list(special_pred_id),
- module_info, tvarset, type, type_ctor, hlds_type_body,
- prog_context, import_status, module_info).
-:- mode add_special_pred_list(in, in, in, in, in, in, in, in, out) is det.
-
-add_special_pred_list([], Module, _, _, _, _, _, _, Module).
-add_special_pred_list([SpecialPredId | SpecialPredIds], Module0,
- TVarSet, Type, TypeCtor, Body, Context, Status, Module) :-
- add_special_pred(SpecialPredId, Module0,
- TVarSet, Type, TypeCtor, Body, Context, Status, Module1),
- add_special_pred_list(SpecialPredIds, Module1,
- TVarSet, Type, TypeCtor, Body, Context, Status, Module).
-
-:- pred add_special_pred(special_pred_id,
- module_info, tvarset, type, type_ctor, hlds_type_body,
- prog_context, import_status, module_info).
-:- mode add_special_pred(in, in, in, in, in, in, in, in, out) is det.
-
-add_special_pred(SpecialPredId, Module0, TVarSet, Type, TypeCtor, TypeBody,
- Context, Status0, Module) :-
- module_info_globals(Module0, Globals),
+:- pred add_special_pred_list(list(special_pred_id)::in, tvarset::in,
+ (type)::in, type_ctor::in, hlds_type_body::in, prog_context::in,
+ import_status::in, module_info::in, module_info::out) is det.
+
+add_special_pred_list([], _, _, _, _, _, _, !Module).
+add_special_pred_list([SpecialPredId | SpecialPredIds], TVarSet, Type,
+ TypeCtor, Body, Context, Status, !Module) :-
+ add_special_pred(SpecialPredId, TVarSet, Type,
+ TypeCtor, Body, Context, Status, !Module),
+ add_special_pred_list(SpecialPredIds, TVarSet, Type,
+ TypeCtor, Body, Context, Status, !Module).
+
+:- pred add_special_pred(special_pred_id::in, tvarset::in, (type)::in,
+ type_ctor::in, hlds_type_body::in, prog_context::in, import_status::in,
+ module_info::in, module_info::out) is det.
+
+add_special_pred(SpecialPredId, TVarSet, Type, TypeCtor, TypeBody, Context,
+ Status0, !Module) :-
+ module_info_globals(!.Module, Globals),
globals__lookup_bool_option(Globals, special_preds, GenSpecialPreds),
(
GenSpecialPreds = yes,
- add_special_pred_for_real(SpecialPredId, Module0, TVarSet,
- Type, TypeCtor, TypeBody, Context, Status0, Module)
+ add_special_pred_for_real(SpecialPredId, TVarSet, Type,
+ TypeCtor, TypeBody, Context, Status0, !Module)
;
GenSpecialPreds = no,
(
SpecialPredId = unify,
add_special_pred_unify_status(TypeBody, Status0,
Status),
- add_special_pred_for_real(SpecialPredId, Module0,
- TVarSet, Type, TypeCtor, TypeBody, Context,
- Status, Module)
+ add_special_pred_for_real(SpecialPredId, TVarSet, Type,
+ TypeCtor, TypeBody, Context, Status, !Module)
;
- SpecialPredId = index,
- Module = Module0
+ SpecialPredId = index
;
SpecialPredId = compare,
( TypeBody ^ du_type_usereq = yes(_) ->
@@ -3859,27 +3735,27 @@
% a good error message in Mercury code
% than in C code.
add_special_pred_for_real(SpecialPredId,
- Module0, TVarSet, Type, TypeCtor,
- TypeBody, Context, Status0, Module)
+ TVarSet, Type, TypeCtor, TypeBody,
+ Context, Status0, !Module)
;
- Module = Module0
+ true
)
)
).
-add_special_pred_for_real(SpecialPredId, Module0, TVarSet, Type, TypeCtor,
- TypeBody, Context, Status0, Module) :-
+add_special_pred_for_real(SpecialPredId, TVarSet, Type, TypeCtor,
+ TypeBody, Context, Status0, !Module) :-
adjust_special_pred_status(Status0, SpecialPredId, Status),
- module_info_get_special_pred_map(Module0, SpecialPredMap0),
+ module_info_get_special_pred_map(!.Module, SpecialPredMap0),
( map__contains(SpecialPredMap0, SpecialPredId - TypeCtor) ->
- Module1 = Module0
+ true
;
- add_special_pred_decl_for_real(SpecialPredId, Module0,
- TVarSet, Type, TypeCtor, Context, Status, Module1)
+ add_special_pred_decl_for_real(SpecialPredId, TVarSet,
+ Type, TypeCtor, Context, Status, !Module)
),
- module_info_get_special_pred_map(Module1, SpecialPredMap1),
+ module_info_get_special_pred_map(!.Module, SpecialPredMap1),
map__lookup(SpecialPredMap1, SpecialPredId - TypeCtor, PredId),
- module_info_preds(Module1, Preds0),
+ module_info_preds(!.Module, Preds0),
map__lookup(Preds0, PredId, PredInfo0),
% if the type was imported, then the special preds for that
% type should be imported too
@@ -3907,51 +3783,50 @@
PredInfo1 = PredInfo0
),
unify_proc__generate_clause_info(SpecialPredId, Type, TypeBody,
- Context, Module1, ClausesInfo),
+ Context, !.Module, ClausesInfo),
pred_info_set_clauses_info(ClausesInfo, PredInfo1, PredInfo2),
pred_info_get_markers(PredInfo2, Markers2),
- add_marker(Markers2, calls_are_fully_qualified, Markers),
+ add_marker(calls_are_fully_qualified, Markers2, Markers),
pred_info_set_markers(Markers, PredInfo2, PredInfo3),
pred_info_set_maybe_special_pred(yes(SpecialPredId - TypeCtor),
PredInfo3, PredInfo),
map__det_update(Preds0, PredId, PredInfo, Preds),
- module_info_set_preds(Module1, Preds, Module).
+ module_info_set_preds(Preds, !Module).
+
+:- pred add_special_pred_decl_list(list(special_pred_id)::in, tvarset::in,
+ (type)::in, type_ctor::in, hlds_type_body::in, prog_context::in,
+ import_status::in, module_info::in, module_info::out) is det.
+
+add_special_pred_decl_list([], _, _, _, _, _, _, !Module).
+add_special_pred_decl_list([SpecialPredId | SpecialPredIds], TVarSet, Type,
+ TypeCtor, TypeBody, Context, Status, !Module) :-
+ add_special_pred_decl(SpecialPredId, TVarSet, Type,
+ TypeCtor, TypeBody, Context, Status, !Module),
+ add_special_pred_decl_list(SpecialPredIds, TVarSet, Type,
+ TypeCtor, TypeBody, Context, Status, !Module).
+
+:- pred add_special_pred_decl(special_pred_id::in, tvarset::in, (type)::in,
+ type_ctor::in, hlds_type_body::in, prog_context::in, import_status::in,
+ module_info::in, module_info::out) is det.
-:- pred add_special_pred_decl_list(list(special_pred_id), module_info,
- tvarset, type, type_ctor, hlds_type_body, prog_context,
- import_status, module_info).
-:- mode add_special_pred_decl_list(in, in, in, in, in, in, in, in, out) is det.
-
-add_special_pred_decl_list([], Module, _, _, _, _, _, _, Module).
-add_special_pred_decl_list([SpecialPredId | SpecialPredIds], Module0,
- TVarSet, Type, TypeCtor, TypeBody, Context, Status, Module) :-
- add_special_pred_decl(SpecialPredId, Module0,
- TVarSet, Type, TypeCtor, TypeBody, Context, Status, Module1),
- add_special_pred_decl_list(SpecialPredIds, Module1,
- TVarSet, Type, TypeCtor, TypeBody, Context, Status, Module).
-
-:- pred add_special_pred_decl(special_pred_id, module_info, tvarset, type,
- type_ctor, hlds_type_body, prog_context, import_status, module_info).
-:- mode add_special_pred_decl(in, in, in, in, in, in, in, in, out) is det.
-
-add_special_pred_decl(SpecialPredId, Module0, TVarSet, Type, TypeCtor,
- TypeBody, Context, Status0, Module) :-
- module_info_globals(Module0, Globals),
+add_special_pred_decl(SpecialPredId, TVarSet, Type, TypeCtor, TypeBody,
+ Context, Status0, !Module) :-
+ module_info_globals(!.Module, Globals),
globals__lookup_bool_option(Globals, special_preds, GenSpecialPreds),
( GenSpecialPreds = yes ->
- add_special_pred_decl_for_real(SpecialPredId, Module0,
- TVarSet, Type, TypeCtor, Context, Status0, Module)
+ add_special_pred_decl_for_real(SpecialPredId,
+ TVarSet, Type, TypeCtor, Context, Status0, !Module)
; SpecialPredId = unify ->
add_special_pred_unify_status(TypeBody, Status0, Status),
- add_special_pred_decl_for_real(SpecialPredId, Module0,
- TVarSet, Type, TypeCtor, Context, Status, Module)
+ add_special_pred_decl_for_real(SpecialPredId, TVarSet, Type,
+ TypeCtor, Context, Status, !Module)
;
- Module = Module0
+ true
).
-add_special_pred_decl_for_real(SpecialPredId, Module0, TVarSet, Type, TypeCtor,
- Context, Status0, Module) :-
- module_info_name(Module0, ModuleName),
+add_special_pred_decl_for_real(SpecialPredId, TVarSet, Type, TypeCtor,
+ Context, Status0, !Module) :-
+ module_info_name(!.Module, ModuleName),
special_pred_interface(SpecialPredId, Type, ArgTypes, ArgModes, Det),
Name = special_pred_name(SpecialPredId, TypeCtor),
PredName = unqualified(Name),
@@ -3965,7 +3840,7 @@
% XXX this context might not be empty
ClassContext = constraints([], []),
ExistQVars = [],
- module_info_globals(Module0, Globals),
+ module_info_globals(!.Module, Globals),
globals__lookup_string_option(Globals, aditi_user, Owner),
pred_info_init(ModuleName, PredName, Arity, TVarSet, ExistQVars,
ArgTypes, Cond, Context, ClausesInfo0, Status, Markers,
@@ -3980,15 +3855,14 @@
ArgLives, yes(Det), Context, address_is_not_taken, PredInfo,
_),
- module_info_get_predicate_table(Module0, PredicateTable0),
+ module_info_get_predicate_table(!.Module, PredicateTable0),
predicate_table_insert(PredicateTable0, PredInfo,
PredId, PredicateTable),
- module_info_set_predicate_table(Module0, PredicateTable,
- Module1),
- module_info_get_special_pred_map(Module1, SpecialPredMap0),
+ module_info_set_predicate_table(PredicateTable, !Module),
+ module_info_get_special_pred_map(!.Module, SpecialPredMap0),
map__set(SpecialPredMap0, SpecialPredId - TypeCtor, PredId,
SpecialPredMap),
- module_info_set_special_pred_map(Module1, SpecialPredMap, Module).
+ module_info_set_special_pred_map(SpecialPredMap, !Module).
:- pred add_special_pred_unify_status(hlds_type_body::in, import_status::in,
import_status::out) is det.
@@ -4052,19 +3926,17 @@
% Add a mode declaration for a predicate.
-:- pred module_add_mode(module_info, inst_varset, sym_name, list(mode),
- maybe(determinism), condition, import_status, prog_context,
- pred_or_func, bool, pair(pred_id, proc_id), module_info,
- io__state, io__state).
-:- mode module_add_mode(in, in, in, in, in, in, in, in, in, in, out, out,
- di, uo) is det.
+:- pred module_add_mode(inst_varset::in, sym_name::in, list(mode)::in,
+ maybe(determinism)::in, condition::in, import_status::in,
+ prog_context::in, pred_or_func::in, bool::in,
+ pair(pred_id, proc_id)::out, module_info::in, module_info::out,
+ io__state::di, io__state::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, InstVarSet, PredName, Modes, MaybeDet, _Cond,
- Status, MContext, PredOrFunc, IsClassMethod, PredProcId,
- ModuleInfo) -->
+module_add_mode(InstVarSet, PredName, Modes, MaybeDet, _Cond, Status, MContext,
+ PredOrFunc, IsClassMethod, PredProcId, !ModuleInfo, !IO) :-
% Lookup the pred or func declaration in the predicate table.
% If it's not there (or if it is ambiguous), optionally print a
@@ -4072,42 +3944,37 @@
% predicate; it is presumed to be local, and its type
% will be inferred automatically.
- { module_info_name(ModuleInfo0, ModuleName0) },
- { sym_name_get_module_name(PredName, ModuleName0, ModuleName) },
- { list__length(Modes, Arity) },
- { module_info_get_predicate_table(ModuleInfo0, PredicateTable0) },
+ module_info_name(!.ModuleInfo, ModuleName0),
+ sym_name_get_module_name(PredName, ModuleName0, ModuleName),
+ list__length(Modes, Arity),
+ module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
(
- { predicate_table_search_pf_sym_arity(PredicateTable0,
+ predicate_table_search_pf_sym_arity(PredicateTable0,
is_fully_qualified, PredOrFunc, PredName, Arity,
- [PredId0]) }
+ [PredId0])
->
- { ModuleInfo1 = ModuleInfo0 },
- { PredId = PredId0 }
+ PredId = PredId0
;
- preds_add_implicit_report_error(ModuleName,
- PredOrFunc, PredName, Arity, Status, IsClassMethod,
- MContext, "mode declaration", PredId,
- ModuleInfo0, ModuleInfo1)
+ preds_add_implicit_report_error(ModuleName, PredOrFunc,
+ PredName, Arity, Status, IsClassMethod, MContext,
+ "mode declaration", PredId, !ModuleInfo, !IO)
),
% Lookup the pred_info for this predicate
- { module_info_get_predicate_table(ModuleInfo1, PredicateTable1) },
- { predicate_table_get_preds(PredicateTable1, Preds0) },
- { map__lookup(Preds0, PredId, PredInfo0) },
+ module_info_get_predicate_table(!.ModuleInfo, PredicateTable1),
+ predicate_table_get_preds(PredicateTable1, Preds0),
+ map__lookup(Preds0, PredId, PredInfo0),
module_do_add_mode(PredInfo0, InstVarSet, Arity, Modes, MaybeDet,
- IsClassMethod, MContext, PredInfo, ProcId),
- { map__det_update(Preds0, PredId, PredInfo, Preds) },
- { predicate_table_set_preds(PredicateTable1, Preds, PredicateTable) },
- { module_info_set_predicate_table(ModuleInfo0, PredicateTable,
- ModuleInfo) },
- { PredProcId = PredId - ProcId }.
-
-:- pred module_do_add_mode(pred_info, inst_varset, arity, list(mode),
- maybe(determinism), bool, prog_context, pred_info, proc_id,
- io__state, io__state).
-:- mode module_do_add_mode(in, in, in, in, in, in, in, out, out, di, uo)
- is det.
+ IsClassMethod, MContext, PredInfo, ProcId, !IO),
+ map__det_update(Preds0, PredId, PredInfo, Preds),
+ predicate_table_set_preds(PredicateTable1, Preds, PredicateTable),
+ module_info_set_predicate_table(PredicateTable, !ModuleInfo),
+ PredProcId = PredId - ProcId.
+
+:- pred module_do_add_mode(pred_info::in, inst_varset::in, arity::in,
+ list(mode)::in, maybe(determinism)::in, bool::in, prog_context::in,
+ pred_info::out, proc_id::out, io__state::di, io__state::uo) is det.
module_do_add_mode(PredInfo0, InstVarSet, Arity, Modes, MaybeDet,
IsClassMethod, MContext, PredInfo, ProcId) -->
@@ -4153,32 +4020,27 @@
% for that predicate; the real types will be inferred by
% type inference.
-:- pred preds_add_implicit_report_error(module_name, pred_or_func, sym_name,
- arity, import_status, bool, prog_context, string,
- pred_id, module_info, module_info, io__state, io__state).
-:- mode preds_add_implicit_report_error(in, in, in, in, in, in, in, in,
- out, in, out, di, uo) is det.
+:- pred preds_add_implicit_report_error(module_name::in, pred_or_func::in,
+ sym_name::in, arity::in, import_status::in, bool::in, prog_context::in,
+ string::in, pred_id::out, module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
preds_add_implicit_report_error(ModuleName, PredOrFunc, PredName, Arity,
Status, IsClassMethod, Context, Description, PredId,
- ModuleInfo0, ModuleInfo) -->
+ !ModuleInfo, !IO) :-
maybe_undefined_pred_error(PredName, Arity, PredOrFunc, Status,
- IsClassMethod, Context, Description),
-
- ( { PredOrFunc = function } ->
- { adjust_func_arity(function, FuncArity, Arity) },
+ IsClassMethod, Context, Description, !IO),
+ ( PredOrFunc = function ->
+ adjust_func_arity(function, FuncArity, Arity),
maybe_check_field_access_function(PredName, FuncArity,
- Status, Context, ModuleInfo0)
+ Status, Context, !.ModuleInfo, !IO)
;
- []
+ true
),
-
- { module_info_get_predicate_table(ModuleInfo0, PredicateTable0) },
- { preds_add_implicit(ModuleInfo0, PredicateTable0, ModuleName,
- PredName, Arity, Status, Context, PredOrFunc,
- PredId, PredicateTable) },
- { module_info_set_predicate_table(ModuleInfo0,
- PredicateTable, ModuleInfo) }.
+ module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
+ preds_add_implicit(!.ModuleInfo, PredicateTable0, ModuleName, PredName,
+ Arity, Status, Context, PredOrFunc, PredId, PredicateTable),
+ module_info_set_predicate_table(PredicateTable, !ModuleInfo).
:- pred preds_add_implicit(module_info, predicate_table, module_name,
sym_name, arity, import_status, prog_context,
@@ -4234,7 +4096,7 @@
pred_info_init(ModuleName, PredName, Arity, TVarSet, ExistQVars,
Types, Cond, Context, ClausesInfo, Status, Markers0, none,
PredOrFunc, ClassContext, Proofs, Owner, PredInfo0),
- add_marker(Markers0, infer_type, Markers),
+ add_marker(infer_type, Markers0, Markers),
pred_info_set_markers(Markers, PredInfo0, PredInfo),
(
\+ predicate_table_search_pf_sym_arity(PredicateTable0,
@@ -4260,142 +4122,130 @@
%-----------------------------------------------------------------------------%
-:- pred module_add_clause(module_info, prog_varset, pred_or_func, sym_name,
- list(prog_term), goal, import_status, prog_context, goal_type,
- module_info, qual_info, qual_info, io__state, io__state).
-:- mode module_add_clause(in, in, in, in, in, in, in, in, in,
- out, in, out, di, uo) is det.
-
-module_add_clause(ModuleInfo0, ClauseVarSet, PredOrFunc, PredName, Args0, Body,
- Status, Context, GoalType, ModuleInfo,
- Info0, Info) -->
-
- { IllegalSVarResult =
- ( if illegal_state_var_func_result(PredOrFunc, Args0, SVar)
- then yes(SVar)
- else no
- ) },
- { ArityAdjustment = ( if IllegalSVarResult = yes(_) then -1 else 0 ) },
-
- { Args = expand_bang_state_var_args(Args0) },
-
- globals__io_lookup_bool_option(very_verbose, VeryVerbose),
- ( { VeryVerbose = yes } ->
- io__write_string("% Processing clause for "),
- hlds_out__write_pred_or_func(PredOrFunc),
- io__write_string(" `"),
- { list__length(Args, PredArity0) },
- { PredArity = PredArity0 + ArityAdjustment },
- { adjust_func_arity(PredOrFunc, OrigArity, PredArity) },
- prog_out__write_sym_name_and_arity(PredName/OrigArity),
- io__write_string("'...\n")
+:- pred module_add_clause(prog_varset::in, pred_or_func::in, sym_name::in,
+ list(prog_term)::in, goal::in, import_status::in, prog_context::in,
+ goal_type::in, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, io__state::di, io__state::uo) is det.
+
+module_add_clause(ClauseVarSet, PredOrFunc, PredName, Args0, Body, Status,
+ Context, GoalType, !ModuleInfo, !Info, !IO) :-
+ ( illegal_state_var_func_result(PredOrFunc, Args0, SVar) ->
+ IllegalSVarResult = yes(SVar)
+ ;
+ IllegalSVarResult = no
+ ),
+ ArityAdjustment = ( if IllegalSVarResult = yes(_) then -1 else 0 ),
+ Args = expand_bang_state_var_args(Args0),
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ ( VeryVerbose = yes ->
+ io__write_string("% Processing clause for ", !IO),
+ hlds_out__write_pred_or_func(PredOrFunc, !IO),
+ io__write_string(" `", !IO),
+ list__length(Args, PredArity0),
+ PredArity = PredArity0 + ArityAdjustment,
+ adjust_func_arity(PredOrFunc, OrigArity, PredArity),
+ prog_out__write_sym_name_and_arity(PredName/OrigArity, !IO),
+ io__write_string("'...\n", !IO)
;
- []
+ true
),
% Lookup the pred declaration in the predicate table.
% (If it's not there, call maybe_undefined_pred_error
% and insert an implicit declaration for the predicate.)
- { module_info_name(ModuleInfo0, ModuleName) },
- { list__length(Args, Arity0) },
- { Arity = Arity0 + ArityAdjustment },
- { module_info_get_predicate_table(ModuleInfo0, PredicateTable0) },
+ module_info_name(!.ModuleInfo, ModuleName),
+ list__length(Args, Arity0),
+ Arity = Arity0 + ArityAdjustment,
+ module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
(
- { predicate_table_search_pf_sym_arity(PredicateTable0,
+ predicate_table_search_pf_sym_arity(PredicateTable0,
is_fully_qualified, PredOrFunc, PredName,
- Arity, [PredId0]) }
- ->
- { PredId = PredId0 },
- { ModuleInfo1 = ModuleInfo0 },
- (
- { GoalType = promise(_) }
+ Arity, [PredId0])
->
- { prog_out__sym_name_to_string(PredName, NameString) },
- { string__format("%s %s %s (%s).\n",
+ PredId = PredId0,
+ ( GoalType = promise(_) ->
+ prog_out__sym_name_to_string(PredName, NameString),
+ string__format("%s %s %s (%s).\n",
[s("Attempted to introduce a predicate"),
s("for a promise with an identical"),
s("name to an existing predicate"),
- s(NameString)], String) },
- { error(String) }
+ s(NameString)], String),
+ error(String)
;
- []
+ true
)
;
% A promise will not have a
% corresponding pred declaration.
(
- { GoalType = promise(_) }
+ GoalType = promise(_)
->
- { term__term_list_to_var_list(Args, HeadVars) },
- { preds_add_implicit_for_assertion(HeadVars,
- ModuleInfo0, PredicateTable0,
+ term__term_list_to_var_list(Args, HeadVars),
+ preds_add_implicit_for_assertion(HeadVars,
+ !.ModuleInfo, PredicateTable0,
ModuleName, PredName, Arity, Status,
Context, PredOrFunc,
- PredId, PredicateTable1) },
- { module_info_set_predicate_table(ModuleInfo0,
- PredicateTable1, ModuleInfo1) }
+ PredId, PredicateTable1),
+ module_info_set_predicate_table(PredicateTable1,
+ !ModuleInfo)
;
preds_add_implicit_report_error(ModuleName,
PredOrFunc, PredName, Arity, Status, no,
- Context, "clause", PredId,
- ModuleInfo0, ModuleInfo1)
+ Context, "clause", PredId, !ModuleInfo, !IO)
)
),
% Lookup the pred_info for this pred,
% add the clause to the clauses_info in the pred_info,
% if there are no modes add an `infer_modes' marker,
% and then save the pred_info.
- { module_info_get_predicate_table(ModuleInfo1, PredicateTable2) },
- { predicate_table_get_preds(PredicateTable2, Preds0) },
- { map__lookup(Preds0, PredId, PredInfo0) },
+ module_info_get_predicate_table(!.ModuleInfo, PredicateTable2),
+ predicate_table_get_preds(PredicateTable2, Preds0),
+ map__lookup(Preds0, PredId, PredInfo0),
% opt_imported preds are initially tagged as imported and are
% tagged as opt_imported only if/when we see a clause for them
- { Status = opt_imported ->
+ ( Status = opt_imported ->
pred_info_set_import_status(opt_imported,
PredInfo0, PredInfo0a),
pred_info_get_markers(PredInfo0a, Markers0),
- add_marker(Markers0, calls_are_fully_qualified, Markers1),
+ add_marker(calls_are_fully_qualified, Markers0, Markers1),
pred_info_set_markers(Markers1, PredInfo0a, PredInfo1)
;
PredInfo1 = PredInfo0
- },
+ ),
(
- { IllegalSVarResult = yes(StateVar) }
+ IllegalSVarResult = yes(StateVar)
->
report_illegal_func_svar_result(Context, ClauseVarSet,
- StateVar),
- { ModuleInfo = ModuleInfo1 },
- { Info = Info0 }
+ StateVar, !IO)
;
%
% User-supplied clauses for field access functions are
% not allowed -- the clauses are always generated by the
% compiler.
%
- { PredOrFunc = function },
- { adjust_func_arity(function, FuncArity, Arity) },
- { is_field_access_function_name(ModuleInfo1, PredName,
- FuncArity, _, _) },
+ PredOrFunc = function,
+ adjust_func_arity(function, FuncArity, Arity),
+ is_field_access_function_name(!.ModuleInfo, PredName,
+ FuncArity, _, _),
% Don't report errors for clauses for field access
% function clauses in `.opt' files.
- { Status \= opt_imported }
+ Status \= opt_imported
->
- { Info = Info0 },
- { module_info_incr_errors(ModuleInfo1, ModuleInfo) },
- { hlds_out__simple_call_id_to_string(
- PredOrFunc - PredName/Arity, CallIdString0) },
- { string__append(CallIdString0, ".", CallIdString) },
- { ErrorPieces0 = [
+ module_info_incr_errors(!ModuleInfo),
+ hlds_out__simple_call_id_to_string(
+ PredOrFunc - PredName/Arity, CallIdString0),
+ string__append(CallIdString0, ".", CallIdString),
+ ErrorPieces0 = [
words("Error: clause for automatically generated"),
words("field access"),
fixed(CallIdString),
nl
- ] },
- globals__io_lookup_bool_option(verbose_errors, Verbose),
+ ],
+ globals__io_lookup_bool_option(verbose_errors, Verbose, !IO),
(
- { Verbose = yes },
- { ErrorPieces1 = [
+ Verbose = yes,
+ ErrorPieces1 = [
words("Clauses for field access functions"),
words("are automatically generated by the"),
words("compiler. To supply your own"),
@@ -4404,42 +4254,38 @@
words("the input to a field update,"),
words("give the field of the constructor a"),
words("different name.")
- ] },
- { list__append(ErrorPieces0, ErrorPieces1,
- ErrorPieces) }
+ ],
+ list__append(ErrorPieces0, ErrorPieces1,
+ ErrorPieces)
;
- { Verbose = no },
- { ErrorPieces = ErrorPieces0 }
+ Verbose = no,
+ ErrorPieces = ErrorPieces0
),
- error_util__write_error_pieces(Context, 0, ErrorPieces)
+ error_util__write_error_pieces(Context, 0, ErrorPieces, !IO)
;
% Ignore clauses for builtins. This makes bootstrapping
% easier when redefining builtins to use normal Mercury code.
- { pred_info_is_builtin(PredInfo1) }
+ pred_info_is_builtin(PredInfo1)
->
% XXX commented out while the change to builtin_ops
% to add term_size_prof_builtin.term_size_plus is bootstrapped
% prog_out__write_context(Context),
% report_warning("Warning: clause for builtin.\n"),
- { ModuleInfo = ModuleInfo1 },
- { Info = Info0 }
+ true
;
- { pred_info_clauses_info(PredInfo1, Clauses0) },
- { pred_info_typevarset(PredInfo1, TVarSet0) },
- { maybe_add_default_func_mode(PredInfo1, PredInfo2, _) },
+ pred_info_clauses_info(PredInfo1, Clauses0),
+ pred_info_typevarset(PredInfo1, TVarSet0),
+ maybe_add_default_func_mode(PredInfo1, PredInfo2, _),
select_applicable_modes(Args, ClauseVarSet, Status, Context,
- PredId, PredInfo2, ModuleInfo1, Info0,
- ArgTerms, ProcIdsForThisClause, ModuleInfo2, Info1),
- clauses_info_add_clause(Clauses0, ProcIdsForThisClause,
+ PredId, PredInfo2, ArgTerms, ProcIdsForThisClause,
+ !ModuleInfo, !Info, !IO),
+ clauses_info_add_clause(ProcIdsForThisClause,
ClauseVarSet, TVarSet0, ArgTerms, Body, Context,
Status, PredOrFunc, Arity, GoalType, Goal,
- VarSet, TVarSet, Clauses, Warnings,
- ModuleInfo2, ModuleInfo3, Info1, Info),
- {
+ VarSet, TVarSet, Clauses0, Clauses, Warnings,
+ !ModuleInfo, !Info, !IO),
pred_info_set_clauses_info(Clauses, PredInfo2, PredInfo3),
- (
- GoalType = promise(PromiseType)
- ->
+ ( GoalType = promise(PromiseType) ->
pred_info_set_goal_type(promise(PromiseType),
PredInfo3, PredInfo4)
;
@@ -4459,7 +4305,7 @@
ProcIds = pred_info_all_procids(PredInfo6),
( ProcIds = [] ->
pred_info_get_markers(PredInfo6, Markers6),
- add_marker(Markers6, infer_modes, Markers),
+ add_marker(infer_modes, Markers6, Markers),
pred_info_set_markers(Markers, PredInfo6, PredInfo)
;
PredInfo = PredInfo6
@@ -4467,18 +4313,17 @@
map__det_update(Preds0, PredId, PredInfo, Preds),
predicate_table_set_preds(PredicateTable2, Preds,
PredicateTable),
- module_info_set_predicate_table(ModuleInfo3, PredicateTable,
- ModuleInfo)
- },
- ( { Status \= opt_imported } ->
+ module_info_set_predicate_table(PredicateTable, !ModuleInfo),
+ ( Status \= opt_imported ->
% warn about singleton variables
maybe_warn_singletons(VarSet,
- PredOrFunc - PredName/Arity, ModuleInfo, Goal),
+ PredOrFunc - PredName/Arity, !.ModuleInfo,
+ Goal, !IO),
% warn about variables with overlapping scopes
maybe_warn_overlap(Warnings, VarSet,
- PredOrFunc - PredName/Arity)
+ PredOrFunc - PredName/Arity, !IO)
;
- []
+ true
)
).
@@ -4486,17 +4331,16 @@
% and determine which mode(s) this clause should apply to.
:- pred select_applicable_modes(list(prog_term)::in, prog_varset::in,
- import_status::in, prog_context::in, pred_id::in,
- pred_info::in, module_info::in, qual_info::in,
+ import_status::in, prog_context::in, pred_id::in, pred_info::in,
list(prog_term)::out, list(proc_id)::out,
- module_info::out, qual_info::out,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
io__state::di, io__state::uo) is det.
select_applicable_modes(Args0, VarSet, Status, Context, PredId, PredInfo,
- ModuleInfo0, Info0, Args, ProcIds, ModuleInfo, Info) -->
- { get_mode_annotations(Args0, Args, empty, ModeAnnotations) },
+ Args, ProcIds, !ModuleInfo, !Info, !IO) :-
+ get_mode_annotations(Args0, Args, empty, ModeAnnotations),
(
- { ModeAnnotations = modes(ModeList0) },
+ ModeAnnotations = modes(ModeList0),
%
% The user specified some mode annotations on this clause.
@@ -4504,39 +4348,36 @@
% on clauses from `.opt' files will already be fully module
% qualified.
%
- ( { Status = opt_imported } ->
- { ModeList = ModeList0 },
- { Info = Info0 }
+ ( Status = opt_imported ->
+ ModeList = ModeList0
;
- { qual_info_get_mq_info(Info0, MQInfo0) },
+ qual_info_get_mq_info(!.Info, MQInfo0),
module_qual__qualify_clause_mode_list(ModeList0,
- ModeList, Context, MQInfo0, MQInfo),
- { qual_info_set_mq_info(Info0, MQInfo, Info) }
+ ModeList, Context, MQInfo0, MQInfo, !IO),
+ qual_info_set_mq_info(MQInfo, !Info)
),
%
% Now find the procedure which matches these mode annotations.
%
- { pred_info_procedures(PredInfo, Procs) },
- { map__to_assoc_list(Procs, ExistingProcs) },
+ pred_info_procedures(PredInfo, Procs),
+ map__to_assoc_list(Procs, ExistingProcs),
(
- { get_procedure_matching_declmodes(ExistingProcs,
- ModeList, ModuleInfo0, ProcId) }
+ get_procedure_matching_declmodes(ExistingProcs,
+ ModeList, !.ModuleInfo, ProcId)
->
- { ProcIds = [ProcId] },
- { ModuleInfo = ModuleInfo0 }
+ ProcIds = [ProcId]
;
- { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
- undeclared_mode_error(
- ModeList, VarSet, PredId, PredInfo,
- ModuleInfo, Context),
+ module_info_incr_errors(!ModuleInfo),
+ undeclared_mode_error(ModeList, VarSet, PredId,
+ PredInfo, !.ModuleInfo, Context, !IO),
% apply the clause to all modes
% XXX would it be better to apply it to none?
- { ProcIds = pred_info_all_procids(PredInfo) }
+ ProcIds = pred_info_all_procids(PredInfo)
)
;
- { ModeAnnotations = empty },
- { pred_info_pragma_goal_type(PredInfo) ->
+ ModeAnnotations = empty,
+ ( pred_info_pragma_goal_type(PredInfo) ->
% We are only allowed to mix foreign procs and
% mode specific clauses, so make this clause
% mode specific but apply to all modes.
@@ -4544,12 +4385,10 @@
;
% this means the clauses applies to all modes
ProcIds = []
- },
- { ModuleInfo = ModuleInfo0 },
- { Info = Info0 }
+ )
;
- { ModeAnnotations = none },
- { pred_info_pragma_goal_type(PredInfo) ->
+ ModeAnnotations = none,
+ ( pred_info_pragma_goal_type(PredInfo) ->
% We are only allowed to mix foreign procs and
% mode specific clauses, so make this clause
% mode specific but apply to all modes.
@@ -4557,24 +4396,21 @@
;
% this means the clauses applies to all modes
ProcIds = []
- },
- { ModuleInfo = ModuleInfo0 },
- { Info = Info0 }
+ )
;
- { ModeAnnotations = mixed },
- { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
- { Info = Info0 },
- io__set_exit_status(1),
- prog_out__write_context(Context),
- io__write_string("In clause for "),
- hlds_out__write_pred_id(ModuleInfo, PredId),
- io__write_string(":\n"),
- prog_out__write_context(Context),
- io__write_string(
- " syntax error: some but not all arguments have mode annotations.\n"),
+ ModeAnnotations = mixed,
+ module_info_incr_errors(!ModuleInfo),
+ io__set_exit_status(1, !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string("In clause for ", !IO),
+ hlds_out__write_pred_id(!.ModuleInfo, PredId, !IO),
+ io__write_string(":\n", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" syntax error: some but not all " ++
+ "arguments have mode annotations.\n", !IO),
% apply the clause to all modes
% XXX would it be better to apply it to none?
- { ProcIds = pred_info_all_procids(PredInfo) }
+ ProcIds = pred_info_all_procids(PredInfo)
).
% Clauses can have mode annotations on them, to indicate that the
@@ -4590,7 +4426,6 @@
% annotations and some without. (This is not allowed.)
.
-
% Extract the mode annotations (if any) from a list of arguments.
:- pred get_mode_annotations(list(prog_term)::in, list(prog_term)::out,
mode_annotations::in, mode_annotations::out) is det.
@@ -4639,7 +4474,7 @@
% handle the `pred(<MethodName>/<Arity>) is <ImplName>' syntax
produce_instance_method_clauses(name(InstancePredName), PredOrFunc, PredArity,
ArgTypes, Markers, Context, _Status, ClausesInfo,
- ModuleInfo0, ModuleInfo, QualInfo0, QualInfo, IO, IO) :-
+ !ModuleInfo, !QualInfo, !IO) :-
% Add the body of the introduced pred
@@ -4665,8 +4500,8 @@
make_n_fresh_vars("HeadVar__", PredArity, HeadVars, VarSet0, VarSet),
construct_pred_or_func_call(invalid_pred_id, PredOrFunc,
InstancePredName, HeadVars, GoalInfo, IntroducedGoal,
- transform_info(ModuleInfo0, QualInfo0),
- transform_info(ModuleInfo, QualInfo)),
+ transform_info(!.ModuleInfo, !.QualInfo),
+ transform_info(!:ModuleInfo, !:QualInfo)),
IntroducedClause = clause([], IntroducedGoal, mercury, Context),
map__from_corresponding_lists(HeadVars, ArgTypes, VarTypes),
@@ -4681,62 +4516,60 @@
% handle the arbitrary clauses syntax
produce_instance_method_clauses(clauses(InstanceClauses), PredOrFunc,
PredArity, _ArgTypes, _Markers, Context, Status, ClausesInfo,
- ModuleInfo0, ModuleInfo, QualInfo0, QualInfo, IO0, IO) :-
+ !ModuleInfo, !QualInfo, !IO) :-
clauses_info_init(PredArity, ClausesInfo0),
- list__foldl2(
+ list__foldl4(
produce_instance_method_clause(PredOrFunc, Context, Status),
- InstanceClauses, ModuleInfo0 - QualInfo0 - ClausesInfo0,
- ModuleInfo - QualInfo - ClausesInfo, IO0, IO).
+ InstanceClauses, !ModuleInfo, !QualInfo,
+ ClausesInfo0, ClausesInfo, !IO).
:- pred produce_instance_method_clause(pred_or_func::in,
prog_context::in, import_status::in, item::in,
- pair(pair(module_info, qual_info), clauses_info)::in,
- pair(pair(module_info, qual_info), clauses_info)::out,
- io__state::di, io__state::uo) is det.
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ clauses_info::in, clauses_info::out, io__state::di, io__state::uo)
+ is det.
+
produce_instance_method_clause(PredOrFunc, Context, Status, InstanceClause,
- ModuleInfo0 - QualInfo0 - ClausesInfo0,
- ModuleInfo - QualInfo - ClausesInfo) -->
+ !ModuleInfo, !QualInfo, !ClausesInfo, !IO) :-
(
- { InstanceClause = clause(CVarSet, PredOrFunc, PredName,
- HeadTerms0, Body) }
+ InstanceClause = clause(CVarSet, PredOrFunc, PredName,
+ HeadTerms0, Body)
->
(
- { illegal_state_var_func_result(PredOrFunc, HeadTerms0,
- StateVar) }
+ illegal_state_var_func_result(PredOrFunc, HeadTerms0,
+ StateVar)
->
report_illegal_func_svar_result(Context, CVarSet,
- StateVar),
- { ModuleInfo = ModuleInfo0 },
- { QualInfo = QualInfo0 },
- { ClausesInfo = ClausesInfo0 }
- ;
- { HeadTerms = expand_bang_state_var_args(HeadTerms0) },
- { PredArity = list__length(HeadTerms) },
- { adjust_func_arity(PredOrFunc, Arity, PredArity) },
+ StateVar, !IO)
+ ;
+ HeadTerms = expand_bang_state_var_args(HeadTerms0),
+ PredArity = list__length(HeadTerms),
+ adjust_func_arity(PredOrFunc, Arity, PredArity),
% The tvarset argument is only used for explicit type
- % qualifications, of which there are none in this clause,
- % so it is set to a dummy value.
- { varset__init(TVarSet0) },
+ % qualifications, of which there are none in this
+ % clause, so it is set to a dummy value.
+ varset__init(TVarSet0),
- { ProcIds = [] }, % means this clause applies to _every_
+ ProcIds = [], % means this clause applies to _every_
% mode of the procedure
- { GoalType = none }, % goal is not a promise
- clauses_info_add_clause(ClausesInfo0, ProcIds,
- CVarSet, TVarSet0, HeadTerms, Body, Context,
- Status, PredOrFunc, Arity, GoalType, Goal,
- VarSet, _TVarSet, ClausesInfo, Warnings,
- ModuleInfo0, ModuleInfo, QualInfo0, QualInfo),
+ GoalType = none, % goal is not a promise
+ clauses_info_add_clause(ProcIds, CVarSet, TVarSet0,
+ HeadTerms, Body, Context, Status, PredOrFunc,
+ Arity, GoalType, Goal, VarSet, _TVarSet,
+ !ClausesInfo, Warnings, !ModuleInfo, !QualInfo,
+ !IO),
% warn about singleton variables
maybe_warn_singletons(VarSet,
- PredOrFunc - PredName/Arity, ModuleInfo, Goal),
+ PredOrFunc - PredName/Arity, !.ModuleInfo,
+ Goal, !IO),
% warn about variables with overlapping scopes
maybe_warn_overlap(Warnings, VarSet,
- PredOrFunc - PredName/Arity)
+ PredOrFunc - PredName/Arity, !IO)
)
;
- { error("produce_clause: invalid instance item") }
+ error("produce_clause: invalid instance item")
).
%-----------------------------------------------------------------------------%
@@ -4750,31 +4583,27 @@
% NB. Any changes here might also require similar changes to the
% handling of `pragma export' declarations, in export.m.
-:- pred module_add_pragma_import(sym_name, pred_or_func, list(mode),
- pragma_foreign_proc_attributes, string, import_status,
- prog_context, module_info, module_info, qual_info, qual_info,
- io__state, io__state).
-:- mode module_add_pragma_import(in, in, in, in, in, in, in, in, out,
- in, out, di, uo) is det.
+:- pred module_add_pragma_import(sym_name::in, pred_or_func::in, list(mode)::in,
+ pragma_foreign_proc_attributes::in, string::in, import_status::in,
+ prog_context::in, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, io__state::di, io__state::uo) is det.
module_add_pragma_import(PredName, PredOrFunc, Modes, Attributes,
- C_Function, Status, Context, ModuleInfo0, ModuleInfo,
- Info0, Info) -->
- { module_info_name(ModuleInfo0, ModuleName) },
- { list__length(Modes, Arity) },
+ C_Function, Status, Context, !ModuleInfo, !Info, !IO) :-
+ module_info_name(!.ModuleInfo, ModuleName),
+ list__length(Modes, Arity),
%
% print out a progress message
%
- globals__io_lookup_bool_option(very_verbose, VeryVerbose),
- (
- { VeryVerbose = yes }
- ->
- io__write_string("% Processing `:- pragma import' for "),
- hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
- io__write_string("...\n")
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ ( VeryVerbose = yes ->
+ io__write_string("% Processing `:- pragma import' for ", !IO),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity,
+ !IO),
+ io__write_string("...\n", !IO)
;
- []
+ true
),
%
@@ -4782,87 +4611,83 @@
% (If it's not there, print an error message and insert
% a dummy declaration for the predicate.)
%
- { module_info_get_predicate_table(ModuleInfo0, PredicateTable0) },
+ module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
(
- { predicate_table_search_pf_sym_arity(PredicateTable0,
+ predicate_table_search_pf_sym_arity(PredicateTable0,
is_fully_qualified, PredOrFunc, PredName,
- Arity, [PredId0]) }
+ Arity, [PredId0])
->
- { PredId = PredId0 },
- { ModuleInfo1 = ModuleInfo0 }
+ PredId = PredId0
;
- preds_add_implicit_report_error(ModuleName,
- PredOrFunc, PredName, Arity, Status, no, Context,
- "`:- pragma import' declaration",
- PredId, ModuleInfo0, ModuleInfo1)
+ preds_add_implicit_report_error(ModuleName, PredOrFunc,
+ PredName, Arity, Status, no, Context,
+ "`:- pragma import' declaration", PredId,
+ !ModuleInfo, !IO)
),
%
% Lookup the pred_info for this pred,
% and check that it is valid.
%
- { module_info_get_predicate_table(ModuleInfo1, PredicateTable2) },
- { predicate_table_get_preds(PredicateTable2, Preds0) },
- { map__lookup(Preds0, PredId, PredInfo0) },
+ module_info_get_predicate_table(!.ModuleInfo, PredicateTable2),
+ predicate_table_get_preds(PredicateTable2, Preds0),
+ map__lookup(Preds0, PredId, PredInfo0),
% opt_imported preds are initially tagged as imported and are
% tagged as opt_imported only if/when we see a clause (including
% a `pragma import' clause) for them
- { Status = opt_imported ->
+ ( Status = opt_imported ->
pred_info_set_import_status(opt_imported, PredInfo0, PredInfo1)
;
PredInfo1 = PredInfo0
- },
+ ),
(
- { pred_info_is_imported(PredInfo1) }
- ->
- { module_info_incr_errors(ModuleInfo1, ModuleInfo) },
- prog_out__write_context(Context),
- io__write_string("Error: `:- pragma import' "),
- io__write_string("declaration for imported "),
- hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
- io__write_string(".\n"),
- { Info = Info0 }
- ;
- { pred_info_clause_goal_type(PredInfo1) }
+ pred_info_is_imported(PredInfo1)
->
- { module_info_incr_errors(ModuleInfo1, ModuleInfo) },
- prog_out__write_context(Context),
- io__write_string("Error: `:- pragma import' declaration "),
- io__write_string("for "),
- hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
- io__write_string("\n"),
- prog_out__write_context(Context),
- io__write_string(" with preceding clauses.\n"),
- { Info = Info0 }
+ module_info_incr_errors(!ModuleInfo),
+ prog_out__write_context(Context, !IO),
+ io__write_string("Error: `:- pragma import' ", !IO),
+ io__write_string("declaration for imported ", !IO),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity, !IO),
+ io__write_string(".\n", !IO)
+ ;
+ pred_info_clause_goal_type(PredInfo1)
+ ->
+ module_info_incr_errors(!ModuleInfo),
+ prog_out__write_context(Context, !IO),
+ io__write_string("Error: `:- pragma import' declaration ", !IO),
+ io__write_string("for ", !IO),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity, !IO),
+ io__write_string("\n", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" with preceding clauses.\n", !IO)
;
- { pred_info_update_goal_type(pragmas, PredInfo1, PredInfo2) },
+ pred_info_update_goal_type(pragmas, PredInfo1, PredInfo2),
%
% add the pragma declaration to the proc_info for this procedure
%
- { pred_info_procedures(PredInfo2, Procs) },
- { map__to_assoc_list(Procs, ExistingProcs) },
+ pred_info_procedures(PredInfo2, Procs),
+ map__to_assoc_list(Procs, ExistingProcs),
(
- { get_procedure_matching_argmodes(ExistingProcs, Modes,
- ModuleInfo1, ProcId) }
+ get_procedure_matching_argmodes(ExistingProcs, Modes,
+ !.ModuleInfo, ProcId)
->
pred_add_pragma_import(PredInfo2, PredId, ProcId,
Attributes, C_Function, Context,
- PredInfo, ModuleInfo1, ModuleInfo2,
- Info0, Info),
- { map__det_update(Preds0, PredId, PredInfo, Preds) },
- { predicate_table_set_preds(PredicateTable2, Preds,
- PredicateTable) },
- { module_info_set_predicate_table(ModuleInfo2,
- PredicateTable, ModuleInfo) }
- ;
- { module_info_incr_errors(ModuleInfo1, ModuleInfo) },
- prog_out__write_context(Context),
- io__write_string("Error: `:- pragma import' "),
- io__write_string("declaration for undeclared mode "),
- io__write_string("of "),
+ PredInfo, !ModuleInfo, !Info, !IO),
+ map__det_update(Preds0, PredId, PredInfo, Preds),
+ predicate_table_set_preds(PredicateTable2, Preds,
+ PredicateTable),
+ module_info_set_predicate_table(PredicateTable,
+ !ModuleInfo)
+ ;
+ module_info_incr_errors(!ModuleInfo),
+ prog_out__write_context(Context, !IO),
+ io__write_string("Error: `:- pragma import' ", !IO),
+ io__write_string("declaration for undeclared mode ",
+ !IO),
+ io__write_string("of ", !IO),
hlds_out__write_simple_call_id(PredOrFunc,
- PredName/Arity),
- io__write_string(".\n"),
- { Info = Info0 }
+ PredName/Arity, !IO),
+ io__write_string(".\n", !IO)
)
).
@@ -4907,67 +4732,63 @@
%-----------------------------------------------------------------------------%
-:- pred module_add_pragma_foreign_proc(pragma_foreign_proc_attributes,
- sym_name, pred_or_func, list(pragma_var), prog_varset,
- pragma_foreign_code_impl, import_status, prog_context,
- module_info, module_info, qual_info, qual_info, io__state,
- io__state).
-:- mode module_add_pragma_foreign_proc(in, in, in, in, in, in, in, in,
- in, out, in, out, di, uo) is det.
-
-module_add_pragma_foreign_proc(Attributes, PredName, PredOrFunc,
- PVars, VarSet, PragmaImpl, Status, Context,
- ModuleInfo0, ModuleInfo, Info0, Info) -->
- { module_info_name(ModuleInfo0, ModuleName) },
- { foreign_language(Attributes, PragmaForeignLanguage) },
- { list__length(PVars, Arity) },
+:- pred module_add_pragma_foreign_proc(pragma_foreign_proc_attributes::in,
+ sym_name::in, pred_or_func::in, list(pragma_var)::in, prog_varset::in,
+ pragma_foreign_code_impl::in, import_status::in, prog_context::in,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ io__state::di, io__state::uo) is det.
+
+module_add_pragma_foreign_proc(Attributes, PredName, PredOrFunc, PVars, VarSet,
+ PragmaImpl, Status, Context, !ModuleInfo, !Info, !IO) :-
+ module_info_name(!.ModuleInfo, ModuleName),
+ foreign_language(Attributes, PragmaForeignLanguage),
+ list__length(PVars, Arity),
% print out a progress message
- globals__io_lookup_bool_option(very_verbose, VeryVerbose),
- (
- { VeryVerbose = yes }
- ->
- io__write_string("% Processing `:- pragma foreign_proc' for "),
- hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
- io__write_string("...\n")
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ ( VeryVerbose = yes ->
+ io__write_string("% Processing `:- pragma foreign_proc' for ",
+ !IO),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity,
+ !IO),
+ io__write_string("...\n", !IO)
;
- []
+ true
),
- globals__io_get_backend_foreign_languages(BackendForeignLangs),
+ globals__io_get_backend_foreign_languages(BackendForeignLangs, !IO),
% Lookup the pred declaration in the predicate table.
% (If it's not there, print an error message and insert
% a dummy declaration for the predicate.)
- { module_info_get_predicate_table(ModuleInfo0, PredicateTable0) },
+ module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
(
- { predicate_table_search_pf_sym_arity(PredicateTable0,
+ predicate_table_search_pf_sym_arity(PredicateTable0,
is_fully_qualified, PredOrFunc, PredName,
- Arity, [PredId0]) }
+ Arity, [PredId0])
->
- { PredId = PredId0 },
- { ModuleInfo1 = ModuleInfo0 }
+ PredId = PredId0
;
- preds_add_implicit_report_error(ModuleName,
- PredOrFunc, PredName, Arity, Status, no, Context,
+ preds_add_implicit_report_error(ModuleName, PredOrFunc,
+ PredName, Arity, Status, no, Context,
"`:- pragma foreign_proc' declaration",
- PredId, ModuleInfo0, ModuleInfo1)
+ PredId, !ModuleInfo, !IO)
),
% Lookup the pred_info for this pred,
% add the pragma to the proc_info in the proc_table in the
% pred_info, and save the pred_info.
- { module_info_get_predicate_table(ModuleInfo1, PredicateTable1) },
- { predicate_table_get_preds(PredicateTable1, Preds0) },
- { map__lookup(Preds0, PredId, PredInfo0) },
+ module_info_get_predicate_table(!.ModuleInfo, PredicateTable1),
+ predicate_table_get_preds(PredicateTable1, Preds0),
+ map__lookup(Preds0, PredId, PredInfo0),
% opt_imported preds are initially tagged as imported and are
% tagged as opt_imported only if/when we see a clause (including
% a `pragma c_code' clause) for them
- { Status = opt_imported ->
+ ( Status = opt_imported ->
pred_info_set_import_status(opt_imported,
PredInfo0, PredInfo1a)
;
PredInfo1a = PredInfo0
- },
- {
+ ),
+ (
% If this procedure was previously defined as clauses only
% then we need to turn all the non mode-specific clauses
% into mode-specific clauses.
@@ -4988,254 +4809,235 @@
pred_info_set_clauses_info(CInfo, PredInfo1a, PredInfo1)
;
PredInfo1 = PredInfo1a
- },
+ ),
(
- { pred_info_is_imported(PredInfo1) }
+ pred_info_is_imported(PredInfo1)
->
- { module_info_incr_errors(ModuleInfo1, ModuleInfo) },
- prog_out__write_context(Context),
- io__write_string("Error: `:- pragma foreign_proc' (or `pragma c_code')\n"),
- prog_out__write_context(Context),
- io__write_string("declaration for imported "),
- hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
- io__write_string(".\n"),
- { Info = Info0 }
+ module_info_incr_errors(!ModuleInfo),
+ prog_out__write_context(Context, !IO),
+ io__write_string("Error: `:- pragma foreign_proc' " ++
+ "(or `pragma c_code')\n", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string("declaration for imported ", !IO),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity, !IO),
+ io__write_string(".\n", !IO)
;
% Don't add clauses for foreign languages other
% than the ones we can generate code for.
- { not list__member(PragmaForeignLanguage, BackendForeignLangs) }
+ not list__member(PragmaForeignLanguage, BackendForeignLangs)
->
- { pred_info_update_goal_type(pragmas, PredInfo0, PredInfo) },
- { module_info_set_pred_info(ModuleInfo1,
- PredId, PredInfo, ModuleInfo) },
- { Info = Info0 }
+ pred_info_update_goal_type(pragmas, PredInfo0, PredInfo),
+ module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
;
% add the pragma declaration to the proc_info for this procedure
- { pred_info_procedures(PredInfo1, Procs) },
- { map__to_assoc_list(Procs, ExistingProcs) },
- { pragma_get_modes(PVars, Modes) },
- (
- { get_procedure_matching_argmodes(ExistingProcs, Modes,
- ModuleInfo1, ProcId) }
- ->
- { pred_info_clauses_info(PredInfo1, Clauses0) },
-
- { pred_info_arg_types(PredInfo1, ArgTypes) },
- { pred_info_get_purity(PredInfo1, Purity) },
- clauses_info_add_pragma_foreign_proc(
- Clauses0, Purity, Attributes, PredId,
- ProcId, VarSet, PVars, ArgTypes,
- PragmaImpl, Context, PredOrFunc,
- PredName, Arity, Clauses, ModuleInfo1,
- ModuleInfo2, Info0, Info),
- { pred_info_set_clauses_info(Clauses,
- PredInfo1, PredInfo2) },
- { pred_info_update_goal_type(pragmas,
- PredInfo2, PredInfo) },
- { map__det_update(Preds0, PredId, PredInfo, Preds) },
- { predicate_table_set_preds(PredicateTable1, Preds,
- PredicateTable) },
- { module_info_set_predicate_table(ModuleInfo2,
- PredicateTable, ModuleInfo) },
- { pragma_get_var_infos(PVars, ArgInfo) },
+ pred_info_procedures(PredInfo1, Procs),
+ map__to_assoc_list(Procs, ExistingProcs),
+ pragma_get_modes(PVars, Modes),
+ (
+ get_procedure_matching_argmodes(ExistingProcs, Modes,
+ !.ModuleInfo, ProcId)
+ ->
+ pred_info_clauses_info(PredInfo1, Clauses0),
+
+ pred_info_arg_types(PredInfo1, ArgTypes),
+ pred_info_get_purity(PredInfo1, Purity),
+ clauses_info_add_pragma_foreign_proc(Clauses0, Purity,
+ Attributes, PredId, ProcId, VarSet, PVars,
+ ArgTypes, PragmaImpl, Context, PredOrFunc,
+ PredName, Arity, Clauses, !ModuleInfo, !Info,
+ !IO),
+ pred_info_set_clauses_info(Clauses,
+ PredInfo1, PredInfo2),
+ pred_info_update_goal_type(pragmas,
+ PredInfo2, PredInfo),
+ map__det_update(Preds0, PredId, PredInfo, Preds),
+ predicate_table_set_preds(PredicateTable1, Preds,
+ PredicateTable),
+ module_info_set_predicate_table(PredicateTable,
+ !ModuleInfo),
+ pragma_get_var_infos(PVars, ArgInfo),
maybe_warn_pragma_singletons(PragmaImpl,
PragmaForeignLanguage, ArgInfo,
Context, PredOrFunc - PredName/Arity,
- ModuleInfo)
+ !.ModuleInfo, !IO)
;
- { module_info_incr_errors(ModuleInfo1, ModuleInfo) },
- prog_out__write_context(Context),
- io__write_string("Error: `:- pragma foreign_proc' "),
- io__write_string("declaration for undeclared mode "),
- io__write_string("of "),
+ module_info_incr_errors(!ModuleInfo),
+ prog_out__write_context(Context, !IO),
+ io__write_string("Error: `:- pragma foreign_proc' ",
+ !IO),
+ io__write_string("declaration for undeclared mode ",
+ !IO),
+ io__write_string("of ", !IO),
hlds_out__write_simple_call_id(PredOrFunc,
- PredName/Arity),
- io__write_string(".\n"),
- { Info = Info0 }
+ PredName/Arity, !IO),
+ io__write_string(".\n", !IO)
)
).
%-----------------------------------------------------------------------------%
-:- pred module_add_pragma_tabled(eval_method, sym_name, int,
- maybe(pred_or_func), maybe(list(mode)),
- import_status, prog_context, module_info, module_info,
- io__state, io__state).
-:- mode module_add_pragma_tabled(in, in, in, in, in, in, in, in, out,
- di, uo) is det.
+:- pred module_add_pragma_tabled(eval_method::in, sym_name::in, int::in,
+ maybe(pred_or_func)::in, maybe(list(mode))::in, import_status::in,
+ prog_context::in, module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
module_add_pragma_tabled(EvalMethod, PredName, Arity, MaybePredOrFunc,
- MaybeModes, Status, Context, ModuleInfo0, ModuleInfo) -->
- { module_info_get_predicate_table(ModuleInfo0, PredicateTable0) },
- { EvalMethodS = eval_method_to_string(EvalMethod) },
+ MaybeModes, Status, Context, !ModuleInfo, !IO) :-
+ module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
+ EvalMethodS = eval_method_to_string(EvalMethod),
% Find out if we are tabling a predicate or a function
(
- { MaybePredOrFunc = yes(PredOrFunc0) }
+ MaybePredOrFunc = yes(PredOrFunc0)
->
- { PredOrFunc = PredOrFunc0 },
+ PredOrFunc = PredOrFunc0,
% Lookup the pred declaration in the predicate table.
% (If it's not there, print an error message and insert
% a dummy declaration for the predicate.)
(
- { predicate_table_search_pf_sym_arity(PredicateTable0,
+ predicate_table_search_pf_sym_arity(PredicateTable0,
is_fully_qualified, PredOrFunc,
- PredName, Arity, PredIds0) }
+ PredName, Arity, PredIds0)
->
- { PredIds = PredIds0 },
- { ModuleInfo1 = ModuleInfo0 }
+ PredIds = PredIds0
;
- { module_info_name(ModuleInfo0, ModuleName) },
- { string__format("`:- pragma %s' declaration",
- [s(EvalMethodS)], Message1) },
+ module_info_name(!.ModuleInfo, ModuleName),
+ string__format("`:- pragma %s' declaration",
+ [s(EvalMethodS)], Message1),
- preds_add_implicit_report_error(ModuleName,
- PredOrFunc, PredName, Arity, Status, no,
- Context, Message1, PredId,
- ModuleInfo0, ModuleInfo1),
- { PredIds = [PredId] }
+ preds_add_implicit_report_error(ModuleName, PredOrFunc,
+ PredName, Arity, Status, no, Context,
+ Message1, PredId, !ModuleInfo, !IO),
+ PredIds = [PredId]
)
;
(
- { predicate_table_search_sym_arity(PredicateTable0,
+ predicate_table_search_sym_arity(PredicateTable0,
is_fully_qualified, PredName,
- Arity, PredIds0) }
+ Arity, PredIds0)
->
- { ModuleInfo1 = ModuleInfo0 },
- { PredIds = PredIds0 }
+ PredIds = PredIds0
;
- { module_info_name(ModuleInfo0, ModuleName) },
- { string__format("`:- pragma %s' declaration",
- [s(EvalMethodS)], Message1) },
+ module_info_name(!.ModuleInfo, ModuleName),
+ string__format("`:- pragma %s' declaration",
+ [s(EvalMethodS)], Message1),
preds_add_implicit_report_error(ModuleName,
predicate, PredName, Arity, Status, no,
Context, Message1, PredId,
- ModuleInfo0, ModuleInfo1),
- { PredIds = [PredId] }
+ !ModuleInfo, !IO),
+ PredIds = [PredId]
)
),
list__foldl2(module_add_pragma_tabled_2(EvalMethod, PredName,
Arity, MaybePredOrFunc, MaybeModes, Context),
- PredIds, ModuleInfo1, ModuleInfo).
+ PredIds, !ModuleInfo, !IO).
-
-:- pred module_add_pragma_tabled_2(eval_method, sym_name, int,
- maybe(pred_or_func), maybe(list(mode)), prog_context,
- pred_id, module_info, module_info, io__state, io__state).
-:- mode module_add_pragma_tabled_2(in, in, in, in, in, in, in, in, out,
- di, uo) is det.
+:- pred module_add_pragma_tabled_2(eval_method::in, sym_name::in, int::in,
+ maybe(pred_or_func)::in, maybe(list(mode))::in, prog_context::in,
+ pred_id::in, module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
module_add_pragma_tabled_2(EvalMethod, PredName, Arity0, MaybePredOrFunc,
- MaybeModes, Context, PredId, ModuleInfo0, ModuleInfo) -->
+ MaybeModes, Context, PredId, !ModuleInfo, !IO) :-
% Lookup the pred_info for this pred,
- { module_info_get_predicate_table(ModuleInfo0, PredicateTable) },
- { predicate_table_get_preds(PredicateTable, Preds) },
- { map__lookup(Preds, PredId, PredInfo0) },
+ module_info_get_predicate_table(!.ModuleInfo, PredicateTable),
+ predicate_table_get_preds(PredicateTable, Preds),
+ map__lookup(Preds, PredId, PredInfo0),
% Find out if we are tabling a predicate or a function
(
- { MaybePredOrFunc = yes(PredOrFunc0) }
- ->
- { PredOrFunc = PredOrFunc0 }
+ MaybePredOrFunc = yes(PredOrFunc0),
+ PredOrFunc = PredOrFunc0
;
- { PredOrFunc = pred_info_is_pred_or_func(PredInfo0) }
+ MaybePredOrFunc = no,
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo0)
),
- { adjust_func_arity(PredOrFunc, Arity0, Arity) },
+ adjust_func_arity(PredOrFunc, Arity0, Arity),
% print out a progress message
- { EvalMethodS = eval_method_to_string(EvalMethod) },
- globals__io_lookup_bool_option(very_verbose, VeryVerbose),
- (
- { VeryVerbose = yes }
- ->
- io__write_string("% Processing `:- pragma "),
- io__write_string(EvalMethodS),
- io__write_string("' for "),
- hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
- io__write_string("...\n")
+ EvalMethodS = eval_method_to_string(EvalMethod),
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ ( VeryVerbose = yes ->
+ io__write_string("% Processing `:- pragma ", !IO),
+ io__write_string(EvalMethodS, !IO),
+ io__write_string("' for ", !IO),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity, !IO),
+ io__write_string("...\n", !IO)
;
- []
+ true
),
- (
- { pred_info_is_imported(PredInfo0) }
- ->
- { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
- prog_out__write_context(Context),
- io__write_string("Error: `:- pragma "),
- io__write_string(EvalMethodS),
- io__write_string("' declaration for imported "),
- hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
- io__write_string(".\n")
+ ( pred_info_is_imported(PredInfo0) ->
+ module_info_incr_errors(!ModuleInfo),
+ prog_out__write_context(Context, !IO),
+ io__write_string("Error: `:- pragma ", !IO),
+ io__write_string(EvalMethodS, !IO),
+ io__write_string("' declaration for imported ", !IO),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity, !IO),
+ io__write_string(".\n", !IO)
;
% do we have to make sure the tabled preds are stratified?
(
- { eval_method_needs_stratification(EvalMethod) = yes }
+ eval_method_needs_stratification(EvalMethod) = yes
->
- { module_info_stratified_preds(ModuleInfo0,
- StratPredIds0) },
- { set__insert(StratPredIds0, PredId, StratPredIds) },
- { module_info_set_stratified_preds(ModuleInfo0,
- StratPredIds, ModuleInfo1) }
+ module_info_stratified_preds(!.ModuleInfo,
+ StratPredIds0),
+ set__insert(StratPredIds0, PredId, StratPredIds),
+ module_info_set_stratified_preds(StratPredIds,
+ !ModuleInfo)
;
- { ModuleInfo1 = ModuleInfo0 }
+ true
),
% add the eval model to the proc_info for this procedure
- { pred_info_procedures(PredInfo0, Procs0) },
- { map__to_assoc_list(Procs0, ExistingProcs) },
+ pred_info_procedures(PredInfo0, Procs0),
+ map__to_assoc_list(Procs0, ExistingProcs),
+ ( MaybeModes = yes(Modes) ->
(
- { MaybeModes = yes(Modes) }
+ get_procedure_matching_argmodes(ExistingProcs,
+ Modes, !.ModuleInfo, ProcId)
->
- (
- { get_procedure_matching_argmodes(
- ExistingProcs, Modes, ModuleInfo1,
- ProcId) }
- ->
- { map__lookup(Procs0, ProcId, ProcInfo0) },
- { proc_info_set_eval_method(EvalMethod,
- ProcInfo0, ProcInfo) },
- { map__det_update(Procs0, ProcId, ProcInfo,
- Procs) },
- { pred_info_set_procedures(Procs,
- PredInfo0, PredInfo) },
- { module_info_set_pred_info(ModuleInfo1,
- PredId, PredInfo, ModuleInfo) }
- ;
- { module_info_incr_errors(ModuleInfo1,
- ModuleInfo) },
- prog_out__write_context(Context),
- io__write_string("Error: `:- pragma "),
- io__write_string(EvalMethodS),
- io__write_string(
- "' declaration for undeclared mode of "),
+ map__lookup(Procs0, ProcId, ProcInfo0),
+ proc_info_set_eval_method(EvalMethod,
+ ProcInfo0, ProcInfo),
+ map__det_update(Procs0, ProcId, ProcInfo,
+ Procs),
+ pred_info_set_procedures(Procs,
+ PredInfo0, PredInfo),
+ module_info_set_pred_info(PredId, PredInfo,
+ !ModuleInfo)
+ ;
+ module_info_incr_errors(!ModuleInfo),
+ prog_out__write_context(Context, !IO),
+ io__write_string("Error: `:- pragma ", !IO),
+ io__write_string(EvalMethodS, !IO),
+ io__write_string("' declaration for " ++
+ "undeclared mode of ", !IO),
hlds_out__write_simple_call_id(PredOrFunc,
- PredName/Arity),
- io__write_string(".\n")
+ PredName/Arity, !IO),
+ io__write_string(".\n", !IO)
)
- ;
- { ExistingProcs = [] }
- ->
- { module_info_incr_errors(ModuleInfo1, ModuleInfo) },
- prog_out__write_context(Context),
- io__write_string("Error: `:- pragma "),
- io__write_string(EvalMethodS),
- io__write_string("' declaration for\n"),
- prog_out__write_context(Context),
- io__write_string(" "),
+ ; ExistingProcs = [] ->
+ module_info_incr_errors(!ModuleInfo),
+ prog_out__write_context(Context, !IO),
+ io__write_string("Error: `:- pragma ", !IO),
+ io__write_string(EvalMethodS, !IO),
+ io__write_string("' declaration for\n", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" ", !IO),
hlds_out__write_simple_call_id(PredOrFunc,
- PredName/Arity),
- io__write_string(" with no declared modes.\n")
+ PredName/Arity, !IO),
+ io__write_string(" with no declared modes.\n", !IO)
;
- { set_eval_method_list(ExistingProcs, EvalMethod,
- Procs0, Procs) },
- { pred_info_set_procedures(Procs,
- PredInfo0, PredInfo) },
- { module_info_set_pred_info(ModuleInfo1, PredId,
- PredInfo, ModuleInfo) }
+ set_eval_method_list(ExistingProcs, EvalMethod,
+ Procs0, Procs),
+ pred_info_set_procedures(Procs,
+ PredInfo0, PredInfo),
+ module_info_set_pred_info(PredId, PredInfo,
+ !ModuleInfo)
)
).
@@ -5312,15 +5114,14 @@
% 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), 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),
+:- pred pragma_add_marker(list(pred_id)::in,
+ add_marker_pred_info::in(add_marker_pred_info), import_status::in,
+ bool::in, pred_table::in, pred_table::out, bool::out) is det.
+
+pragma_add_marker([], _, _, _, !PredTable, no).
+pragma_add_marker([PredId | PredIds], UpdatePredInfo, Status, MustBeExported,
+ !PredTable, WrongStatus) :-
+ map__lookup(!.PredTable, PredId, PredInfo0),
call(UpdatePredInfo, PredInfo0, PredInfo),
(
pred_info_is_exported(PredInfo),
@@ -5331,9 +5132,9 @@
;
WrongStatus0 = no
),
- map__det_update(PredTable0, PredId, PredInfo, PredTable1),
- pragma_add_marker(PredTable1, PredIds, UpdatePredInfo, Status,
- MustBeExported, PredTable, WrongStatus1),
+ map__det_update(!.PredTable, PredId, PredInfo, !:PredTable),
+ pragma_add_marker(PredIds, UpdatePredInfo, Status,
+ MustBeExported, !PredTable, WrongStatus1),
bool__or(WrongStatus0, WrongStatus1, WrongStatus).
:- pred add_marker_pred_info(marker, pred_info, pred_info).
@@ -5341,7 +5142,7 @@
add_marker_pred_info(Marker, !PredInfo) :-
pred_info_get_markers(!.PredInfo, Markers0),
- add_marker(Markers0, Marker, Markers),
+ add_marker(Marker, Markers0, Markers),
pred_info_set_markers(Markers, !PredInfo).
% Succeed if a marker for an exported procedure must also
@@ -5585,7 +5386,6 @@
warn_singletons_in_goal_2_shorthand(ShorthandGoal, GoalInfo,
QuantVars, VarSet, PredCallId, MI).
-
:- pred warn_singletons_in_goal_2_shorthand(shorthand_goal_expr,
hlds_goal_info, set(prog_var), prog_varset, simple_call_id,
module_info, io__state, io__state).
@@ -5597,7 +5397,6 @@
warn_singletons_in_goal_list([LHS, RHS], QuantVars, VarSet,
PredCallId, MI).
-
:- pred warn_singletons_in_goal_list(list(hlds_goal), set(prog_var),
prog_varset, simple_call_id, module_info,
io__state, io__state).
@@ -5989,23 +5788,21 @@
VarTypes, HeadVars, [], TI_VarMap, TCI_VarMap,
HasForeignClauses).
-:- pred clauses_info_add_clause(clauses_info::in,
- list(proc_id)::in, prog_varset::in, tvarset::in,
- list(prog_term)::in, goal::in, prog_context::in,
- import_status::in, pred_or_func::in, arity::in, goal_type::in,
- hlds_goal::out, prog_varset::out, tvarset::out,
- clauses_info::out, list(quant_warning)::out,
- module_info::in, module_info::out, qual_info::in,
- qual_info::out, io__state::di, io__state::uo) is det.
+:- pred clauses_info_add_clause(list(proc_id)::in,
+ prog_varset::in, tvarset::in, list(prog_term)::in, goal::in,
+ prog_context::in, import_status::in, pred_or_func::in, arity::in,
+ goal_type::in, hlds_goal::out, prog_varset::out, tvarset::out,
+ clauses_info::in, clauses_info::out, list(quant_warning)::out,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ io__state::di, io__state::uo) is det.
-clauses_info_add_clause(ClausesInfo0, ModeIds0, CVarSet, TVarSet0,
- Args, Body, Context, Status, PredOrFunc, Arity, GoalType,
- Goal, VarSet, TVarSet, ClausesInfo, Warnings, Module0, Module,
- Info0, Info) -->
- { ClausesInfo0 = clauses_info(VarSet0, ExplicitVarTypes0, TVarNameMap0,
- InferredVarTypes, HeadVars, ClauseList0,
- TI_VarMap, TCI_VarMap, HasForeignClauses) },
- { ClauseList0 = [] ->
+clauses_info_add_clause(ModeIds0, CVarSet, TVarSet0, Args, Body, Context,
+ Status, PredOrFunc, Arity, GoalType, Goal, VarSet, TVarSet,
+ !ClausesInfo, Warnings, !Module, !Info, !IO) :-
+ !.ClausesInfo = clauses_info(VarSet0, ExplicitVarTypes0,
+ TVarNameMap0, InferredVarTypes, HeadVars, ClauseList0,
+ TI_VarMap, TCI_VarMap, HasForeignClauses),
+ ( ClauseList0 = [] ->
% Create the mapping from type variable name, used to
% rename type variables occurring in explicit type
% qualifications. The version of this mapping stored
@@ -6016,34 +5813,33 @@
varset__create_name_var_map(TVarSet0, TVarNameMap)
;
TVarNameMap = TVarNameMap0
- },
- { update_qual_info(Info0, TVarNameMap, TVarSet0,
- ExplicitVarTypes0, Status, Info1) },
- { varset__merge_subst(VarSet0, CVarSet, VarSet1, Subst) },
- transform(Subst, HeadVars, Args, Body, VarSet1, Context, PredOrFunc,
- Arity, GoalType, Goal0, VarSet, Warnings,
- transform_info(Module0, Info1),
- transform_info(Module, Info2)),
- { TVarSet = Info2 ^ tvarset },
- { qual_info_get_found_syntax_error(Info2, FoundError) },
- { qual_info_set_found_syntax_error(no, Info2, Info) },
+ ),
+ update_qual_info(TVarNameMap, TVarSet0, ExplicitVarTypes0, Status,
+ !Info),
+ varset__merge_subst(VarSet0, CVarSet, VarSet1, Subst),
+ transform(Subst, HeadVars, Args, Body, Context, PredOrFunc,
+ Arity, GoalType, Goal0, VarSet1, VarSet, Warnings,
+ transform_info(!.Module, !.Info),
+ transform_info(!:Module, !:Info), !IO),
+ TVarSet = !.Info ^ tvarset ,
+ qual_info_get_found_syntax_error(!.Info, FoundError),
+ qual_info_set_found_syntax_error(no, !Info),
(
- { FoundError = yes },
+ FoundError = yes,
% Don't insert clauses containing syntax errors into
% the clauses_info, because doing that would cause
% typecheck.m to report spurious type errors.
- { ClausesInfo = ClausesInfo0 },
% Don't report singleton variable warnings if there
% were syntax errors.
- { true_goal(Goal) }
+ true_goal(Goal)
;
- { FoundError = no },
- { Goal = Goal0 },
+ FoundError = no,
+ Goal = Goal0,
% If we have foreign clauses, we should only
% add this clause for modes *not* covered by the
% foreign clauses.
- { HasForeignClauses = yes ->
+ ( HasForeignClauses = yes ->
ForeignModeIds = list__condense(list__filter_map(
(func(C) = ProcIds is semidet :-
C = clause(ProcIds, _, ClauseLang, _),
@@ -6063,12 +5859,12 @@
% XXX we should avoid append - this gives O(N*N)
list__append(ClauseList0, [clause(ModeIds0, Goal,
mercury, Context)], ClauseList)
- },
- { qual_info_get_var_types(Info, ExplicitVarTypes) },
- { ClausesInfo = clauses_info(VarSet, ExplicitVarTypes,
+ ),
+ qual_info_get_var_types(!.Info, ExplicitVarTypes),
+ !:ClausesInfo = clauses_info(VarSet, ExplicitVarTypes,
TVarNameMap, InferredVarTypes, HeadVars,
ClauseList, TI_VarMap, TCI_VarMap,
- HasForeignClauses) }
+ HasForeignClauses)
).
%-----------------------------------------------------------------------------
@@ -6079,7 +5875,6 @@
; split_add(int, clause)
; replace(int).
-
% Add the pragma_foreign_proc goal to the clauses_info for this procedure.
% To do so, we must also insert unifications between the variables in the
% pragma foreign_proc declaration and the head vars of the pred. Also
@@ -6110,7 +5905,6 @@
globals__io_get_globals(Globals),
globals__io_get_target(Target),
-
% We traverse the clauses, and decide which action to perform.
%
% If there are no clauses, we will simply add this clause.
@@ -6126,7 +5920,6 @@
% - remove the matching proc_id from its proc_id list,
% and add this clause as a new clause for this mode.
-
{ list__foldl2(
(pred(C::in, Action0::in, Action::out, N0::in, N::out) is det :-
C = clause(ProcIds, B, ClauseLang, D),
@@ -6179,8 +5972,6 @@
)
) },
-
-
globals__io_get_backend_foreign_languages(BackendForeignLanguages),
{
pragma_get_vars(PVars, Args0),
@@ -6281,53 +6072,36 @@
qual_info :: qual_info
).
-:- pred transform(prog_substitution, list(prog_var), list(prog_term), goal,
- prog_varset, prog_context, pred_or_func, arity, goal_type,
- hlds_goal, prog_varset, list(quant_warning),
- transform_info, transform_info,
- io__state, io__state).
-:- mode transform(in, in, in, in, in, in, in, in, in, out, out, out,
- in, out, di, uo) is det.
-
-transform(Subst, HeadVars, Args0, Body0, VarSet0, Context, PredOrFunc,
- Arity, GoalType, Goal, VarSet, Warnings, Info0, Info,
- IO0, IO) :-
+:- pred transform(prog_substitution::in, list(prog_var)::in,
+ list(prog_term)::in, goal::in, prog_context::in, pred_or_func::in,
+ arity::in, goal_type::in, hlds_goal::out,
+ prog_varset::in, prog_varset::out, list(quant_warning)::out,
+ transform_info::in, transform_info::out,
+ io__state::di, io__state::uo) is det.
+transform(Subst, HeadVars, Args0, Body0, Context, PredOrFunc, Arity, GoalType,
+ Goal, !VarSet, Warnings, !Info, !IO) :-
prepare_for_head(SInfo0),
-
term__apply_substitution_to_list(Args0, Subst, Args1),
-
- substitute_state_var_mappings(Args1, Args, VarSet0, VarSet1,
- SInfo0, SInfo1, IO0, IO1),
-
+ substitute_state_var_mappings(Args1, Args, !VarSet,
+ SInfo0, SInfo1, !IO),
hlds_goal__true_goal(Head0),
-
- ( if GoalType = promise(_) then
- VarSet2 = VarSet1,
+ ( GoalType = promise(_) ->
Head = Head0,
- Info1 = Info0,
- SInfo2 = SInfo1,
- IO2 = IO1
- else
+ SInfo2 = SInfo1
+ ;
ArgContext = head(PredOrFunc, Arity),
insert_arg_unifications(HeadVars, Args, Context, ArgContext,
- Head0, VarSet1, Head, VarSet2, Info0, Info1,
- SInfo1, SInfo2, IO1, IO2)
+ Head0, Head, !VarSet, !Info, SInfo1, SInfo2, !IO)
),
-
- prepare_for_body(FinalSVarMap, VarSet2, VarSet3, SInfo2, SInfo3),
-
- transform_goal(Body0, VarSet3, Subst, Body, VarSet4, Info1, Info2,
- SInfo3, SInfo, IO2, IO),
-
- finish_head_and_body(Context, FinalSVarMap, Head, Body, Goal0,
- SInfo),
-
- VarTypes2 = Info2 ^ qual_info ^ vartypes,
+ prepare_for_body(FinalSVarMap, !VarSet, SInfo2, SInfo3),
+ transform_goal(Body0, Subst, Body, !VarSet, !Info,
+ SInfo3, SInfo, !IO),
+ finish_head_and_body(Context, FinalSVarMap, Head, Body, Goal0, SInfo),
+ VarTypes0 = !.Info ^ qual_info ^ vartypes,
implicitly_quantify_clause_body(HeadVars, Warnings,
- Goal0, Goal, VarSet4, VarSet, VarTypes2, VarTypes),
-
- Info = Info2 ^ qual_info ^ vartypes := VarTypes.
+ Goal0, Goal, !VarSet, VarTypes0, VarTypes),
+ !:Info = !.Info ^ qual_info ^ vartypes := VarTypes.
%-----------------------------------------------------------------------------%
@@ -6339,151 +6113,126 @@
% And also at the same time, apply the given substitution to
% the goal, to rename it apart from the other clauses.
-:- pred transform_goal(goal, prog_varset, prog_substitution, hlds_goal,
- prog_varset, transform_info, transform_info,
- svar_info, svar_info, io__state, io__state).
-:- mode transform_goal(in, in, in, out, out, in, out, in, out, di, uo) is det.
-
-transform_goal(Goal0 - Context, VarSet0, Subst, Goal1 - GoalInfo1, VarSet,
- Info0, Info, SInfo0, SInfo) -->
- transform_goal_2(Goal0, Context, VarSet0, Subst, Goal1 - GoalInfo0,
- VarSet, Info0, Info, SInfo0, SInfo),
- { goal_info_set_context(GoalInfo0, Context, GoalInfo1) }.
-
-:- pred transform_goal_2(goal_expr, prog_context, prog_varset,
- prog_substitution, hlds_goal, prog_varset,
- transform_info, transform_info, svar_info, svar_info,
- io__state, io__state).
-:- mode transform_goal_2(in, in, in, in, out, out, in, out, in, out, di, uo)
- is det.
+:- pred transform_goal(goal::in, prog_substitution::in, hlds_goal::out,
+ prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
+
+transform_goal(Goal0 - Context, Subst, Goal1 - GoalInfo1, !VarSet,
+ !Info, !SInfo, !IO) :-
+ transform_goal_2(Goal0, Context, Subst, Goal1 - GoalInfo0,
+ !VarSet, !Info, !SInfo, !IO),
+ goal_info_set_context(GoalInfo0, Context, GoalInfo1).
+
+:- pred transform_goal_2(goal_expr::in, prog_context::in,
+ prog_substitution::in, hlds_goal::out,
+ prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
-transform_goal_2(fail, _, VarSet0, _, disj([]) - GoalInfo, VarSet,
- Info, Info, SInfo0, SInfo) -->
- { goal_info_init(GoalInfo) },
- { prepare_for_next_conjunct(set__init, VarSet0, VarSet,
- SInfo0, SInfo) }.
-
-transform_goal_2(true, _, VarSet0, _, conj([]) - GoalInfo, VarSet,
- Info, Info, SInfo0, SInfo) -->
- { goal_info_init(GoalInfo) },
- { prepare_for_next_conjunct(set__init, VarSet0, VarSet,
- SInfo0, SInfo) }.
+transform_goal_2(fail, _, _, disj([]) - GoalInfo, !VarSet, !Info, !SInfo,
+ !IO) :-
+ goal_info_init(GoalInfo),
+ prepare_for_next_conjunct(set__init, !VarSet, !SInfo).
+
+transform_goal_2(true, _, _, conj([]) - GoalInfo, !VarSet, !Info, !SInfo,
+ !IO) :-
+ goal_info_init(GoalInfo),
+ prepare_for_next_conjunct(set__init, !VarSet, !SInfo).
% Convert `all [Vars] Goal' into `not some [Vars] not Goal'.
-transform_goal_2(all(Vars0, Goal0), Context, VarSet0, Subst, Goal, VarSet,
- Info0, Info, SInfo0, SInfo) -->
- { TransformedGoal = not(some(Vars0, not(Goal0) - Context) - Context) },
- transform_goal_2(TransformedGoal, Context, VarSet0, Subst,
- Goal, VarSet, Info0, Info, SInfo0, SInfo).
+transform_goal_2(all(Vars0, Goal0), Context, Subst, Goal, !VarSet, !Info,
+ !SInfo, !IO) :-
+ TransformedGoal = not(some(Vars0, not(Goal0) - Context) - Context),
+ transform_goal_2(TransformedGoal, Context, Subst, Goal, !VarSet,
+ !Info, !SInfo, !IO).
-transform_goal_2(all_state_vars(StateVars, Goal0), Context, VarSet0, Subst,
- Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
+transform_goal_2(all_state_vars(StateVars, Goal0), Context, Subst,
+ Goal, !VarSet, !Info, !SInfo, !IO) :-
transform_goal_2(
not(some_state_vars(StateVars, not(Goal0) - Context) - Context),
- Context, VarSet0, Subst, Goal, VarSet,
- Info0, Info, SInfo0, SInfo).
+ Context, Subst, Goal, !VarSet, !Info, !SInfo, !IO).
-transform_goal_2(some(Vars0, Goal0), _, VarSet0, Subst,
+transform_goal_2(some(Vars0, Goal0), _, Subst,
some(Vars, can_remove, Goal) - GoalInfo,
- VarSet, Info0, Info, SInfo0, SInfo) -->
- { substitute_vars(Vars0, Subst, Vars) },
- transform_goal(Goal0, VarSet0, Subst, Goal, VarSet, Info0, Info,
- SInfo0, SInfo),
- { goal_info_init(GoalInfo) }.
+ !VarSet, !Info, !SInfo, !IO) :-
+ substitute_vars(Vars0, Subst, Vars),
+ transform_goal(Goal0, Subst, Goal, !VarSet, !Info, !SInfo, !IO),
+ goal_info_init(GoalInfo).
-transform_goal_2(some_state_vars(StateVars0, Goal0), _, VarSet0, Subst,
+transform_goal_2(some_state_vars(StateVars0, Goal0), _, Subst,
some(Vars, can_remove, Goal) - GoalInfo,
- VarSet, Info0, Info, SInfo0, SInfo) -->
- { substitute_vars(StateVars0, Subst, StateVars) },
- { prepare_for_local_state_vars(StateVars, VarSet0, VarSet1,
- SInfo0, SInfo1) },
- transform_goal(Goal0, VarSet1, Subst, Goal, VarSet, Info0, Info,
- SInfo1, SInfo2),
- { finish_local_state_vars(StateVars, Vars, SInfo0, SInfo2, SInfo) },
- { goal_info_init(GoalInfo) }.
-
-transform_goal_2(if_then_else(Vars0, StateVars0, A0, B0, C0), Context,
- VarSet0, Subst,
- if_then_else(Vars, A, B, C) - GoalInfo, VarSet,
- Info0, Info, SInfo0, SInfo) -->
-
- { substitute_vars(Vars0, Subst, Vars) },
- { substitute_vars(StateVars0, Subst, StateVars) },
-
- { prepare_for_if_then_else_goal(StateVars, VarSet0, VarSet1,
- SInfo0, SInfoA0) },
-
- transform_goal(A0, VarSet1, Subst, A, VarSet2, Info0, Info1,
- SInfoA0, SInfoA1),
-
- { finish_if_then_else_goal_condition(StateVars,
- SInfo0, SInfoA1, SInfoA, SInfoB0) },
-
- transform_goal(B0, VarSet2, Subst, B1, VarSet3, Info1, Info2,
- SInfoB0, SInfoB1),
-
- { finish_if_then_else_goal_then_goal(StateVars,
- SInfo0, SInfoB1, SInfoB) },
-
- transform_goal(C0, VarSet3, Subst, C1, VarSet4, Info2, Info,
- SInfo0, SInfoC),
-
- { goal_info_init(Context, GoalInfo) },
-
- { finish_if_then_else(Context, B1, B, C1, C,
- SInfo0, SInfoA, SInfoB, SInfoC, SInfo, VarSet4, VarSet) }.
-
-transform_goal_2(if_then(Vars0, StateVars, A0, B0), Context, Subst, VarSet0,
- Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
- transform_goal_2(if_then_else(Vars0, StateVars, A0, B0, true - Context),
- Context, Subst, VarSet0, Goal, VarSet, Info0, Info,
- SInfo0, SInfo).
-
-transform_goal_2(not(A0), _, VarSet0, Subst, Goal, VarSet, Info0, Info,
- SInfo0, SInfo) -->
- transform_goal(A0, VarSet0, Subst, A, VarSet, Info0, Info,
- SInfo0, SInfo1),
- { goal_info_init(GoalInfo) },
- { Goal = not(A) - GoalInfo },
- { finish_negation(SInfo0, SInfo1, SInfo) }.
-
-transform_goal_2((A0, B0), _, VarSet0, Subst, Goal, VarSet, Info0, Info,
- SInfo0, SInfo) -->
- get_rev_conj(A0, Subst, [], VarSet0, R0, VarSet1, Info0, Info1,
- SInfo0, SInfo1),
- get_rev_conj(B0, Subst, R0, VarSet1, R, VarSet, Info1, Info,
- SInfo1, SInfo),
- { L = list__reverse(R) },
- { goal_info_init(GoalInfo) },
- { conj_list_to_goal(L, GoalInfo, Goal) }.
-
-transform_goal_2((A0 & B0), _, VarSet0, Subst, Goal, VarSet, Info0, Info,
- SInfo0, SInfo) -->
- get_rev_par_conj(B0, Subst, [], VarSet0, R0, VarSet1, Info0, Info1,
- SInfo0, SInfo1),
- get_rev_par_conj(A0, Subst, R0, VarSet1, R, VarSet, Info1, Info,
- SInfo1, SInfo),
- { L = list__reverse(R) },
- { goal_info_init(GoalInfo) },
- { par_conj_list_to_goal(L, GoalInfo, Goal) }.
-
-transform_goal_2((A0 ; B0), Context, VarSet0, Subst, Goal, VarSet, Info0, Info,
- SInfo0, SInfo) -->
- get_disj(B0, Subst, [], VarSet0, L0, VarSet1, Info0, Info1, SInfo0),
- get_disj(A0, Subst, L0, VarSet1, L1, VarSet, Info1, Info, SInfo0),
- { finish_disjunction(Context, VarSet, L1, L, SInfo) },
- { goal_info_init(Context, GoalInfo) },
- { disj_list_to_goal(L, GoalInfo, Goal) }.
+ !VarSet, !Info, !SInfo, !IO) :-
+ BeforeSInfo = !.SInfo,
+ substitute_vars(StateVars0, Subst, StateVars),
+ prepare_for_local_state_vars(StateVars, !VarSet, !SInfo),
+ transform_goal(Goal0, Subst, Goal, !VarSet, !Info, !SInfo, !IO),
+ finish_local_state_vars(StateVars, Vars, BeforeSInfo, !SInfo),
+ goal_info_init(GoalInfo).
+
+transform_goal_2(if_then_else(Vars0, StateVars0, Cond0, Then0, Else0), Context,
+ Subst, if_then_else(Vars, Cond, Then, Else) - GoalInfo,
+ !VarSet, !Info, !SInfo, !IO) :-
+ BeforeSInfo = !.SInfo,
+ substitute_vars(Vars0, Subst, Vars),
+ substitute_vars(StateVars0, Subst, StateVars),
+ prepare_for_if_then_else_goal(StateVars, !VarSet, !SInfo),
+ transform_goal(Cond0, Subst, Cond, !VarSet, !Info, !SInfo, !IO),
+ finish_if_then_else_goal_condition(StateVars,
+ BeforeSInfo, !.SInfo, AfterCondSInfo, !:SInfo),
+ transform_goal(Then0, Subst, Then1, !VarSet, !Info, !SInfo, !IO),
+ finish_if_then_else_goal_then_goal(StateVars, BeforeSInfo, !SInfo),
+ AfterThenSInfo = !.SInfo,
+ transform_goal(Else0, Subst, Else1, !VarSet, !Info,
+ BeforeSInfo, !:SInfo, !IO),
+ goal_info_init(Context, GoalInfo),
+ finish_if_then_else(Context, Then1, Then, Else1, Else,
+ BeforeSInfo, AfterCondSInfo, AfterThenSInfo, !SInfo, !VarSet).
+
+transform_goal_2(if_then(Vars0, StateVars, A0, B0), Context, Subst,
+ Goal, !VarSet, !Info, !SInfo, !IO) :-
+ transform_goal_2(
+ if_then_else(Vars0, StateVars, A0, B0, true - Context),
+ Context, Subst, Goal, !VarSet, !Info, !SInfo, !IO).
+
+transform_goal_2(not(A0), _, Subst, Goal, !VarSet, !Info, !SInfo, !IO) :-
+ BeforeSInfo = !.SInfo,
+ transform_goal(A0, Subst, A, !VarSet, !Info, !SInfo, !IO),
+ goal_info_init(GoalInfo),
+ Goal = not(A) - GoalInfo,
+ finish_negation(BeforeSInfo, !SInfo).
+
+transform_goal_2((A0, B0), _, Subst, Goal, !VarSet, !Info, !SInfo, !IO) :-
+ get_rev_conj(A0, Subst, [], R0, !VarSet, !Info, !SInfo, !IO),
+ get_rev_conj(B0, Subst, R0, R, !VarSet, !Info, !SInfo, !IO),
+ L = list__reverse(R),
+ goal_info_init(GoalInfo),
+ conj_list_to_goal(L, GoalInfo, Goal).
+
+transform_goal_2((A0 & B0), _, Subst, Goal, !VarSet, !Info, !SInfo, !IO) :-
+ get_rev_par_conj(B0, Subst, [], R0, !VarSet, !Info, !SInfo, !IO),
+ get_rev_par_conj(A0, Subst, R0, R, !VarSet, !Info, !SInfo, !IO),
+ L = list__reverse(R),
+ goal_info_init(GoalInfo),
+ par_conj_list_to_goal(L, GoalInfo, Goal).
+
+transform_goal_2((A0 ; B0), Context, Subst, Goal, !VarSet, !Info, !SInfo,
+ !IO) :-
+ get_disj(B0, Subst, [], L0, !VarSet, !Info, !.SInfo, !IO),
+ get_disj(A0, Subst, L0, L1, !VarSet, !Info, !.SInfo, !IO),
+ finish_disjunction(Context, !.VarSet, L1, L, !:SInfo),
+ goal_info_init(Context, GoalInfo),
+ disj_list_to_goal(L, GoalInfo, Goal).
-transform_goal_2(implies(P, Q), Context, VarSet0, Subst, Goal, VarSet,
- Info0, Info, SInfo0, SInfo) -->
+transform_goal_2(implies(P, Q), Context, Subst, Goal, !VarSet, !Info, !SInfo,
+ !IO) :-
% `P => Q' is defined as `not (P, not Q)'
- { TransformedGoal = not( (P, not(Q) - Context) - Context ) },
- transform_goal_2(TransformedGoal, Context, VarSet0, Subst,
- Goal, VarSet, Info0, Info, SInfo0, SInfo).
+ TransformedGoal = not( (P, not(Q) - Context) - Context ),
+ transform_goal_2(TransformedGoal, Context, Subst, Goal, !VarSet,
+ !Info, !SInfo, !IO).
-transform_goal_2(equivalent(P0, Q0), _, VarSet0, Subst, Goal, VarSet,
- Info0, Info, SInfo0, SInfo) -->
+transform_goal_2(equivalent(P0, Q0), _, Subst, Goal, !VarSet, !Info, !SInfo,
+ !IO) :-
%
% `P <=> Q' is defined as `(P => Q), (Q => P)',
% but that transformation must not be done until
@@ -6491,82 +6240,77 @@
% the goals concerned affect the implicit quantification
% of the variables inside them.
%
- { goal_info_init(GoalInfo) },
- transform_goal(P0, VarSet0, Subst, P, VarSet1, Info0, Info1,
- SInfo0, SInfo1),
- transform_goal(Q0, VarSet1, Subst, Q, VarSet, Info1, Info,
- SInfo1, SInfo2),
- { Goal = shorthand(bi_implication(P, Q)) - GoalInfo },
- { finish_equivalence(SInfo0, SInfo2, SInfo) }.
-
-transform_goal_2(call(Name, Args0, Purity), Context, VarSet0, Subst, Goal,
- VarSet, Info0, Info, SInfo0, SInfo) -->
- { Args1 = expand_bang_state_var_args(Args0) },
+ BeforeSInfo = !.SInfo,
+ goal_info_init(GoalInfo),
+ transform_goal(P0, Subst, P, !VarSet, !Info, !SInfo, !IO),
+ transform_goal(Q0, Subst, Q, !VarSet, !Info, !SInfo, !IO),
+ Goal = shorthand(bi_implication(P, Q)) - GoalInfo,
+ finish_equivalence(BeforeSInfo, !SInfo).
+
+transform_goal_2(call(Name, Args0, Purity), Context, Subst, Goal, !VarSet,
+ !Info, !SInfo, !IO) :-
+ Args1 = expand_bang_state_var_args(Args0),
(
- { Name = unqualified("\\=") },
- { Args1 = [LHS, RHS] }
+ Name = unqualified("\\="),
+ Args1 = [LHS, RHS]
->
- { prepare_for_call(SInfo0, SInfo1) },
+ prepare_for_call(!SInfo),
% `LHS \= RHS' is defined as `not (LHS = RHS)'
transform_goal_2(not(unify(LHS, RHS, Purity) - Context),
- Context, VarSet0, Subst, Goal, VarSetX, Info0, Info,
- SInfo1, SInfoX),
- { finish_call(VarSetX, VarSet, SInfoX, SInfo) }
+ Context, Subst, Goal, !VarSet, !Info, !SInfo, !IO),
+ finish_call(!VarSet, !SInfo)
;
% check for a DCG field access goal:
% get: Field =^ field
% set: ^ field := Field
- { Name = unqualified(Operator) },
- ( { Operator = "=^" }
- ; { Operator = ":=" }
+ ( Name = unqualified(Operator) ),
+ ( Operator = "=^"
+ ; Operator = ":="
)
->
- { prepare_for_call(SInfo0, SInfo1) },
- { term__apply_substitution_to_list(Args1, Subst, Args2) },
+ prepare_for_call(!SInfo),
+ term__apply_substitution_to_list(Args1, Subst, Args2),
transform_dcg_record_syntax(Operator, Args2, Context,
- VarSet0, Goal, VarSetX, Info0, Info, SInfo1, SInfoX),
- { finish_call(VarSetX, VarSet, SInfoX, SInfo) }
+ Goal, !VarSet, !Info, !SInfo, !IO),
+ finish_call(!VarSet, !SInfo)
;
% check for an Aditi builtin
- { Purity = pure },
- { Name = unqualified(Name1) },
- { Name1 = "aditi_insert"
+ Purity = pure,
+ Name = unqualified(Name1),
+ ( Name1 = "aditi_insert"
; Name1 = "aditi_delete"
; Name1 = "aditi_bulk_insert"
; Name1 = "aditi_bulk_delete"
; Name1 = "aditi_bulk_modify"
- }
+ )
->
- { term__apply_substitution_to_list(Args1, Subst, Args2) },
- transform_aditi_builtin(Name1, Args2, Context, VarSet0,
- Goal, VarSet, Info0, Info, SInfo0, SInfo)
- ;
- { prepare_for_call(SInfo0, SInfo1) },
- { term__apply_substitution_to_list(Args1, Subst, Args) },
- { make_fresh_arg_vars(Args, VarSet0, HeadVars, VarSet1) },
- { list__length(Args, Arity) },
+ term__apply_substitution_to_list(Args1, Subst, Args2),
+ transform_aditi_builtin(Name1, Args2, Context, Goal,
+ !VarSet, !Info, !SInfo, !IO)
+ ;
+ prepare_for_call(!SInfo),
+ term__apply_substitution_to_list(Args1, Subst, Args),
+ make_fresh_arg_vars(Args, HeadVars, !VarSet),
+ list__length(Args, Arity),
(
% check for a higher-order call,
% i.e. a call to either call/N or ''/N.
- { Name = unqualified("call")
+ ( Name = unqualified("call")
; Name = unqualified("")
- },
- { HeadVars = [PredVar | RealHeadVars] }
+ ),
+ HeadVars = [PredVar | RealHeadVars]
->
- {
% initialize some fields to junk
Modes = [],
Det = erroneous,
GenericCall = higher_order(PredVar, Purity,
predicate, Arity),
- Call = generic_call(GenericCall,
- RealHeadVars, Modes, Det),
+ Call = generic_call(GenericCall, RealHeadVars,
+ Modes, Det),
hlds_goal__generic_call_id(GenericCall, CallId)
- }
;
- {
% initialize some fields to junk
PredId = invalid_pred_id,
ModeId = invalid_proc_id,
@@ -6575,77 +6319,63 @@
Call = call(PredId, ModeId, HeadVars, not_builtin,
MaybeUnifyContext, Name),
CallId = call(predicate - Name/Arity)
- }
),
- { goal_info_init(Context, GoalInfo0) },
- { add_goal_info_purity_feature(GoalInfo0,
- Purity, GoalInfo) },
- { Goal0 = Call - GoalInfo },
+ goal_info_init(Context, GoalInfo0),
+ add_goal_info_purity_feature(GoalInfo0, Purity, GoalInfo),
+ Goal0 = Call - GoalInfo,
- { record_called_pred_or_func(predicate, Name, Arity,
- Info0, Info1) },
+ record_called_pred_or_func(predicate, Name, Arity, !Info),
insert_arg_unifications(HeadVars, Args, Context, call(CallId),
- Goal0, VarSet1, Goal, VarSetX, Info1, Info,
- SInfo1, SInfoX),
- { finish_call(VarSetX, VarSet, SInfoX, SInfo) }
+ Goal0, Goal, !VarSet, !Info, !SInfo, !IO),
+ finish_call(!VarSet, !SInfo)
).
-transform_goal_2(unify(A0, B0, Purity), Context, VarSet0, Subst, Goal, VarSet,
- Info0, Info, SInfo0, SInfo) -->
+transform_goal_2(unify(A0, B0, Purity), Context, Subst, Goal, !VarSet,
+ !Info, !SInfo, !IO) :-
% It is an error for the left or right hand side of a
% unification to be !X (it may be !.X or !:X, however).
%
- ( if { A0 = functor(atom("!"), [variable(StateVarA)], _) } then
- report_svar_unify_error(Context, VarSet0, StateVarA),
- { true_goal(Goal) },
- { VarSet = VarSet0 },
- { Info = Info0 },
- { SInfo = SInfo0 }
- else if { B0 = functor(atom("!"), [variable(StateVarB)], _) } then
- report_svar_unify_error(Context, VarSet0, StateVarB),
- { true_goal(Goal) },
- { VarSet = VarSet0 },
- { Info = Info0 },
- { SInfo = SInfo0 }
- else
- { prepare_for_call(SInfo0, SInfo1) },
- { term__apply_substitution(A0, Subst, A) },
- { term__apply_substitution(B0, Subst, B) },
+ ( A0 = functor(atom("!"), [variable(StateVarA)], _) ->
+ report_svar_unify_error(Context, !.VarSet, StateVarA, !IO),
+ true_goal(Goal)
+ ; B0 = functor(atom("!"), [variable(StateVarB)], _) ->
+ report_svar_unify_error(Context, !.VarSet, StateVarB, !IO),
+ true_goal(Goal)
+ ;
+ prepare_for_call(!SInfo),
+ term__apply_substitution(A0, Subst, A),
+ term__apply_substitution(B0, Subst, B),
unravel_unification(A, B, Context, explicit, [],
- VarSet0, Purity, Goal, VarSet1, Info0, Info,
- SInfo1, SInfo2),
- { finish_call(VarSet1, VarSet, SInfo2, SInfo) }
+ Purity, Goal, !VarSet, !Info, !SInfo, !IO),
+ finish_call(!VarSet, !SInfo)
).
+:- pred report_svar_unify_error(prog_context::in, prog_varset::in, svar::in,
+ io::di, io::uo) is det.
-:- pred report_svar_unify_error(prog_context, prog_varset, svar, io, io).
-:- mode report_svar_unify_error(in, in, in, di, uo) is det.
-
-report_svar_unify_error(Context, VarSet, StateVar) -->
- { Name = varset__lookup_name(VarSet, StateVar) },
- prog_out__write_context(Context),
+report_svar_unify_error(Context, VarSet, StateVar, !IO) :-
+ Name = varset__lookup_name(VarSet, StateVar),
+ prog_out__write_context(Context, !IO),
report_warning(string__format("\
-Error: !%s cannot appear as a unification argument.\n", [s(Name)])),
- prog_out__write_context(Context),
+Error: !%s cannot appear as a unification argument.\n", [s(Name)]), !IO),
+ prog_out__write_context(Context, !IO),
report_warning(string__format("\
- You probably meant !.%s or !:%s.\n", [s(Name), s(Name)])).
-
+You probably meant !.%s or !:%s.\n", [s(Name), s(Name)]), !IO).
:- inst dcg_record_syntax_op = bound("=^"; ":=").
-:- pred transform_dcg_record_syntax(string, list(prog_term), prog_context,
- prog_varset, hlds_goal, prog_varset, transform_info,
- transform_info, svar_info, svar_info, io__state, io__state).
-:- mode transform_dcg_record_syntax(in(dcg_record_syntax_op),
- in, in, in, out, out, in, out, in, out, di, uo) is det.
-
-transform_dcg_record_syntax(Operator, ArgTerms0, Context, VarSet0,
- Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
- { goal_info_init(Context, GoalInfo) },
+:- pred transform_dcg_record_syntax(string::in(dcg_record_syntax_op),
+ list(prog_term)::in, prog_context::in, hlds_goal::out,
+ prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
+
+transform_dcg_record_syntax(Operator, ArgTerms0, Context, Goal, !VarSet,
+ !Info, !SInfo, !IO) :-
+ goal_info_init(Context, GoalInfo),
+ (
+ ArgTerms0 = [LHSTerm, RHSTerm, TermInputTerm, TermOutputTerm],
(
- { ArgTerms0 = [LHSTerm, RHSTerm,
- TermInputTerm, TermOutputTerm] },
- {
Operator = "=^",
AccessType = get,
FieldNameTerm = RHSTerm,
@@ -6657,80 +6387,73 @@
[FieldNameTerm0], _),
FieldNameTerm = FieldNameTerm0,
FieldValueTerm = RHSTerm
- }
+ )
->
- { parse_field_list(FieldNameTerm, MaybeFieldNames) },
+ parse_field_list(FieldNameTerm, MaybeFieldNames),
(
- { MaybeFieldNames = ok(FieldNames) },
- { ArgTerms = [FieldValueTerm, TermInputTerm,
- TermOutputTerm] },
-
+ MaybeFieldNames = ok(FieldNames),
+ ArgTerms = [FieldValueTerm, TermInputTerm,
+ TermOutputTerm],
transform_dcg_record_syntax_2(AccessType,
- FieldNames, ArgTerms, Context, VarSet0,
- Goal, VarSet, Info0, Info, SInfo0, SInfo)
+ FieldNames, ArgTerms, Context, Goal,
+ !VarSet, !Info, !SInfo, !IO)
;
- { MaybeFieldNames = error(Msg, ErrorTerm) },
- { invalid_goal("^", ArgTerms0, GoalInfo,
- Goal, VarSet0, VarSet) },
- { qual_info_set_found_syntax_error(yes,
- Info0 ^ qual_info, QualInfo) },
- { Info = Info0 ^ qual_info := QualInfo },
- io__set_exit_status(1),
- prog_out__write_context(Context),
- io__write_string("In DCG field "),
+ MaybeFieldNames = error(Msg, ErrorTerm),
+ invalid_goal("^", ArgTerms0, GoalInfo, Goal, !VarSet),
+ qual_info_set_found_syntax_error(yes,
+ !.Info ^ qual_info, QualInfo),
+ !:Info = !.Info ^ qual_info := QualInfo,
+ io__set_exit_status(1, !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string("In DCG field ", !IO),
(
- { AccessType = set },
- io__write_string("update")
+ AccessType = set,
+ io__write_string("update", !IO)
;
- { AccessType = get },
- io__write_string("extraction")
+ AccessType = get,
+ io__write_string("extraction", !IO)
),
- io__write_string(" goal:\n"),
- prog_out__write_context(Context),
- io__write_string(" error: "),
- io__write_string(Msg),
- io__write_string(" at term `"),
- term_io__write_term(VarSet, ErrorTerm),
- io__write_string("'.\n"),
- { SInfo = SInfo0 }
- )
- ;
- { invalid_goal("^", ArgTerms0, GoalInfo,
- Goal, VarSet0, VarSet) },
- { qual_info_set_found_syntax_error(yes, Info0 ^ qual_info,
- QualInfo) },
- { Info = Info0 ^ qual_info := QualInfo },
- io__set_exit_status(1),
- prog_out__write_context(Context),
- io__write_string(
- "Error: expected `Field =^ field1 ^ ... ^ fieldN'\n"),
- prog_out__write_context(Context),
- io__write_string(" or `^ field1 ^ ... ^ fieldN := Field'.\n"),
- prog_out__write_context(Context),
- io__write_string(" in DCG field access goal.\n"),
- { SInfo = SInfo0 }
- ).
-
-:- pred transform_dcg_record_syntax_2(field_access_type,
- field_list, list(prog_term), prog_context,
- prog_varset, hlds_goal, prog_varset,
- transform_info, transform_info, svar_info, svar_info,
- io__state, io__state).
-:- mode transform_dcg_record_syntax_2(in, in, in, in, in, out, out,
- in, out, in, out, di, uo) is det.
+ io__write_string(" goal:\n", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" error: ", !IO),
+ io__write_string(Msg, !IO),
+ io__write_string(" at term `", !IO),
+ term_io__write_term(!.VarSet, ErrorTerm, !IO),
+ io__write_string("'.\n", !IO)
+ )
+ ;
+ invalid_goal("^", ArgTerms0, GoalInfo, Goal, !VarSet),
+ qual_info_set_found_syntax_error(yes, !.Info ^ qual_info,
+ QualInfo),
+ !:Info = !.Info ^ qual_info := QualInfo,
+ io__set_exit_status(1, !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string("Error: expected " ++
+ "`Field =^ field1 ^ ... ^ fieldN'\n", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" or `^ field1 ^ ... ^ fieldN := Field'.\n",
+ !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" in DCG field access goal.\n", !IO)
+ ).
+
+:- pred transform_dcg_record_syntax_2(field_access_type::in, field_list::in,
+ list(prog_term)::in, prog_context::in, hlds_goal::out,
+ prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
-transform_dcg_record_syntax_2(AccessType, FieldNames, ArgTerms, Context,
- VarSet0, Goal, VarSet, Info0, Info, SInfo0, SInfo, IO0, IO) :-
- make_fresh_arg_vars(ArgTerms, VarSet0, ArgVars, VarSet1),
+transform_dcg_record_syntax_2(AccessType, FieldNames, ArgTerms, Context, Goal,
+ !VarSet, !Info, !SInfo, !IO) :-
+ make_fresh_arg_vars(ArgTerms, ArgVars, !VarSet),
( ArgVars = [FieldValueVar, TermInputVar, TermOutputVar] ->
(
AccessType = set,
expand_set_field_function_call(Context, explicit, [],
FieldNames, FieldValueVar, TermInputVar,
- TermOutputVar, VarSet1, VarSet2, Functor,
+ TermOutputVar, !VarSet, Functor,
InnermostFunctor - InnermostSubContext, Goal0,
- Info0, Info1, SInfo0, SInfo1, IO0, IO1),
-
+ !Info, !SInfo, !IO),
FieldArgNumber = 2,
FieldArgContext = functor(InnermostFunctor, explicit,
@@ -6755,16 +6478,15 @@
OutputTermArgNumber - OutputTermArgContext
],
insert_arg_unifications_with_supplied_contexts(ArgVars,
- ArgTerms, ArgContexts, Context, Goal0,
- VarSet2, Goal, VarSet, Info1, Info,
- SInfo1, SInfo, IO1, IO)
+ ArgTerms, ArgContexts, Context, Goal0, Goal,
+ !VarSet, !Info, !SInfo, !IO)
;
AccessType = get,
expand_dcg_field_extraction_goal(Context, explicit,
[], FieldNames, FieldValueVar, TermInputVar,
- TermOutputVar, VarSet1, VarSet2, Functor,
+ TermOutputVar, !VarSet, Functor,
InnermostFunctor - _InnerSubContext, Goal0,
- Info0, Info1, SInfo0, SInfo1, IO0, IO1),
+ !Info, !SInfo, !IO),
InputTermArgNumber = 1,
InputTermArgContext = functor(Functor, explicit, []),
@@ -6788,9 +6510,8 @@
OutputTermArgNumber - OutputTermArgContext
],
insert_arg_unifications_with_supplied_contexts(ArgVars,
- ArgTerms, ArgContexts, Context, Goal0,
- VarSet2, Goal, VarSet, Info1, Info,
- SInfo1, SInfo, IO1, IO)
+ ArgTerms, ArgContexts, Context, Goal0, Goal,
+ !VarSet, !Info, !SInfo, !IO)
)
;
error("make_hlds__do_transform_dcg_record_syntax")
@@ -6806,91 +6527,81 @@
% V_3 = V_2 ^ ctors := Ctors,
% Term = Term0 ^ module_info := V_3.
%
-:- pred expand_set_field_function_call(prog_context,
- unify_main_context, unify_sub_contexts,
- field_list, prog_var, prog_var,
- prog_var, prog_varset, prog_varset, cons_id,
- pair(cons_id, unify_sub_contexts), hlds_goal,
- transform_info, transform_info, svar_info, svar_info,
- io__state, io__state).
-:- mode expand_set_field_function_call(in, in, in, in, in, in,
- in, in, out, out, out, out, in, out, in, out, di, uo) is det.
+:- pred expand_set_field_function_call(prog_context::in,
+ unify_main_context::in, unify_sub_contexts::in, field_list::in,
+ prog_var::in, prog_var::in, prog_var::in,
+ prog_varset::in, prog_varset::out, cons_id::out,
+ pair(cons_id, unify_sub_contexts)::out, hlds_goal::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
-expand_set_field_function_call(Context, MainContext, SubContext0,
- FieldNames, FieldValueVar, TermInputVar,
- TermOutputVar, VarSet0, VarSet,
- Functor, FieldSubContext, Goal, Info0, Info, SInfo0, SInfo) -->
+expand_set_field_function_call(Context, MainContext, SubContext0, FieldNames,
+ FieldValueVar, TermInputVar, TermOutputVar, !VarSet, Functor,
+ FieldSubContext, Goal, !Info, !SInfo, !IO) :-
expand_set_field_function_call_2(Context, MainContext,
SubContext0, FieldNames, FieldValueVar, TermInputVar,
- TermOutputVar, VarSet0, VarSet,
- Functor, FieldSubContext, Goals, Info0, Info, SInfo0, SInfo),
- { goal_info_init(Context, GoalInfo) },
- { conj_list_to_goal(Goals, GoalInfo, Goal) }.
-
-:- pred expand_set_field_function_call_2(prog_context,
- unify_main_context, unify_sub_contexts,
- field_list, prog_var, prog_var,
- prog_var, prog_varset, prog_varset, cons_id,
- pair(cons_id, unify_sub_contexts), list(hlds_goal),
- transform_info, transform_info, svar_info, svar_info,
- io__state, io__state).
-:- mode expand_set_field_function_call_2(in, in, in, in, in, in,
- in, in, out, out, out, out, in, out, in, out, di, uo) is det.
+ TermOutputVar, !VarSet, Functor, FieldSubContext, Goals,
+ !Info, !SInfo, !IO),
+ goal_info_init(Context, GoalInfo),
+ conj_list_to_goal(Goals, GoalInfo, Goal).
+
+:- pred expand_set_field_function_call_2(prog_context::in,
+ unify_main_context::in, unify_sub_contexts::in, field_list::in,
+ prog_var::in, prog_var::in, prog_var::in,
+ prog_varset::in, prog_varset::out, cons_id::out,
+ pair(cons_id, unify_sub_contexts)::out, list(hlds_goal)::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
expand_set_field_function_call_2(_, _, _, [], _, _, _, _, _, _, _, _, _, _,
- _, _) -->
- { error(
- "expand_set_field_function_call_2: empty list of field names") }.
+ _, _, !IO) :-
+ error("expand_set_field_function_call_2: empty list of field names").
expand_set_field_function_call_2(Context, MainContext, SubContext0,
[FieldName - FieldArgs | FieldNames], FieldValueVar,
- TermInputVar, TermOutputVar, VarSet0, VarSet, Functor,
- FieldSubContext, Goals, Info0, Info, SInfo0, SInfo) -->
- { make_fresh_arg_vars(FieldArgs, VarSet0, FieldArgVars, VarSet1) },
- ( { FieldNames = [_|_] } ->
- { varset__new_var(VarSet1, SubTermInputVar, VarSet2) },
- { varset__new_var(VarSet2, SubTermOutputVar, VarSet3) },
- { SetArgs = list__append(FieldArgVars,
- [TermInputVar, SubTermOutputVar]) },
- { construct_field_access_function_call(set, Context,
- MainContext, SubContext0, FieldName,
- TermOutputVar, SetArgs,
- Functor, UpdateGoal, Info0, Info1) },
+ TermInputVar, TermOutputVar, !VarSet, Functor,
+ FieldSubContext, Goals, !Info, !SInfo, !IO) :-
+ make_fresh_arg_vars(FieldArgs, FieldArgVars, !VarSet),
+ ( FieldNames = [_ | _] ->
+ varset__new_var(!.VarSet, SubTermInputVar, !:VarSet),
+ varset__new_var(!.VarSet, SubTermOutputVar, !:VarSet),
+ SetArgs = list__append(FieldArgVars,
+ [TermInputVar, SubTermOutputVar]),
+ construct_field_access_function_call(set, Context,
+ MainContext, SubContext0, FieldName, TermOutputVar,
+ SetArgs, Functor, UpdateGoal, !Info),
% extract the field containing the field to update.
- { construct_field_access_function_call(get, Context,
+ construct_field_access_function_call(get, Context,
MainContext, SubContext0, FieldName, SubTermInputVar,
list__append(FieldArgVars, [TermInputVar]), _,
- GetSubFieldGoal, Info1, Info2) },
+ GetSubFieldGoal, !Info),
% recursively update the field.
- { SubTermInputArgNumber = 2 + list__length(FieldArgs) },
- { TermInputContext = Functor - SubTermInputArgNumber },
- { SubContext = [TermInputContext | SubContext0] },
+ SubTermInputArgNumber = 2 + list__length(FieldArgs),
+ TermInputContext = Functor - SubTermInputArgNumber,
+ SubContext = [TermInputContext | SubContext0],
expand_set_field_function_call_2(Context, MainContext,
SubContext, FieldNames, FieldValueVar, SubTermInputVar,
- SubTermOutputVar, VarSet3, VarSet4, _,
- FieldSubContext, Goals0, Info2, Info3, SInfo0, SInfo1),
+ SubTermOutputVar, !VarSet, _, FieldSubContext, Goals0,
+ !Info, !SInfo, !IO),
- { list__append([GetSubFieldGoal | Goals0],
- [UpdateGoal], Goals1) }
+ list__append([GetSubFieldGoal | Goals0], [UpdateGoal], Goals1)
;
- { VarSet4 = VarSet1 },
- { SetArgs = list__append(FieldArgVars,
- [TermInputVar, FieldValueVar]) },
- { construct_field_access_function_call(set, Context,
+ SetArgs = list__append(FieldArgVars,
+ [TermInputVar, FieldValueVar]),
+ construct_field_access_function_call(set, Context,
MainContext, SubContext0, FieldName, TermOutputVar,
- SetArgs, Functor, Goal, Info0, Info3) },
- { FieldSubContext = Functor - SubContext0 },
- { Goals1 = [Goal] },
- { SInfo1 = SInfo0 }
+ SetArgs, Functor, Goal, !Info),
+ FieldSubContext = Functor - SubContext0,
+ Goals1 = [Goal]
),
- { ArgContext = functor(Functor, MainContext, SubContext0) },
- { goal_info_init(Context, GoalInfo) },
- { conj_list_to_goal(Goals1, GoalInfo, Conj0) },
+ ArgContext = functor(Functor, MainContext, SubContext0),
+ goal_info_init(Context, GoalInfo),
+ conj_list_to_goal(Goals1, GoalInfo, Conj0),
insert_arg_unifications(FieldArgVars, FieldArgs, Context, ArgContext,
- Conj0, VarSet4, Conj, VarSet, Info3, Info, SInfo1, SInfo),
- { goal_to_conj_list(Conj, Goals) }.
+ Conj0, Conj, !VarSet, !Info, !SInfo, !IO),
+ goal_to_conj_list(Conj, Goals).
% Expand a field extraction goal into a list of goals which
% each get one level of the structure.
@@ -6904,32 +6615,29 @@
% V_2 = V_1 ^ sub_info,
% ModuleName = V_2 ^ module_name.
%
-:- pred expand_dcg_field_extraction_goal(prog_context, unify_main_context,
- unify_sub_contexts, field_list, prog_var, prog_var,
- prog_var, prog_varset, prog_varset, cons_id,
- pair(cons_id, unify_sub_contexts), hlds_goal,
- transform_info, transform_info, svar_info, svar_info,
- io__state, io__state).
-:- mode expand_dcg_field_extraction_goal(in, in, in, in, in, in, in,
- in, out, out, out, out, in, out, in, out, di, uo) is det.
+:- pred expand_dcg_field_extraction_goal(prog_context::in,
+ unify_main_context::in, unify_sub_contexts::in, field_list::in,
+ prog_var::in, prog_var::in, prog_var::in,
+ prog_varset::in, prog_varset::out, cons_id::out,
+ pair(cons_id, unify_sub_contexts)::out, hlds_goal::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
expand_dcg_field_extraction_goal(Context, MainContext, SubContext,
FieldNames, FieldValueVar, TermInputVar, TermOutputVar,
- VarSet0, VarSet, Functor, FieldSubContext,
- Goal, Info0, Info, SInfo0, SInfo) -->
+ !VarSet, Functor, FieldSubContext, Goal, !Info, !SInfo, !IO) :-
% unify the DCG input and output variables
- { make_atomic_unification(TermOutputVar, var(TermInputVar),
- Context, MainContext, SubContext, UnifyDCG,
- Info0, Info1) },
+ make_atomic_unification(TermOutputVar, var(TermInputVar), Context,
+ MainContext, SubContext, UnifyDCG, !Info),
% process the access function as a get function on
% the output DCG variable
expand_get_field_function_call_2(Context, MainContext, SubContext,
- FieldNames, FieldValueVar, TermOutputVar, VarSet0, VarSet,
- Functor, FieldSubContext, Goals1, Info1, Info, SInfo0, SInfo),
- { Goals = [UnifyDCG | Goals1] },
- { goal_info_init(Context, GoalInfo) },
- { conj_list_to_goal(Goals, GoalInfo, Goal) }.
+ FieldNames, FieldValueVar, TermOutputVar, !VarSet,
+ Functor, FieldSubContext, Goals1, !Info, !SInfo, !IO),
+ Goals = [UnifyDCG | Goals1],
+ goal_info_init(Context, GoalInfo),
+ conj_list_to_goal(Goals, GoalInfo, Goal).
% Expand a field extraction function call into a list of goals which
% each get one level of the structure.
@@ -6941,95 +6649,84 @@
% V_2 = V_1 ^ sub_info,
% ModuleName = V_2 ^ module_name.
%
-:- pred expand_get_field_function_call(prog_context, unify_main_context,
- unify_sub_contexts, field_list, prog_var,
- prog_var, prog_varset, prog_varset, cons_id,
- pair(cons_id, unify_sub_contexts), hlds_goal,
- transform_info, transform_info, svar_info, svar_info,
- io__state, io__state).
-:- mode expand_get_field_function_call(in, in, in, in, in,
- in, in, out, out, out, out, in, out, in, out, di, uo) is det.
+:- pred expand_get_field_function_call(prog_context::in,
+ unify_main_context::in, unify_sub_contexts::in, field_list::in,
+ prog_var::in, prog_var::in, prog_varset::in, prog_varset::out,
+ cons_id::out, pair(cons_id, unify_sub_contexts)::out, hlds_goal::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
expand_get_field_function_call(Context, MainContext, SubContext0,
- FieldNames, FieldValueVar, TermInputVar, VarSet0, VarSet,
- Functor, FieldSubContext, Goal, Info0, Info, SInfo0, SInfo) -->
+ FieldNames, FieldValueVar, TermInputVar, !VarSet,
+ Functor, FieldSubContext, Goal, !Info, !SInfo, !IO) :-
expand_get_field_function_call_2(Context, MainContext, SubContext0,
- FieldNames, FieldValueVar, TermInputVar, VarSet0, VarSet,
- Functor, FieldSubContext, Goals, Info0, Info, SInfo0, SInfo),
- { goal_info_init(Context, GoalInfo) },
- { conj_list_to_goal(Goals, GoalInfo, Goal) }.
-
-:- pred expand_get_field_function_call_2(prog_context, unify_main_context,
- unify_sub_contexts, field_list, prog_var,
- prog_var, prog_varset, prog_varset, cons_id,
- pair(cons_id, unify_sub_contexts), list(hlds_goal),
- transform_info, transform_info, svar_info, svar_info,
- io__state, io__state).
-:- mode expand_get_field_function_call_2(in, in, in, in, in,
- in, in, out, out, out, out, in, out, in, out, di, uo) is det.
+ FieldNames, FieldValueVar, TermInputVar, !VarSet,
+ Functor, FieldSubContext, Goals, !Info, !SInfo, !IO),
+ goal_info_init(Context, GoalInfo),
+ conj_list_to_goal(Goals, GoalInfo, Goal).
+
+:- pred expand_get_field_function_call_2(prog_context::in,
+ unify_main_context::in, unify_sub_contexts::in, field_list::in,
+ prog_var::in, prog_var::in, prog_varset::in, prog_varset::out,
+ cons_id::out, pair(cons_id, unify_sub_contexts)::out,
+ list(hlds_goal)::out, transform_info::in, transform_info::out,
+ svar_info::in, svar_info::out, io__state::di, io__state::uo) is det.
expand_get_field_function_call_2(_, _, _, [], _, _, _, _, _, _, _, _, _,
- _, _) -->
- { error(
- "expand_get_field_function_call_2: empty list of field names") }.
+ _, _, !IO) :-
+ error("expand_get_field_function_call_2: empty list of field names").
expand_get_field_function_call_2(Context, MainContext, SubContext0,
[FieldName - FieldArgs | FieldNames], FieldValueVar,
- TermInputVar, VarSet0, VarSet, Functor,
- FieldSubContext, Goals, Info0, Info, SInfo0, SInfo) -->
- { make_fresh_arg_vars(FieldArgs, VarSet0, FieldArgVars, VarSet1) },
- { GetArgVars = list__append(FieldArgVars, [TermInputVar]) },
- ( { FieldNames = [_|_] } ->
- { varset__new_var(VarSet1, SubTermInputVar, VarSet2) },
- { construct_field_access_function_call(get, Context,
+ TermInputVar, !VarSet, Functor, FieldSubContext, Goals,
+ !Info, !SInfo, !IO) :-
+ make_fresh_arg_vars(FieldArgs, FieldArgVars, !VarSet),
+ GetArgVars = list__append(FieldArgVars, [TermInputVar]),
+ ( FieldNames = [_ | _] ->
+ varset__new_var(!.VarSet, SubTermInputVar, !:VarSet),
+ construct_field_access_function_call(get, Context,
MainContext, SubContext0, FieldName, SubTermInputVar,
- GetArgVars, Functor, Goal, Info0, Info1) },
+ GetArgVars, Functor, Goal, !Info),
% recursively extract until we run out of field names
- { TermInputArgNumber = 1 + list__length(FieldArgVars) },
- { TermInputContext = Functor - TermInputArgNumber },
- { SubContext = [TermInputContext | SubContext0] },
+ TermInputArgNumber = 1 + list__length(FieldArgVars),
+ TermInputContext = Functor - TermInputArgNumber,
+ SubContext = [TermInputContext | SubContext0],
expand_get_field_function_call_2(Context, MainContext,
SubContext, FieldNames, FieldValueVar, SubTermInputVar,
- VarSet2, VarSet3, _, FieldSubContext,
- Goals1, Info1, Info2, SInfo0, SInfo1),
- { Goals2 = [Goal | Goals1] }
- ;
- { VarSet3 = VarSet1 },
- { FieldSubContext = Functor - SubContext0 },
- { construct_field_access_function_call(get, Context,
+ !VarSet, _, FieldSubContext, Goals1, !Info, !SInfo,
+ !IO),
+ Goals2 = [Goal | Goals1]
+ ;
+ FieldSubContext = Functor - SubContext0,
+ construct_field_access_function_call(get, Context,
MainContext, SubContext0, FieldName, FieldValueVar,
- GetArgVars, Functor, Goal, Info0, Info2) },
- { Goals2 = [Goal] },
- { SInfo1 = SInfo0 }
- ),
- { ArgContext = functor(Functor, MainContext, SubContext0) },
- { goal_info_init(Context, GoalInfo) },
- { conj_list_to_goal(Goals2, GoalInfo, Conj0) },
+ GetArgVars, Functor, Goal, !Info),
+ Goals2 = [Goal]
+ ),
+ ArgContext = functor(Functor, MainContext, SubContext0),
+ goal_info_init(Context, GoalInfo),
+ conj_list_to_goal(Goals2, GoalInfo, Conj0),
insert_arg_unifications(FieldArgVars, FieldArgs, Context, ArgContext,
- Conj0, VarSet3, Conj, VarSet, Info2, Info, SInfo1, SInfo),
- { goal_to_conj_list(Conj, Goals) }.
+ Conj0, Conj, !VarSet, !Info, !SInfo, !IO),
+ goal_to_conj_list(Conj, Goals).
-:- pred construct_field_access_function_call(field_access_type, prog_context,
- unify_main_context, unify_sub_contexts, ctor_field_name,
- prog_var, list(prog_var), cons_id, hlds_goal,
- transform_info, transform_info).
-:- mode construct_field_access_function_call(in, in, in, in, in,
- in, in, out, out, in, out) is det.
+:- pred construct_field_access_function_call(field_access_type::in,
+ prog_context::in, unify_main_context::in, unify_sub_contexts::in,
+ ctor_field_name::in, prog_var::in, list(prog_var)::in, cons_id::out,
+ hlds_goal::out, transform_info::in, transform_info::out) is det.
-construct_field_access_function_call(AccessType, Context,
- MainContext, SubContext, FieldName, RetArg, Args,
- Functor, Goal, Info0, Info) :-
+construct_field_access_function_call(AccessType, Context, MainContext,
+ SubContext, FieldName, RetArg, Args, Functor, Goal, !Info) :-
field_access_function_name(AccessType, FieldName, FuncName),
list__length(Args, Arity),
Functor = cons(FuncName, Arity),
make_atomic_unification(RetArg, functor(Functor, no, Args),
- Context, MainContext, SubContext, Goal, Info0, Info).
+ Context, MainContext, SubContext, Goal, !Info).
:- type field_list == assoc_list(ctor_field_name, list(prog_term)).
-:- pred parse_field_list(prog_term,
- maybe1(field_list, prog_var_type)).
-:- mode parse_field_list(in, out) is det.
+:- pred parse_field_list(prog_term::in,
+ maybe1(field_list, prog_var_type)::out) is det.
parse_field_list(Term, MaybeFieldNames) :-
(
@@ -7062,8 +6759,7 @@
->
MaybeFieldNames = ok([FieldName - Args])
;
- MaybeFieldNames = error("expected field name",
- Term)
+ MaybeFieldNames = error("expected field name", Term)
)
).
@@ -7079,49 +6775,44 @@
% See the "Aditi update syntax" section of the
% Mercury Language Reference Manual.
-:- pred transform_aditi_builtin(string, list(prog_term), prog_context,
- prog_varset, hlds_goal, prog_varset,
- transform_info, transform_info, svar_info, svar_info,
- io__state, io__state).
-:- mode transform_aditi_builtin(in(aditi_update_str), in, in,
- in, out, out, in, out, in, out, di, uo) is det.
+:- pred transform_aditi_builtin(string::in(aditi_update_str),
+ list(prog_term)::in, prog_context::in, hlds_goal::out,
+ prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
-transform_aditi_builtin(UpdateStr, Args0, Context, VarSet0,
- Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
+transform_aditi_builtin(UpdateStr, Args0, Context, Goal, !VarSet,
+ !Info, !SInfo, !IO) :-
(
- { UpdateStr = "aditi_insert", Update = insert
+ ( UpdateStr = "aditi_insert", Update = insert
; UpdateStr = "aditi_delete", Update = delete
- }
+ )
->
- transform_aditi_tuple_update(UpdateStr, Update,
- Args0, Context, VarSet0, Goal,
- VarSet, Info0, Info, SInfo0, SInfo)
+ transform_aditi_tuple_update(UpdateStr, Update, Args0,
+ Context, Goal, !VarSet, !Info, !SInfo, !IO)
;
- { UpdateStr = "aditi_bulk_insert", Update = bulk_insert
+ ( UpdateStr = "aditi_bulk_insert", Update = bulk_insert
; UpdateStr = "aditi_bulk_delete", Update = bulk_delete
; UpdateStr = "aditi_bulk_modify", Update = bulk_modify
- }
+ )
->
- transform_aditi_bulk_update(UpdateStr,
- Update, Args0, Context, VarSet0, Goal,
- VarSet, Info0, Info, SInfo0, SInfo)
+ transform_aditi_bulk_update(UpdateStr, Update, Args0,
+ Context, Goal, !VarSet, !Info, !SInfo, !IO)
;
- { error("transform_aditi_builtin") }
+ error("transform_aditi_builtin")
).
-:- pred transform_aditi_tuple_update(string, aditi_tuple_update,
- list(prog_term), prog_context,
- prog_varset, hlds_goal, prog_varset,
- transform_info, transform_info, svar_info, svar_info,
- io__state, io__state).
-:- mode transform_aditi_tuple_update(in, in, in, in,
- in, out, out, in, out, in, out, di, uo) is det.
+:- pred transform_aditi_tuple_update(string::in, aditi_tuple_update::in,
+ list(prog_term)::in, prog_context::in, hlds_goal::out,
+ prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
transform_aditi_tuple_update(UpdateStr, Update, Args0, Context,
- VarSet0, Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
+ Goal, !VarSet, !Info, !SInfo, !IO) :-
% Build an empty goal_info.
- { goal_info_init(Context, GoalInfo) },
+ goal_info_init(Context, GoalInfo),
%
% Syntax -
@@ -7129,13 +6820,12 @@
%
% `p(_DB, X, Y)' is the tuple to insert, not a higher-order term.
%
- ( { Args0 = [InsertTupleTerm, AditiState0Term, AditiStateTerm] } ->
+ ( Args0 = [InsertTupleTerm, AditiState0Term, AditiStateTerm] ->
(
% Parse the tuple to insert.
- { parse_pred_or_func_and_args(InsertTupleTerm,
- PredOrFunc, SymName, TupleArgTerms) }
+ parse_pred_or_func_and_args(InsertTupleTerm,
+ PredOrFunc, SymName, TupleArgTerms)
->
- {
%
% Make new variables for the arguments.
% The argument list of the `aditi_insert'
@@ -7143,11 +6833,11 @@
% to insert and the `aditi__state' arguments.
%
make_fresh_arg_var(AditiState0Term, AditiState0Var, [],
- VarSet0, VarSet1),
+ !VarSet),
make_fresh_arg_var(AditiStateTerm, AditiStateVar, [],
- VarSet1, VarSet2),
- make_fresh_arg_vars(TupleArgTerms, VarSet2,
- TupleArgVars, VarSet3),
+ !VarSet),
+ make_fresh_arg_vars(TupleArgTerms, TupleArgVars,
+ !VarSet),
list__append(TupleArgVars,
[AditiState0Var, AditiStateVar], AllArgs),
list__length(TupleArgVars, InsertArity),
@@ -7163,64 +6853,57 @@
InsertCallId)),
list__append(TupleArgTerms,
[AditiState0Term, AditiStateTerm],
- AllArgTerms)
- },
+ AllArgTerms),
- { record_called_pred_or_func(PredOrFunc, SymName,
- InsertArity, Info0, Info1) },
+ record_called_pred_or_func(PredOrFunc, SymName,
+ InsertArity, !Info),
insert_arg_unifications(AllArgs, AllArgTerms,
- Context, call(CallId), Goal0,
- VarSet3, Goal, VarSet, Info1, Info,
- SInfo0, SInfo)
- ;
- { invalid_goal(UpdateStr, Args0, GoalInfo,
- Goal, VarSet0, VarSet) },
- { qual_info_set_found_syntax_error(yes,
- Info0 ^ qual_info, QualInfo) },
- { Info = Info0 ^ qual_info := QualInfo },
- io__set_exit_status(1),
- prog_out__write_context(Context),
- io__write_string("Error: expected tuple to "),
- io__write(Update),
- io__write_string(" in `"),
- io__write_string(UpdateStr),
- io__write_string("'.\n"),
- { SInfo = SInfo0 }
- )
+ Context, call(CallId), Goal0, Goal,
+ !VarSet, !Info, !SInfo, !IO)
;
- { invalid_goal(UpdateStr, Args0, GoalInfo,
- Goal, VarSet0, VarSet) },
- { qual_info_set_found_syntax_error(yes, Info0 ^ qual_info,
- QualInfo) },
- { Info = Info0 ^ qual_info := QualInfo },
- { list__length(Args0, Arity) },
- aditi_update_arity_error(Context, UpdateStr, Arity, [3]),
- { SInfo = SInfo0 }
+ invalid_goal(UpdateStr, Args0, GoalInfo,
+ Goal, !VarSet),
+ qual_info_set_found_syntax_error(yes,
+ !.Info ^ qual_info, QualInfo),
+ !:Info = !.Info ^ qual_info := QualInfo,
+ io__set_exit_status(1, !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string("Error: expected tuple to ", !IO),
+ io__write(Update, !IO),
+ io__write_string(" in `", !IO),
+ io__write_string(UpdateStr, !IO),
+ io__write_string("'.\n", !IO)
+ )
+ ;
+ invalid_goal(UpdateStr, Args0, GoalInfo, Goal, !VarSet),
+ qual_info_set_found_syntax_error(yes, !.Info ^ qual_info,
+ QualInfo),
+ !:Info = !.Info ^ qual_info := QualInfo,
+ list__length(Args0, Arity),
+ aditi_update_arity_error(Context, UpdateStr, Arity, [3], !IO)
).
% Parse an `aditi_delete' or `aditi_modify' goal.
-:- pred transform_aditi_bulk_update(string,
- aditi_bulk_update, list(prog_term), prog_context,
- prog_varset, hlds_goal, prog_varset, transform_info,
- transform_info, svar_info, svar_info, io__state, io__state).
-:- mode transform_aditi_bulk_update(in, in, in, in, in, out, out,
- in, out, in, out, di, uo) is det.
-
-transform_aditi_bulk_update(Descr, Update, Args0, Context,
- VarSet0, UpdateGoal, VarSet, Info0, Info, SInfo0, SInfo) -->
- { goal_info_init(Context, GoalInfo) },
- (
- { list__length(Args0, Arity) },
- { Arity \= 3 },
- { Arity \= 4 }
- ->
- { invalid_goal(Descr, Args0, GoalInfo,
- UpdateGoal, VarSet0, VarSet) },
- { qual_info_set_found_syntax_error(yes, Info0 ^ qual_info,
- QualInfo) },
- { Info = Info0 ^ qual_info := QualInfo },
- aditi_update_arity_error(Context, Descr, Arity, [3, 4]),
- { SInfo = SInfo0 }
+:- pred transform_aditi_bulk_update(string::in, aditi_bulk_update::in,
+ list(prog_term)::in, prog_context::in, hlds_goal::out,
+ prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
+
+transform_aditi_bulk_update(Descr, Update, Args0, Context, UpdateGoal,
+ !VarSet, !Info, !SInfo, !IO) :-
+ goal_info_init(Context, GoalInfo),
+ (
+ list__length(Args0, Arity),
+ Arity \= 3,
+ Arity \= 4
+ ->
+ invalid_goal(Descr, Args0, GoalInfo,
+ UpdateGoal, !VarSet),
+ qual_info_set_found_syntax_error(yes, !.Info ^ qual_info,
+ QualInfo),
+ !:Info = !.Info ^ qual_info := QualInfo,
+ aditi_update_arity_error(Context, Descr, Arity, [3, 4], !IO)
;
%
% First syntax -
@@ -7231,9 +6914,9 @@
% aditi_modify((p(X0, Y0, _DB0) ==> p(X0, Y, _DB) :-
% X0 < 100, Y = Y0 + 1), DB0, DB).
%
- { Args0 = [HOTerm, AditiState0Term, AditiStateTerm] },
- { parse_rule_term(Context, HOTerm, HeadTerm, GoalTerm1) },
- {
+ Args0 = [HOTerm, AditiState0Term, AditiStateTerm],
+ parse_rule_term(Context, HOTerm, HeadTerm, GoalTerm1),
+ (
Update = bulk_insert,
parse_pred_or_func_and_args(HeadTerm,
PredOrFunc, SymName, HeadArgs1),
@@ -7254,7 +6937,7 @@
list__append(LeftHeadArgs, RightHeadArgs, HeadArgs1),
list__length(LeftHeadArgs, PredArity),
list__length(RightHeadArgs, PredArity)
- }
+ )
->
%
% This syntax is transformed into a construction of
@@ -7263,52 +6946,50 @@
% The transformed code is equivalent to the
% `sym_name_and_closure' syntax which is parsed below.
%
- { Syntax = pred_term },
+ Syntax = pred_term,
%
% Parse the modification goal as for a lambda expression.
%
- { make_fresh_arg_vars(HeadArgs1, VarSet0, HeadArgs, VarSet1) },
- { term__coerce(GoalTerm1, GoalTerm) },
- { parse_goal(GoalTerm, VarSet1, ParsedGoal, VarSet2) },
+ make_fresh_arg_vars(HeadArgs1, HeadArgs, !VarSet),
+ term__coerce(GoalTerm1, GoalTerm),
+ parse_goal(GoalTerm, ParsedGoal, !VarSet),
- { prepare_for_lambda(SInfo0, SInfo1) },
+ prepare_for_lambda(!SInfo),
- { hlds_goal__true_goal(PredHead0) },
- { ArgContext = head(PredOrFunc, PredArity) },
+ hlds_goal__true_goal(PredHead0),
+ ArgContext = head(PredOrFunc, PredArity),
insert_arg_unifications(HeadArgs, HeadArgs1, Context,
- ArgContext, PredHead0, VarSet2, PredHead, VarSet3,
- Info0, Info1, SInfo1, SInfo2),
+ ArgContext, PredHead0, PredHead, !VarSet,
+ !Info, !SInfo, !IO),
- { prepare_for_body(FinalSVarMap, VarSet3, VarSet4,
- SInfo2, SInfo3) },
+ prepare_for_body(FinalSVarMap, !VarSet, !SInfo),
- { map__init(Substitution) },
- transform_goal(ParsedGoal, VarSet4, Substitution,
- PredBody, VarSet5, Info1, Info2, SInfo3, SInfo4),
+ map__init(Substitution),
+ transform_goal(ParsedGoal, Substitution, PredBody,
+ !VarSet, !Info, !SInfo, !IO),
- { finish_head_and_body(Context, FinalSVarMap,
- PredHead, PredBody, PredGoal0, SInfo4) },
+ finish_head_and_body(Context, FinalSVarMap, PredHead, PredBody,
+ PredGoal0, !.SInfo),
% Quantification will reduce this down to
% the proper set of nonlocal arguments.
- { goal_util__goal_vars(PredGoal, LambdaGoalVars0) },
- { set__delete_list(LambdaGoalVars0,
- HeadArgs, LambdaGoalVars1) },
- { set__to_sorted_list(LambdaGoalVars1, LambdaNonLocals) },
- { aditi_bulk_update_goal_info(Update,
+ goal_util__goal_vars(PredGoal, LambdaGoalVars0),
+ set__delete_list(LambdaGoalVars0, HeadArgs, LambdaGoalVars1),
+ set__to_sorted_list(LambdaGoalVars1, LambdaNonLocals),
+ aditi_bulk_update_goal_info(Update,
PredOrFunc, SymName, PredArity, HeadArgs,
LambdaPredOrFunc, EvalMethod, LambdaModes,
- Detism, PredGoal0, PredGoal) },
- { ModifiedCallId = PredOrFunc - SymName/PredArity },
+ Detism, PredGoal0, PredGoal),
+ ModifiedCallId = PredOrFunc - SymName/PredArity,
- { PredId = invalid_pred_id },
- { Builtin = aditi_bulk_update(Update, PredId, Syntax) },
- { MainContext =
+ PredId = invalid_pred_id,
+ Builtin = aditi_bulk_update(Update, PredId, Syntax),
+ MainContext =
call(generic_call(
aditi_builtin(Builtin, ModifiedCallId)),
- 1) },
- { varset__new_var(VarSet5, LambdaVar, VarSet6) },
+ 1),
+ varset__new_var(!.VarSet, LambdaVar, !:VarSet),
% Tell purity.m to change the mode of the `aditi__state'
% arguments of the closure to `unused', to make sure
@@ -7318,27 +6999,26 @@
% The `aditi__state's are passed even though they are not
% used to make the arguments of the closure match the
% arguments of the relation being updated.
- { FixModes = modes_need_fixing },
+ FixModes = modes_need_fixing,
% Build the lambda expression for the modification condition.
- { make_atomic_unification(LambdaVar,
+ make_atomic_unification(LambdaVar,
lambda_goal((pure), LambdaPredOrFunc, EvalMethod,
FixModes, LambdaNonLocals,
HeadArgs, LambdaModes, Detism, PredGoal),
- Context, MainContext, [], LambdaConstruct,
- Info2, Info3) },
+ Context, MainContext, [], LambdaConstruct, !Info),
- { make_fresh_arg_var(AditiState0Term, AditiState0Var, [],
- VarSet6, VarSet7) },
- { make_fresh_arg_var(AditiStateTerm, AditiStateVar, [],
- VarSet7, VarSet8) },
- { AllArgs = [LambdaVar, AditiState0Var, AditiStateVar] },
+ make_fresh_arg_var(AditiState0Term, AditiState0Var, [],
+ !VarSet),
+ make_fresh_arg_var(AditiStateTerm, AditiStateVar, [],
+ !VarSet),
+ AllArgs = [LambdaVar, AditiState0Var, AditiStateVar],
% post_typecheck.m will fill this in.
- { GenericCallModes = [] },
+ GenericCallModes = [],
- { Call = generic_call(aditi_builtin(Builtin, ModifiedCallId),
- AllArgs, GenericCallModes, det) - GoalInfo },
+ Call = generic_call(aditi_builtin(Builtin, ModifiedCallId),
+ AllArgs, GenericCallModes, det) - GoalInfo,
%
% Wrap an explicit quantification around the goal to make
@@ -7347,19 +7027,19 @@
% Separating the goals would make optimization of the update
% using indexes more difficult.
%
- { UpdateConj = some([], cannot_remove,
- conj([LambdaConstruct, Call]) - GoalInfo) - GoalInfo },
+ UpdateConj = some([], cannot_remove,
+ conj([LambdaConstruct, Call]) - GoalInfo) - GoalInfo,
- { CallId = call(generic_call(
- aditi_builtin(Builtin, ModifiedCallId))) },
+ CallId = call(generic_call(
+ aditi_builtin(Builtin, ModifiedCallId))),
- { record_called_pred_or_func(PredOrFunc, SymName, PredArity,
- Info3, Info4) },
+ record_called_pred_or_func(PredOrFunc, SymName, PredArity,
+ !Info),
insert_arg_unifications(AllArgs,
[term__variable(LambdaVar), AditiState0Term,
AditiStateTerm],
Context, CallId, UpdateConj,
- VarSet8, UpdateGoal, VarSet, Info4, Info, SInfo4, SInfo)
+ UpdateGoal, !VarSet, !Info, !SInfo, !IO)
;
%
% Second syntax -
@@ -7369,44 +7049,42 @@
% The `pred_term' syntax parsed above is transformed
% into the equivalent of this syntax.
%
- { Args0 = [PredCallIdTerm | OtherArgs0] },
- { OtherArgs0 = [_, _, _] },
+ Args0 = [PredCallIdTerm | OtherArgs0],
+ OtherArgs0 = [_, _, _],
- { parse_pred_or_func_name_and_arity(PredCallIdTerm,
- PredOrFunc, SymName, Arity0) },
- { adjust_func_arity(PredOrFunc, Arity0, Arity) }
+ parse_pred_or_func_name_and_arity(PredCallIdTerm,
+ PredOrFunc, SymName, Arity0),
+ adjust_func_arity(PredOrFunc, Arity0, Arity)
->
- { Syntax = sym_name_and_closure },
+ Syntax = sym_name_and_closure,
- { make_fresh_arg_vars(OtherArgs0,
- VarSet0, OtherArgs, VarSet1) },
- { PredId = invalid_pred_id },
+ make_fresh_arg_vars(OtherArgs0,
+ OtherArgs, !VarSet),
+ PredId = invalid_pred_id,
- { Builtin = aditi_bulk_update(Update, PredId, Syntax) },
+ Builtin = aditi_bulk_update(Update, PredId, Syntax),
- { ModifiedCallId = PredOrFunc - SymName/Arity },
+ ModifiedCallId = PredOrFunc - SymName/Arity,
% post_typecheck.m will fill this in.
- { GenericCallModes = [] },
+ GenericCallModes = [],
- { Call = generic_call(aditi_builtin(Builtin, ModifiedCallId),
- OtherArgs, GenericCallModes, det) - GoalInfo },
- { CallId = call(generic_call(
- aditi_builtin(Builtin, ModifiedCallId))) },
- { record_called_pred_or_func(PredOrFunc, SymName, Arity,
- Info0, Info1) },
+ Call = generic_call(aditi_builtin(Builtin, ModifiedCallId),
+ OtherArgs, GenericCallModes, det) - GoalInfo,
+ CallId = call(generic_call(
+ aditi_builtin(Builtin, ModifiedCallId))),
+ record_called_pred_or_func(PredOrFunc, SymName, Arity,
+ !Info),
insert_arg_unifications(OtherArgs, OtherArgs0, Context, CallId,
- Call, VarSet1, UpdateGoal,
- VarSet, Info1, Info, SInfo0, SInfo)
+ Call, UpdateGoal, !VarSet, !Info, !SInfo, !IO)
;
- { invalid_goal(Descr, Args0, GoalInfo,
- UpdateGoal, VarSet0, VarSet) },
- { qual_info_set_found_syntax_error(yes, Info0 ^ qual_info,
- QualInfo) },
- { Info = Info0 ^ qual_info := QualInfo },
- io__set_exit_status(1),
- output_expected_aditi_update_syntax(Context, Update),
- { SInfo = SInfo0 }
+ invalid_goal(Descr, Args0, GoalInfo,
+ UpdateGoal, !VarSet),
+ qual_info_set_found_syntax_error(yes, !.Info ^ qual_info,
+ QualInfo),
+ !:Info = !.Info ^ qual_info := QualInfo,
+ io__set_exit_status(1, !IO),
+ output_expected_aditi_update_syntax(Context, Update, !IO)
).
:- pred aditi_bulk_update_goal_info(aditi_bulk_update,
@@ -7454,8 +7132,7 @@
% Modes for the arguments corresponding to
% the input tuple.
- list__duplicate(PredArity, OutMode,
- DeleteModes),
+ list__duplicate(PredArity, OutMode, DeleteModes),
% `Args' must have length `PredArity * 2',
% so this will always succeed.
@@ -7475,9 +7152,8 @@
list__duplicate(PredArity, OutMode, InsertModes),
list__append(DeleteModes, InsertModes, LambdaModes).
-:- pred conjoin_aditi_update_goal_with_call(pred_or_func, sym_name,
- list(prog_var), hlds_goal, hlds_goal).
-:- mode conjoin_aditi_update_goal_with_call(in, in, in, in, out) is det.
+:- pred conjoin_aditi_update_goal_with_call(pred_or_func::in, sym_name::in,
+ list(prog_var)::in, hlds_goal::in, hlds_goal::out) is det.
conjoin_aditi_update_goal_with_call(PredOrFunc, SymName, Args, Goal0, Goal) :-
PredId = invalid_pred_id,
@@ -7491,9 +7167,8 @@
Goal = conj([CallGoal, Goal0]) - GoalInfo.
-:- pred output_expected_aditi_update_syntax(prog_context,
- aditi_bulk_update, io__state, io__state).
-:- mode output_expected_aditi_update_syntax(in, in, di, uo) is det.
+:- pred output_expected_aditi_update_syntax(prog_context::in,
+ aditi_bulk_update::in, io__state::di, io__state::uo) is det.
output_expected_aditi_update_syntax(Context, bulk_insert) -->
output_insert_or_delete_expected_syntax(Context, "aditi_bulk_insert").
@@ -7508,16 +7183,13 @@
io__write_string(Name),
io__write_string("(\n"),
prog_out__write_context(Context),
- io__write_string(
- " (p(<Args0>) ==> p(<Args>) :- <Goal>),\n"),
+ io__write_string(" (p(<Args0>) ==> p(<Args>) :- <Goal>),\n"),
prog_out__write_context(Context),
- io__write_string(
- " DB0, DB)'\n"),
+ io__write_string( " DB0, DB)'\n"),
output_aditi_closure_syntax(Context, Name).
-:- pred output_insert_or_delete_expected_syntax(prog_context, string,
- io__state, io__state).
-:- mode output_insert_or_delete_expected_syntax(in, in, di, uo) is det.
+:- pred output_insert_or_delete_expected_syntax(prog_context::in, string::in,
+ io__state::di, io__state::uo) is det.
output_insert_or_delete_expected_syntax(Context, Name) -->
prog_out__write_context(Context),
@@ -7526,9 +7198,8 @@
io__write_string("((p(<Args>) :- <Goal>), DB0, DB)'\n"),
output_aditi_closure_syntax(Context, Name).
-:- pred output_aditi_closure_syntax(prog_context, string,
- io__state, io__state).
-:- mode output_aditi_closure_syntax(in, in, di, uo) is det.
+:- pred output_aditi_closure_syntax(prog_context::in, string::in,
+ io__state::di, io__state::uo) is det.
output_aditi_closure_syntax(Context, Name) -->
prog_out__write_context(Context),
@@ -7538,9 +7209,8 @@
% Report an error for an Aditi update with the wrong number
% of arguments.
-:- pred aditi_update_arity_error(prog_context, string, int, list(int),
- io__state, io__state).
-:- mode aditi_update_arity_error(in, in, in, in, di, uo) is det.
+:- pred aditi_update_arity_error(prog_context::in, string::in, int::in,
+ list(int)::in, io__state::di, io__state::uo) is det.
aditi_update_arity_error(Context, UpdateStr, Arity, ExpectedArities) -->
io__set_exit_status(1),
@@ -7556,12 +7226,11 @@
io__write_string("'.\n").
% Produce an invalid goal when parsing of an Aditi update fails.
-:- pred invalid_goal(string, list(prog_term), hlds_goal_info,
- hlds_goal, prog_varset, prog_varset).
-:- mode invalid_goal(in, in, in, out, in, out) is det.
+:- pred invalid_goal(string::in, list(prog_term)::in, hlds_goal_info::in,
+ hlds_goal::out, prog_varset::in, prog_varset::out) is det.
-invalid_goal(UpdateStr, Args0, GoalInfo, Goal, VarSet0, VarSet) :-
- make_fresh_arg_vars(Args0, VarSet0, HeadVars, VarSet),
+invalid_goal(UpdateStr, Args0, GoalInfo, Goal, !VarSet) :-
+ make_fresh_arg_vars(Args0, HeadVars, !VarSet),
MaybeUnifyContext = no,
Goal = call(invalid_pred_id, invalid_proc_id, HeadVars, not_builtin,
MaybeUnifyContext, unqualified(UpdateStr)) - GoalInfo.
@@ -7593,239 +7262,190 @@
unify_sub_contexts
).
-:- pred insert_arg_unifications(list(prog_var), list(prog_term),
- prog_context, arg_context, hlds_goal, prog_varset,
- hlds_goal, prog_varset, transform_info, transform_info,
- svar_info, svar_info, io__state, io__state).
-:- mode insert_arg_unifications(in, in, in, in, in, in, out,
- out, in, out, in, out, di, uo) is det.
+:- pred insert_arg_unifications(list(prog_var)::in, list(prog_term)::in,
+ prog_context::in, arg_context::in, hlds_goal::in, hlds_goal::out,
+ prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
insert_arg_unifications(HeadVars, Args0, Context, ArgContext,
- Goal0, VarSet0, Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
- ( { HeadVars = [] } ->
- { Goal = Goal0 },
- { VarSet = VarSet0 },
- { Info = Info0 },
- { SInfo = SInfo0 }
- ;
- { Goal0 = _ - GoalInfo0 },
- { goal_to_conj_list(Goal0, List0) },
- substitute_state_var_mappings(Args0, Args, VarSet0, VarSet1,
- SInfo0, SInfo1),
+ !Goal, !VarSet, !Info, !SInfo, !IO) :-
+ ( HeadVars = [] ->
+ true
+ ;
+ !.Goal = _ - GoalInfo0,
+ goal_to_conj_list(!.Goal, List0),
+ substitute_state_var_mappings(Args0, Args, !VarSet, !SInfo,
+ !IO),
insert_arg_unifications_2(HeadVars, Args, Context, ArgContext,
- 0, List0, VarSet1, List, VarSet,
- Info0, Info, SInfo1, SInfo),
- { goal_info_set_context(GoalInfo0, Context, GoalInfo) },
- { conj_list_to_goal(List, GoalInfo, Goal) }
+ 0, List0, List, !VarSet, !Info, !SInfo, !IO),
+ goal_info_set_context(GoalInfo0, Context, GoalInfo),
+ conj_list_to_goal(List, GoalInfo, !:Goal)
).
-:- pred insert_arg_unifications_2(list(prog_var), list(prog_term),
- prog_context, arg_context, int, list(hlds_goal),
- prog_varset, list(hlds_goal), prog_varset,
- transform_info, transform_info, svar_info, svar_info,
- io__state, io__state).
-:- mode insert_arg_unifications_2(in, in, in, in, in, in, in,
- out, out, in, out, in, out, di, uo) is det.
+:- pred insert_arg_unifications_2(list(prog_var)::in, list(prog_term)::in,
+ prog_context::in, arg_context::in, int::in,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
-insert_arg_unifications_2([], [_|_], _, _, _, _, _, _, _, _, _, _, _) -->
- { error("insert_arg_unifications_2: length mismatch") }.
-insert_arg_unifications_2([_|_], [], _, _, _, _, _, _, _, _, _, _, _) -->
- { error("insert_arg_unifications_2: length mismatch") }.
-insert_arg_unifications_2([], [], _, _, _, List, VarSet, List, VarSet,
- Info, Info, SInfo, SInfo) --> [].
-insert_arg_unifications_2([Var|Vars], [Arg|Args], Context, ArgContext,
- N0, List0, VarSet0, List, VarSet,
- Info0, Info, SInfo0, SInfo) -->
- { N1 = N0 + 1 },
- insert_arg_unification(Var, Arg, Context, ArgContext,
- N1, List0, VarSet0, List1, VarSet1, ArgUnifyConj,
- Info0, Info1, SInfo0, SInfo1),
- ( { ArgUnifyConj = [] } ->
- insert_arg_unifications_2(Vars, Args, Context, ArgContext,
- N1, List1, VarSet1, List, VarSet,
- Info1, Info, SInfo1, SInfo)
- ;
- insert_arg_unifications_2(Vars, Args, Context, ArgContext,
- N1, List1, VarSet1, List2, VarSet,
- Info1, Info, SInfo1, SInfo),
- { list__append(ArgUnifyConj, List2, List) }
- ).
-
-:- pred insert_arg_unifications_with_supplied_contexts(list(prog_var),
- list(prog_term), assoc_list(int, arg_context), prog_context,
- hlds_goal, prog_varset, hlds_goal, prog_varset,
- transform_info, transform_info, svar_info, svar_info,
- io__state, io__state).
-:- mode insert_arg_unifications_with_supplied_contexts(in, in, in, in, in,
- in, out, out, in, out, in, out, di, uo) is det.
+insert_arg_unifications_2([], [_|_], _, _, _, _, _, _, _, _, _, _, _, !IO) :-
+ error("insert_arg_unifications_2: length mismatch").
+insert_arg_unifications_2([_|_], [], _, _, _, _, _, _, _, _, _, _, _, !IO) :-
+ error("insert_arg_unifications_2: length mismatch").
+insert_arg_unifications_2([], [], _, _, _, !List, !VarSet, !Info, !SInfo, !IO).
+insert_arg_unifications_2([Var|Vars], [Arg|Args], Context, ArgContext, N0,
+ !List, !VarSet, !Info, !SInfo, !IO) :-
+ N1 = N0 + 1,
+ insert_arg_unification(Var, Arg, Context, ArgContext, N1,
+ !VarSet, ArgUnifyConj, !Info, !SInfo, !IO),
+ ( ArgUnifyConj = [] ->
+ insert_arg_unifications_2(Vars, Args, Context, ArgContext, N1,
+ !List, !VarSet, !Info, !SInfo, !IO)
+ ;
+ insert_arg_unifications_2(Vars, Args, Context, ArgContext, N1,
+ !List, !VarSet, !Info, !SInfo, !IO),
+ list__append(ArgUnifyConj, !.List, !:List)
+ ).
+
+:- pred insert_arg_unifications_with_supplied_contexts(list(prog_var)::in,
+ list(prog_term)::in, assoc_list(int, arg_context)::in, prog_context::in,
+ hlds_goal::in, hlds_goal::out, prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
-insert_arg_unifications_with_supplied_contexts(ArgVars,
- ArgTerms0, ArgContexts, Context, Goal0, VarSet0,
- Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
- ( { ArgVars = [] } ->
- { Goal = Goal0 },
- { VarSet = VarSet0 },
- { Info = Info0 },
- { SInfo = SInfo0 }
+insert_arg_unifications_with_supplied_contexts(ArgVars, ArgTerms0, ArgContexts,
+ Context, !Goal, !VarSet, !Info, !SInfo, !IO) :-
+ ( ArgVars = [] ->
+ true
;
- { Goal0 = _ - GoalInfo0 },
- { goal_to_conj_list(Goal0, GoalList0) },
+ !.Goal = _ - GoalInfo0,
+ goal_to_conj_list(!.Goal, GoalList0),
substitute_state_var_mappings(ArgTerms0, ArgTerms,
- VarSet0, VarSet1, SInfo0, SInfo1),
+ !VarSet, !SInfo, !IO),
insert_arg_unifications_with_supplied_contexts_2(ArgVars,
- ArgTerms, ArgContexts, Context, GoalList0,
- VarSet1, GoalList, VarSet, Info0, Info, SInfo1, SInfo),
- { goal_info_set_context(GoalInfo0, Context, GoalInfo) },
- { conj_list_to_goal(GoalList, GoalInfo, Goal) }
+ ArgTerms, ArgContexts, Context, GoalList0, GoalList,
+ !VarSet, !Info, !SInfo, !IO),
+ goal_info_set_context(GoalInfo0, Context, GoalInfo),
+ conj_list_to_goal(GoalList, GoalInfo, !:Goal)
).
-:- pred insert_arg_unifications_with_supplied_contexts_2(list(prog_var),
- list(prog_term), assoc_list(int, arg_context), prog_context,
- list(hlds_goal), prog_varset, list(hlds_goal), prog_varset,
- transform_info, transform_info, svar_info, svar_info,
- io__state, io__state).
-:- mode insert_arg_unifications_with_supplied_contexts_2(in, in, in, in, in,
- in, out, out, in, out, in, out, di, uo) is det.
+:- pred insert_arg_unifications_with_supplied_contexts_2(list(prog_var)::in,
+ list(prog_term)::in, assoc_list(int, arg_context)::in,
+ prog_context::in,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
insert_arg_unifications_with_supplied_contexts_2(Vars, Terms, ArgContexts,
- Context, List0, VarSet0, List, VarSet, Info0, Info,
- SInfo0, SInfo) -->
+ Context, !List, !VarSet, !Info, !SInfo, !IO) :-
(
- { Vars = [], Terms = [], ArgContexts = [] }
+ ( Vars = [], Terms = [], ArgContexts = [] )
->
- { List = List0 },
- { VarSet = VarSet0 },
- { Info = Info0 },
- { SInfo = SInfo0 }
- ;
- { Vars = [Var | Vars1] },
- { Terms = [Term | Terms1] },
- { ArgContexts = [ArgNumber - ArgContext | ArgContexts1] }
+ true
+ ;
+ Vars = [Var | Vars1],
+ Terms = [Term | Terms1],
+ ArgContexts = [ArgNumber - ArgContext | ArgContexts1]
->
insert_arg_unification(Var, Term, Context, ArgContext,
- ArgNumber, List0, VarSet0, List1, VarSet1,
- UnifyConj, Info0, Info1, SInfo0, SInfo1),
+ ArgNumber, !VarSet, UnifyConj, !Info, !SInfo, !IO),
insert_arg_unifications_with_supplied_contexts_2(Vars1, Terms1,
- ArgContexts1, Context, List1, VarSet1, List2, VarSet,
- Info1, Info, SInfo1, SInfo),
- { list__append(UnifyConj, List2, List) }
- ;
- { error("insert_arg_unifications_with_supplied_contexts") }
- ).
-
-:- pred insert_arg_unification(prog_var, prog_term,
- prog_context, arg_context, int,
- list(hlds_goal), prog_varset, list(hlds_goal), prog_varset,
- list(hlds_goal), transform_info, transform_info,
- svar_info, svar_info, io__state, io__state).
-:- mode insert_arg_unification(in, in, in, in, in,
- in, in, out, out, out, in, out, in, out, di, uo) is det.
-
-insert_arg_unification(Var, Arg, Context, ArgContext, N1,
- List0, VarSet0, List1, VarSet1, ArgUnifyConj,
- Info0, Info, SInfo0, SInfo) -->
- (
- { Arg = term__variable(Var) }
- ->
+ ArgContexts1, Context, !List, !VarSet, !Info, !SInfo,
+ !IO),
+ list__append(UnifyConj, !.List, !:List)
+ ;
+ error("insert_arg_unifications_with_supplied_contexts")
+ ).
+
+:- pred insert_arg_unification(prog_var::in, prog_term::in, prog_context::in,
+ arg_context::in, int::in, prog_varset::in, prog_varset::out,
+ list(hlds_goal)::out, transform_info::in, transform_info::out,
+ svar_info::in, svar_info::out, io__state::di, io__state::uo) is det.
+
+insert_arg_unification(Var, Arg, Context, ArgContext, N1, !VarSet,
+ ArgUnifyConj, !Info, !SInfo, !IO) :-
+ ( Arg = term__variable(Var) ->
% Skip unifications of the form `X = X'
- { VarSet1 = VarSet0 },
- { Info = Info0 },
- { ArgUnifyConj = [] },
- { List1 = List0 },
- { SInfo = SInfo0 }
+ ArgUnifyConj = []
;
- { arg_context_to_unify_context(ArgContext, N1,
- UnifyMainContext, UnifySubContext) },
+ arg_context_to_unify_context(ArgContext, N1,
+ UnifyMainContext, UnifySubContext),
unravel_unification(term__variable(Var), Arg,
Context, UnifyMainContext, UnifySubContext,
- VarSet0, pure, Goal, VarSet1, Info0, Info,
- SInfo0, SInfo),
- { goal_to_conj_list(Goal, ArgUnifyConj) },
- { List1 = List0 }
+ pure, Goal, !VarSet, !Info, !SInfo, !IO),
+ goal_to_conj_list(Goal, ArgUnifyConj)
).
% append_arg_unifications is the same as insert_arg_unifications,
% except that the unifications are added after the goal rather
% than before the goal.
-:- pred append_arg_unifications(list(prog_var), list(prog_term),
- prog_context, arg_context, hlds_goal, prog_varset, hlds_goal,
- prog_varset, transform_info, transform_info,
- svar_info, svar_info, io__state, io__state).
-:- mode append_arg_unifications(in, in, in, in, in, in,
- out, out, in, out, in, out, di, uo) is det.
-
-append_arg_unifications(HeadVars, Args0, Context, ArgContext, Goal0,
- VarSet0, Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
- ( { HeadVars = [] } ->
- { Goal = Goal0 },
- { VarSet = VarSet0 },
- { Info = Info0 },
- { SInfo = SInfo0 }
- ;
- { Goal0 = _ - GoalInfo },
- { goal_to_conj_list(Goal0, List0) },
- substitute_state_var_mappings(Args0, Args, VarSet0, VarSet1,
- SInfo0, SInfo1),
+:- pred append_arg_unifications(list(prog_var)::in, list(prog_term)::in,
+ prog_context::in, arg_context::in, hlds_goal::in, hlds_goal::out,
+ prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
+
+append_arg_unifications(HeadVars, Args0, Context, ArgContext, !Goal, !VarSet,
+ !Info, !SInfo, !IO) :-
+ ( HeadVars = [] ->
+ true
+ ;
+ !.Goal = _ - GoalInfo,
+ goal_to_conj_list(!.Goal, List0),
+ substitute_state_var_mappings(Args0, Args, !VarSet,
+ !SInfo, !IO),
append_arg_unifications_2(HeadVars, Args, Context, ArgContext,
- 0, List0, VarSet1, List, VarSet, Info0, Info,
- SInfo1, SInfo),
- { conj_list_to_goal(List, GoalInfo, Goal) }
- ).
-
-:- pred append_arg_unifications_2(list(prog_var), list(prog_term),
- prog_context, arg_context, int, list(hlds_goal), prog_varset,
- list(hlds_goal), prog_varset, transform_info, transform_info,
- svar_info, svar_info, io__state, io__state).
-:- mode append_arg_unifications_2(in, in, in, in, in, in, in,
- out, out, in, out, in, out, di, uo) is det.
-
-append_arg_unifications_2([], [_|_], _, _, _, _, _, _, _, _, _, _, _) -->
- { error("append_arg_unifications_2: length mismatch") }.
-append_arg_unifications_2([_|_], [], _, _, _, _, _, _, _, _, _, _, _) -->
- { error("append_arg_unifications_2: length mismatch") }.
-append_arg_unifications_2([], [], _, _, _, List, VarSet, List, VarSet,
- Info, Info, SInfo, SInfo) --> [].
+ 0, List0, List, !VarSet, !Info, !SInfo, !IO),
+ conj_list_to_goal(List, GoalInfo, !:Goal)
+ ).
+
+:- pred append_arg_unifications_2(list(prog_var)::in, list(prog_term)::in,
+ prog_context::in, arg_context::in, int::in,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
+
+append_arg_unifications_2([], [_|_], _, _, _, _, _, _, _, _, _, _, _, !IO) :-
+ error("append_arg_unifications_2: length mismatch").
+append_arg_unifications_2([_|_], [], _, _, _, _, _, _, _, _, _, _, _, !IO) :-
+ error("append_arg_unifications_2: length mismatch").
+append_arg_unifications_2([], [], _, _, _, !List, !VarSet, !Info, !SInfo, !IO).
append_arg_unifications_2([Var|Vars], [Arg|Args], Context, ArgContext, N0,
- List0, VarSet0, List, VarSet,
- Info0, Info, SInfo0, SInfo) -->
- { N1 = N0 + 1 },
- append_arg_unification(Var, Arg, Context, ArgContext,
- N1, ConjList, VarSet0, VarSet1,
- Info0, Info1, SInfo0, SInfo1),
- { list__append(List0, ConjList, List1) },
+ !List, !VarSet, !Info, !SInfo, !IO) :-
+ N1 = N0 + 1,
+ append_arg_unification(Var, Arg, Context, ArgContext, N1, ConjList,
+ !VarSet, !Info, !SInfo, !IO),
+ list__append(!.List, ConjList, !:List),
append_arg_unifications_2(Vars, Args, Context, ArgContext, N1,
- List1, VarSet1, List, VarSet,
- Info1, Info, SInfo1, SInfo).
+ !List, !VarSet, !Info, !SInfo, !IO).
-:- pred append_arg_unification(prog_var, prog_term, prog_context, arg_context,
- int, list(hlds_goal), prog_varset, prog_varset,
- transform_info, transform_info, svar_info, svar_info,
- io__state, io__state).
-:- mode append_arg_unification(in, in, in, in, in, out, in,
- out, in, out, in, out, di, uo) is det.
+:- pred append_arg_unification(prog_var::in, prog_term::in, prog_context::in,
+ arg_context::in, int::in, list(hlds_goal)::out,
+ prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
append_arg_unification(Var, Arg, Context, ArgContext, N1, ConjList,
- VarSet0, VarSet, Info0, Info, SInfo0, SInfo) -->
- ( { Arg = term__variable(Var) } ->
+ !VarSet, !Info, !SInfo, !IO) :-
+ ( Arg = term__variable(Var) ->
% skip unifications of the form `X = X'
- { Info = Info0 },
- { VarSet = VarSet0 },
- { ConjList = [] },
- { SInfo = SInfo0 }
+ ConjList = []
;
- { arg_context_to_unify_context(ArgContext, N1,
- UnifyMainContext, UnifySubContext) },
+ arg_context_to_unify_context(ArgContext, N1,
+ UnifyMainContext, UnifySubContext),
unravel_unification(term__variable(Var), Arg,
Context, UnifyMainContext, UnifySubContext,
- VarSet0, pure, Goal, VarSet, Info0, Info,
- SInfo0, SInfo),
- { goal_to_conj_list(Goal, ConjList) }
+ pure, Goal, !VarSet, !Info, !SInfo, !IO),
+ goal_to_conj_list(Goal, ConjList)
).
-:- pred arg_context_to_unify_context(arg_context, int,
- unify_main_context, unify_sub_contexts).
-:- mode arg_context_to_unify_context(in, in, out, out) is det.
+:- pred arg_context_to_unify_context(arg_context::in, int::in,
+ unify_main_context::out, unify_sub_contexts::out) is det.
arg_context_to_unify_context(head(PredOrFunc, Arity), ArgNum,
ArgContext, []) :-
@@ -7854,29 +7474,29 @@
% For efficiency, the list `Vars' is constructed backwards
% and then reversed to get the correct order.
-:- pred make_fresh_arg_vars(list(prog_term), prog_varset, list(prog_var),
- prog_varset).
-:- mode make_fresh_arg_vars(in, in, out, out) is det.
+:- pred make_fresh_arg_vars(list(prog_term)::in, list(prog_var)::out,
+ prog_varset::in, prog_varset::out) is det.
-make_fresh_arg_vars(Args, VarSet0, Vars, VarSet) :-
- make_fresh_arg_vars_2(Args, [], VarSet0, Vars1, VarSet),
+make_fresh_arg_vars(Args, Vars, !VarSet) :-
+ make_fresh_arg_vars_2(Args, [], Vars1, !VarSet),
list__reverse(Vars1, Vars).
-:- pred make_fresh_arg_vars_2(list(prog_term), list(prog_var), prog_varset,
- list(prog_var), prog_varset).
-:- mode make_fresh_arg_vars_2(in, in, in, out, out) is det.
-
-make_fresh_arg_vars_2([], Vars, VarSet, Vars, VarSet).
-make_fresh_arg_vars_2([Arg | Args], Vars0, VarSet0, Vars, VarSet) :-
- make_fresh_arg_var(Arg, Var, Vars0, VarSet0, VarSet1),
- make_fresh_arg_vars_2(Args, [Var | Vars0], VarSet1, Vars, VarSet).
+:- pred make_fresh_arg_vars_2(list(prog_term)::in, list(prog_var)::in,
+ list(prog_var)::out, prog_varset::in,prog_varset::out) is det.
-:- pred make_fresh_arg_var(prog_term, prog_var, list(prog_var),
- prog_varset, prog_varset).
-:- mode make_fresh_arg_var(in, out, in, in, out) is det.
+make_fresh_arg_vars_2([], Vars, Vars, !VarSet).
+make_fresh_arg_vars_2([Arg | Args], Vars0, Vars, !VarSet) :-
+ make_fresh_arg_var(Arg, Var, Vars0, !VarSet),
+ make_fresh_arg_vars_2(Args, [Var | Vars0], Vars, !VarSet).
+
+:- pred make_fresh_arg_var(prog_term::in, prog_var::out, list(prog_var)::in,
+ prog_varset::in, prog_varset::out) is det.
make_fresh_arg_var(Arg, Var, Vars0, VarSet0, VarSet) :-
- ( Arg = term__variable(ArgVar), \+ list__member(ArgVar, Vars0) ->
+ (
+ Arg = term__variable(ArgVar),
+ \+ list__member(ArgVar, Vars0)
+ ->
Var = ArgVar,
VarSet = VarSet0
;
@@ -7889,39 +7509,33 @@
% XXX We could do better on the error messages for
% lambda expressions and field extraction and update expressions.
%
-:- pred unravel_unification(prog_term, prog_term, prog_context,
- unify_main_context, unify_sub_contexts, prog_varset,
- purity, hlds_goal, prog_varset, transform_info, transform_info,
- svar_info, svar_info, io__state, io__state).
-:- mode unravel_unification(in, in, in, in, in, in, in, out, out,
- in, out, in, out, di, uo) is det.
+:- pred unravel_unification(prog_term::in, prog_term::in, prog_context::in,
+ unify_main_context::in, unify_sub_contexts::in, purity::in,
+ hlds_goal::out, prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out,
+ svar_info::in, svar_info::out, io__state::di, io__state::uo) is det.
unravel_unification(LHS0, RHS0, Context, MainContext, SubContext,
- VarSet0, Purity, Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
- substitute_state_var_mapping(LHS0, LHS,
- VarSet0, VarSet1, SInfo0, SInfo1),
- substitute_state_var_mapping(RHS0, RHS,
- VarSet1, VarSet2, SInfo1, SInfo2),
+ Purity, Goal, !VarSet, !Info, !SInfo, !IO) :-
+ substitute_state_var_mapping(LHS0, LHS, !VarSet, !SInfo, !IO),
+ substitute_state_var_mapping(RHS0, RHS, !VarSet, !SInfo, !IO),
unravel_unification_2(LHS, RHS, Context, MainContext, SubContext,
- VarSet2, Purity, Goal, VarSet, Info0, Info, SInfo2, SInfo).
-
+ Purity, Goal, !VarSet, !Info, !SInfo,!IO).
-:- pred unravel_unification_2(prog_term, prog_term, prog_context,
- unify_main_context, unify_sub_contexts, prog_varset,
- purity, hlds_goal, prog_varset, transform_info, transform_info,
- svar_info, svar_info, io__state, io__state).
-:- mode unravel_unification_2(in, in, in, in, in, in, in, out, out,
- in, out, in, out, di, uo) is det.
+:- pred unravel_unification_2(prog_term::in, prog_term::in, prog_context::in,
+ unify_main_context::in, unify_sub_contexts::in, purity::in,
+ hlds_goal::out, prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
% `X = Y' needs no unravelling.
unravel_unification_2(term__variable(X), term__variable(Y), Context,
- MainContext, SubContext, VarSet0, Purity, Goal, VarSet,
- Info0, Info, SInfo, SInfo) -->
- { make_atomic_unification(X, var(Y), Context, MainContext,
- SubContext, Goal, Info0, Info1) },
- check_expr_purity(Purity, Context, Info1, Info),
- { VarSet0 = VarSet }.
+ MainContext, SubContext, Purity, Goal, !VarSet, !Info, !SInfo,
+ !IO) :-
+ make_atomic_unification(X, var(Y), Context, MainContext,
+ SubContext, Goal, !Info),
+ check_expr_purity(Purity, Context, !Info, !IO).
% If we find a unification of the form
% X = f(A1, A2, A3)
@@ -7932,63 +7546,65 @@
% NewVar3 = A3.
% In the trivial case `X = c', no unravelling occurs.
-unravel_unification_2(term__variable(X), RHS,
- Context, MainContext, SubContext, VarSet0, Purity,
- Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
- { RHS = term__functor(F, Args1, FunctorContext) },
- substitute_state_var_mappings(Args1, Args, VarSet0, VarSet1,
- SInfo0, SInfo1),
+unravel_unification_2(term__variable(X), RHS, Context, MainContext, SubContext,
+ Purity, Goal, !VarSet, !Info, !SInfo, !IO) :-
+ RHS = term__functor(F, Args1, FunctorContext),
+ substitute_state_var_mappings(Args1, Args, !VarSet, !SInfo, !IO),
(
% Handle explicit type qualification.
- { F = term__atom("with_type") },
- { Args = [RVal, DeclType0] }
+ F = term__atom("with_type"),
+ Args = [RVal, DeclType0]
->
- { convert_type(DeclType0, DeclType) },
- { varset__coerce(VarSet1, DeclVarSet) },
+ convert_type(DeclType0, DeclType),
+ varset__coerce(!.VarSet, DeclVarSet),
process_type_qualification(X, DeclType, DeclVarSet,
- Context, Info0, Info1),
- unravel_unification(term__variable(X), RVal,
- Context, MainContext, SubContext, VarSet1,
- Purity, Goal, VarSet, Info1, Info, SInfo1, SInfo)
+ Context, !Info, !IO),
+ unravel_unification(term__variable(X), RVal, Context,
+ MainContext, SubContext, Purity, Goal,
+ !VarSet, !Info, !SInfo, !IO)
;
% Handle unification expressions.
- { F = term__atom("@") },
- { Args = [LVal, RVal] }
+ F = term__atom("@"),
+ Args = [LVal, RVal]
->
- unravel_unification(term__variable(X), LVal,
- Context, MainContext, SubContext,
- VarSet1, Purity, Goal1, VarSet2, Info0, Info1,
- SInfo1, SInfo2),
- unravel_unification(term__variable(X), RVal,
- Context, MainContext, SubContext,
- VarSet2, Purity, Goal2, VarSet, Info1, Info,
- SInfo2, SInfo),
- { goal_info_init(GoalInfo) },
- { goal_to_conj_list(Goal1, ConjList1) },
- { goal_to_conj_list(Goal2, ConjList2) },
- { list__append(ConjList1, ConjList2, ConjList) },
- { conj_list_to_goal(ConjList, GoalInfo, Goal) }
+ unravel_unification(term__variable(X), LVal, Context,
+ MainContext, SubContext, Purity, Goal1,
+ !VarSet, !Info, !SInfo, !IO),
+ unravel_unification(term__variable(X), RVal, Context,
+ MainContext, SubContext, Purity, Goal2,
+ !VarSet, !Info, !SInfo, !IO),
+ goal_info_init(GoalInfo),
+ goal_to_conj_list(Goal1, ConjList1),
+ goal_to_conj_list(Goal2, ConjList2),
+ list__append(ConjList1, ConjList2, ConjList),
+ conj_list_to_goal(ConjList, GoalInfo, Goal)
;
- {
+ (
% handle lambda expressions
parse_lambda_eval_method(RHS, EvalMethod0, RHS1),
RHS1 = term__functor(term__atom("lambda"), Args1, _),
Args1 = [LambdaExpressionTerm0, GoalTerm0],
- term__coerce(LambdaExpressionTerm0, LambdaExpressionTerm),
+ term__coerce(LambdaExpressionTerm0,
+ LambdaExpressionTerm),
parse_lambda_expression(LambdaExpressionTerm,
Vars0, Modes0, Det0)
->
LambdaPurity = (pure),
PredOrFunc = predicate,
- EvalMethod = EvalMethod0, Vars1 = Vars0,
- Modes1 = Modes0, Det1 = Det0, GoalTerm1 = GoalTerm0
+ EvalMethod = EvalMethod0,
+ Vars1 = Vars0,
+ Modes1 = Modes0,
+ Det1 = Det0,
+ GoalTerm1 = GoalTerm0
;
% handle higher-order pred and func expressions -
- % same semantics as lambda expressions, different syntax
- % (the original lambda expression syntax is now deprecated)
+ % same semantics as lambda expressions, different
+ % syntax (the original lambda expression syntax
+ % is now deprecated)
parse_rule_term(Context, RHS, HeadTerm0, GoalTerm1),
term__coerce(HeadTerm0, HeadTerm1),
- parse_purity_annotation(HeadTerm1, LambdaPurity, HeadTerm),
+ parse_purity_annotation(HeadTerm1, LambdaPurity,
+ HeadTerm),
(
parse_pred_expression(HeadTerm, EvalMethod0,
Vars0, Modes0, Det0)
@@ -8001,21 +7617,19 @@
Vars1, Modes1, Det1),
PredOrFunc = function
)
- }
+ )
->
- check_expr_purity(Purity, Context, Info0, Info1),
- make_hlds__qualify_lambda_mode_list(Modes1, Modes,
- Context, Info1, Info2),
- { Det = Det1 },
- { term__coerce(GoalTerm1, GoalTerm) },
- { parse_goal(GoalTerm, VarSet1, ParsedGoal, VarSet2) },
+ check_expr_purity(Purity, Context, !Info, !IO),
+ make_hlds__qualify_lambda_mode_list(Modes1, Modes, Context,
+ !Info, !IO),
+ Det = Det1,
+ term__coerce(GoalTerm1, GoalTerm),
+ parse_goal(GoalTerm, ParsedGoal, !VarSet),
build_lambda_expression(X, LambdaPurity, PredOrFunc,
- EvalMethod, Vars1, Modes, Det, ParsedGoal, VarSet2,
- Context, MainContext, SubContext, Goal, VarSet,
- Info2, Info, SInfo1),
- { SInfo = SInfo1 }
+ EvalMethod, Vars1, Modes, Det, ParsedGoal,
+ Context, MainContext, SubContext, Goal, !VarSet,
+ !Info, !.SInfo, !IO)
;
- {
% handle higher-order dcg pred expressions -
% same semantics as higher-order pred expressions,
% but has two extra arguments, and the goal is expanded
@@ -8026,197 +7640,169 @@
parse_purity_annotation(PredTerm1, DCGLambdaPurity, PredTerm),
parse_dcg_pred_expression(PredTerm, EvalMethod,
Vars0, Modes0, Det)
- }
->
- make_hlds__qualify_lambda_mode_list(Modes0, Modes,
- Context, Info0, Info1),
- { term__coerce(GoalTerm0, GoalTerm) },
- { parse_dcg_pred_goal(GoalTerm, VarSet1,
- ParsedGoal, DCG0, DCGn, VarSet2) },
- { list__append(Vars0, [term__variable(DCG0),
- term__variable(DCGn)], Vars1) },
+ make_hlds__qualify_lambda_mode_list(Modes0, Modes, Context,
+ !Info, !IO),
+ term__coerce(GoalTerm0, GoalTerm),
+ parse_dcg_pred_goal(GoalTerm, ParsedGoal, DCG0, DCGn, !VarSet),
+ list__append(Vars0,
+ [term__variable(DCG0), term__variable(DCGn)], Vars1),
build_lambda_expression(X, DCGLambdaPurity, predicate,
- EvalMethod, Vars1, Modes, Det, ParsedGoal, VarSet2,
- Context, MainContext, SubContext, Goal0, VarSet,
- Info1, Info, SInfo1),
- { SInfo = SInfo1 },
- { Goal0 = GoalExpr - GoalInfo0 },
- { add_goal_info_purity_feature(GoalInfo0, Purity, GoalInfo) },
- { Goal = GoalExpr - GoalInfo }
+ EvalMethod, Vars1, Modes, Det, ParsedGoal,
+ Context, MainContext, SubContext, Goal0, !VarSet,
+ !Info, !.SInfo, !IO),
+ Goal0 = GoalExpr - GoalInfo0,
+ add_goal_info_purity_feature(GoalInfo0, Purity, GoalInfo),
+ Goal = GoalExpr - GoalInfo
;
% handle if-then-else expressions
- { F = term__atom("else"),
- Args = [term__functor(term__atom("if"), [
- term__functor(term__atom("then"),
- [IfTerm0, ThenTerm], _)
- ], _),
+ (
+ F = term__atom("else"),
+ Args = [term__functor(term__atom("if"),
+ [term__functor(term__atom("then"),
+ [IfTerm0, ThenTerm], _)], _),
ElseTerm]
- ; F = term__atom(";"),
+ ;
+ F = term__atom(";"),
Args = [term__functor(term__atom("->"),
[IfTerm0, ThenTerm], _),
ElseTerm]
- },
- { term__coerce(IfTerm0, IfTerm) },
- { parse_some_vars_goal(IfTerm, VarSet1, Vars, StateVars,
- IfParseTree, VarSet11) }
- ->
- { prepare_for_if_then_else_expr(StateVars, VarSet11, VarSet11a,
- SInfo1, SInfo2) },
-
- check_expr_purity(Purity, Context, Info0, Info1),
- { map__init(EmptySubst) },
- transform_goal(IfParseTree, VarSet11a, EmptySubst,
- IfGoal, VarSet22, Info1, Info2, SInfo2, SInfo3),
+ ),
+ term__coerce(IfTerm0, IfTerm),
+ parse_some_vars_goal(IfTerm, Vars, StateVars,
+ IfParseTree, !VarSet)
+ ->
+ BeforeSInfo = !.SInfo,
+ prepare_for_if_then_else_expr(StateVars, !VarSet, !SInfo),
+
+ check_expr_purity(Purity, Context, !Info, !IO),
+ map__init(EmptySubst),
+ transform_goal(IfParseTree, EmptySubst, IfGoal, !VarSet,
+ !Info, !SInfo, !IO),
- { finish_if_then_else_expr_condition(SInfo1, SInfo3, SInfo4) },
+ finish_if_then_else_expr_condition(BeforeSInfo, !SInfo),
unravel_unification(term__variable(X), ThenTerm,
- Context, MainContext, SubContext, VarSet22,
- pure, ThenGoal, VarSet33, Info2, Info3, SInfo4, SInfo5),
+ Context, MainContext, SubContext, pure, ThenGoal,
+ !VarSet, !Info, !SInfo, !IO),
- { finish_if_then_else_expr_then_goal(StateVars,
- SInfo1, SInfo5, SInfo6) },
+ finish_if_then_else_expr_then_goal(StateVars, BeforeSInfo,
+ !SInfo),
unravel_unification(term__variable(X), ElseTerm,
- Context, MainContext, SubContext, VarSet33, pure,
- ElseGoal, VarSet, Info3, Info, SInfo6, SInfo),
+ Context, MainContext, SubContext, pure,
+ ElseGoal, !VarSet, !Info, !SInfo, !IO),
- { IfThenElse = if_then_else(StateVars ++ Vars, IfGoal,
- ThenGoal, ElseGoal) },
- { goal_info_init(Context, GoalInfo) },
- { Goal = IfThenElse - GoalInfo }
+ IfThenElse = if_then_else(StateVars ++ Vars, IfGoal,
+ ThenGoal, ElseGoal),
+ goal_info_init(Context, GoalInfo),
+ Goal = IfThenElse - GoalInfo
;
% handle field extraction expressions
- { F = term__atom("^") },
- { Args = [InputTerm, FieldNameTerm] },
- { parse_field_list(FieldNameTerm, FieldNameResult) },
- { FieldNameResult = ok(FieldNames) }
- ->
- check_expr_purity(Purity, Context, Info0, Info1),
- { make_fresh_arg_var(InputTerm, InputTermVar, [],
- VarSet1, VarSet2) },
+ F = term__atom("^"),
+ Args = [InputTerm, FieldNameTerm],
+ parse_field_list(FieldNameTerm, FieldNameResult),
+ FieldNameResult = ok(FieldNames)
+ ->
+ check_expr_purity(Purity, Context, !Info, !IO),
+ make_fresh_arg_var(InputTerm, InputTermVar, [], !VarSet),
expand_get_field_function_call(Context, MainContext,
SubContext, FieldNames, X, InputTermVar,
- VarSet2, VarSet3, Functor, _, Goal0, Info1, Info2,
- SInfo1, SInfo2),
+ !VarSet, Functor, _, Goal0, !Info, !SInfo, !IO),
- { ArgContext = functor(Functor, MainContext, SubContext) },
+ ArgContext = functor(Functor, MainContext, SubContext),
insert_arg_unifications([InputTermVar], [InputTerm],
FunctorContext, ArgContext, Goal0,
- VarSet3, Goal, VarSet, Info2, Info, SInfo2, SInfo)
+ Goal, !VarSet, !Info, !SInfo, !IO)
;
% handle field update expressions
- { F = term__atom(":=") },
- { Args = [FieldDescrTerm, FieldValueTerm] },
- { FieldDescrTerm = term__functor(term__atom("^"),
- [InputTerm, FieldNameTerm], _) },
- { parse_field_list(FieldNameTerm, FieldNameResult) },
- { FieldNameResult = ok(FieldNames) }
- ->
- check_expr_purity(Purity, Context, Info0, Info1),
- { make_fresh_arg_var(InputTerm, InputTermVar, [],
- VarSet1, VarSet2) },
- { make_fresh_arg_var(FieldValueTerm, FieldValueVar,
- [InputTermVar], VarSet2, VarSet3) },
+ F = term__atom(":="),
+ Args = [FieldDescrTerm, FieldValueTerm],
+ FieldDescrTerm = term__functor(term__atom("^"),
+ [InputTerm, FieldNameTerm], _),
+ parse_field_list(FieldNameTerm, FieldNameResult),
+ FieldNameResult = ok(FieldNames)
+ ->
+ check_expr_purity(Purity, Context, !Info, !IO),
+ make_fresh_arg_var(InputTerm, InputTermVar, [], !VarSet),
+ make_fresh_arg_var(FieldValueTerm, FieldValueVar,
+ [InputTermVar], !VarSet),
expand_set_field_function_call(Context, MainContext,
SubContext, FieldNames, FieldValueVar, InputTermVar, X,
- VarSet3, VarSet4, Functor,
- InnerFunctor - FieldSubContext, Goal0, Info1, Info2,
- SInfo1, SInfo2),
-
- { TermArgContext = functor(Functor, MainContext, SubContext) },
- { TermArgNumber = 1 },
- { FieldArgContext = functor(InnerFunctor,
- MainContext, FieldSubContext) },
- { FieldArgNumber = 2 },
- { ArgContexts = [TermArgNumber - TermArgContext,
- FieldArgNumber - FieldArgContext] },
+ !VarSet, Functor, InnerFunctor - FieldSubContext,
+ Goal0, !Info, !SInfo, !IO),
+
+ TermArgContext = functor(Functor, MainContext, SubContext),
+ TermArgNumber = 1,
+ FieldArgContext = functor(InnerFunctor,
+ MainContext, FieldSubContext),
+ FieldArgNumber = 2,
+ ArgContexts = [TermArgNumber - TermArgContext,
+ FieldArgNumber - FieldArgContext],
insert_arg_unifications_with_supplied_contexts(
[InputTermVar, FieldValueVar],
[InputTerm, FieldValueTerm], ArgContexts,
- Context, Goal0, VarSet4, Goal, VarSet, Info2, Info,
- SInfo2, SInfo)
+ Context, Goal0, Goal, !VarSet, !Info, !SInfo, !IO)
;
- { parse_qualified_term(RHS, RHS, "", MaybeFunctor) },
+ parse_qualified_term(RHS, RHS, "", MaybeFunctor),
(
- { MaybeFunctor = ok(FunctorName, FunctorArgs) },
- { list__length(FunctorArgs, Arity) },
- { ConsId = cons(FunctorName, Arity) }
+ MaybeFunctor = ok(FunctorName, FunctorArgs),
+ list__length(FunctorArgs, Arity),
+ ConsId = cons(FunctorName, Arity)
;
% float, int or string constant
% - any errors will be caught by typechecking
- { MaybeFunctor = error(_, _) },
- { list__length(Args, Arity) },
- { make_functor_cons_id(F, Arity, ConsId) },
- { FunctorArgs = Args }
+ MaybeFunctor = error(_, _),
+ list__length(Args, Arity),
+ make_functor_cons_id(F, Arity, ConsId),
+ FunctorArgs = Args
),
- ( { FunctorArgs = [] } ->
- { make_atomic_unification(X, functor(ConsId, no, []),
+ ( FunctorArgs = [] ->
+ make_atomic_unification(X, functor(ConsId, no, []),
Context, MainContext, SubContext, Goal0,
- Info0, Info) },
- { Goal0 = GoalExpr - GoalInfo0 },
- { add_goal_info_purity_feature(GoalInfo0, Purity,
- GoalInfo) },
- { Goal = GoalExpr - GoalInfo },
- { VarSet = VarSet1 },
- { SInfo = SInfo1 }
- ;
- { make_fresh_arg_vars(FunctorArgs, VarSet1,
- HeadVars, VarSet2) },
- { make_atomic_unification(X,
+ !Info),
+ Goal0 = GoalExpr - GoalInfo0,
+ add_goal_info_purity_feature(GoalInfo0, Purity,
+ GoalInfo),
+ Goal = GoalExpr - GoalInfo
+ ;
+ make_fresh_arg_vars(FunctorArgs, HeadVars, !VarSet),
+ make_atomic_unification(X,
functor(ConsId, no, HeadVars), Context,
MainContext, SubContext, Goal0,
- Info0, Info1) },
- { ArgContext = functor(ConsId,
- MainContext, SubContext) },
+ !Info),
+ ArgContext = functor(ConsId, MainContext, SubContext),
% Should this be insert_... rather than append_...?
% No, because that causes efficiency problems
% with type-checking :-(
% But for impure unifications, we need to do
% this, because mode reordering can't reorder
% around the functor unification.
- ( { Purity = pure } ->
+ ( Purity = pure ->
append_arg_unifications(HeadVars, FunctorArgs,
- FunctorContext, ArgContext, Goal0,
- VarSet2, Goal, VarSet,
- Info1, Info, SInfo1, SInfo)
- ;
- { Goal0 = GoalExpr - GoalInfo0 },
- { add_goal_info_purity_feature(GoalInfo0,
- Purity, GoalInfo) },
- { Goal1 = GoalExpr - GoalInfo },
+ FunctorContext, ArgContext,
+ Goal0, Goal, !VarSet, !Info, !SInfo,
+ !IO)
+ ;
+ Goal0 = GoalExpr - GoalInfo0,
+ add_goal_info_purity_feature(GoalInfo0,
+ Purity, GoalInfo),
+ Goal1 = GoalExpr - GoalInfo,
insert_arg_unifications(HeadVars, FunctorArgs,
- FunctorContext, ArgContext, Goal1,
- VarSet2, Goal, VarSet,
- Info1, Info, SInfo1, SInfo)
+ FunctorContext, ArgContext,
+ Goal1, Goal, !VarSet, !Info, !SInfo,
+ !IO)
)
)
).
-:- pred parse_purity_annotation(term(T), purity, term(T)).
-:- mode parse_purity_annotation(in, out, out) is det.
-parse_purity_annotation(Term0, Purity, Term) :-
- (
- Term0 = term__functor(term__atom(PurityName), [Term1], _),
- purity_name(Purity0, PurityName)
- ->
- Purity = Purity0,
- Term = Term1
- ;
- Purity = (pure),
- Term = Term0
- ).
-
% Handle `f(...) = X' in the same way as `X = f(...)'.
unravel_unification_2(term__functor(F, As, FC), term__variable(Y),
- C, MC, SC, VarSet0, Purity, Goal, VarSet, Info0, Info,
- SInfo0, SInfo) -->
- unravel_unification(term__variable(Y),
- term__functor(F, As, FC),
- C, MC, SC, VarSet0, Purity, Goal, VarSet, Info0, Info,
- SInfo0, SInfo).
+ C, MC, SC, Purity, Goal, !VarSet, !Info, !SInfo, !IO) :-
+ unravel_unification(term__variable(Y), term__functor(F, As, FC),
+ C, MC, SC, Purity, Goal, !VarSet, !Info, !SInfo, !IO).
% If we find a unification of the form `f1(...) = f2(...)',
% then we replace it with `Tmp = f1(...), Tmp = f2(...)',
@@ -8226,58 +7812,68 @@
unravel_unification_2(term__functor(LeftF, LeftAs, LeftC),
term__functor(RightF, RightAs, RightC),
- Context, MainContext, SubContext, VarSet0,
- Purity, Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
- { varset__new_var(VarSet0, TmpVar, VarSet1) },
- unravel_unification(
- term__variable(TmpVar),
+ Context, MainContext, SubContext,
+ Purity, Goal, !VarSet, !Info, !SInfo, !IO) :-
+ varset__new_var(!.VarSet, TmpVar, !:VarSet),
+ unravel_unification(term__variable(TmpVar),
term__functor(LeftF, LeftAs, LeftC),
Context, MainContext, SubContext,
- VarSet1, Purity, Goal0, VarSet2, Info0, Info1, SInfo0, SInfo1),
- unravel_unification(
- term__variable(TmpVar),
+ Purity, Goal0, !VarSet, !Info, !SInfo, !IO),
+ unravel_unification(term__variable(TmpVar),
term__functor(RightF, RightAs, RightC),
Context, MainContext, SubContext,
- VarSet2, Purity, Goal1, VarSet, Info1, Info, SInfo1, SInfo),
- { goal_info_init(GoalInfo) },
- { goal_to_conj_list(Goal0, ConjList0) },
- { goal_to_conj_list(Goal1, ConjList1) },
- { list__append(ConjList0, ConjList1, ConjList) },
- { conj_list_to_goal(ConjList, GoalInfo, Goal) }.
+ Purity, Goal1, !VarSet, !Info, !SInfo, !IO),
+ goal_info_init(GoalInfo),
+ goal_to_conj_list(Goal0, ConjList0),
+ goal_to_conj_list(Goal1, ConjList1),
+ list__append(ConjList0, ConjList1, ConjList),
+ conj_list_to_goal(ConjList, GoalInfo, Goal).
-:- pred make_hlds__qualify_lambda_mode_list(list(mode), list(mode),
- prog_context, transform_info, transform_info,
- io__state, io__state).
-:- mode make_hlds__qualify_lambda_mode_list(in, out, in, in, out,
- di, uo) is det.
+:- pred parse_purity_annotation(term(T), purity, term(T)).
+:- mode parse_purity_annotation(in, out, out) is det.
+
+parse_purity_annotation(Term0, Purity, Term) :-
+ (
+ Term0 = term__functor(term__atom(PurityName), [Term1], _),
+ purity_name(Purity0, PurityName)
+ ->
+ Purity = Purity0,
+ Term = Term1
+ ;
+ Purity = (pure),
+ Term = Term0
+ ).
+
+:- pred make_hlds__qualify_lambda_mode_list(list(mode)::in, list(mode)::out,
+ prog_context::in, transform_info::in, transform_info::out,
+ io__state::di, io__state::uo) is det.
-make_hlds__qualify_lambda_mode_list(Modes0, Modes, Context, Info0, Info) -->
+make_hlds__qualify_lambda_mode_list(Modes0, Modes, Context, !Info, !IO) :-
% The modes in `.opt' files are already fully module qualified.
- ( { Info0 ^ qual_info ^ import_status \= opt_imported } ->
- { qual_info_get_mq_info(Info0 ^ qual_info, MQInfo0) },
+ ( !.Info ^ qual_info ^ import_status \= opt_imported ->
+ qual_info_get_mq_info(!.Info ^ qual_info, MQInfo0),
module_qual__qualify_lambda_mode_list(Modes0, Modes,
- Context, MQInfo0, MQInfo1),
- { qual_info_set_mq_info(Info0 ^ qual_info,
- MQInfo1, QualInfo1) },
- { Info = Info0 ^ qual_info := QualInfo1 }
+ Context, MQInfo0, MQInfo1, !IO),
+ qual_info_set_mq_info(MQInfo1, !.Info ^ qual_info,
+ QualInfo1),
+ !:Info = !.Info ^ qual_info := QualInfo1
;
- { Modes = Modes0 },
- { Info = Info0 }
+ Modes = Modes0
).
%-----------------------------------------------------------------------------%
-:- pred check_expr_purity(purity, prog_context, transform_info,
- transform_info, io__state, io__state).
-:- mode check_expr_purity(in, in, in, out, di, uo) is det.
-check_expr_purity(Purity, Context, Info0, Info) -->
- ( { Purity \= pure } ->
- impure_unification_expr_error(Context, Purity),
- { module_info_incr_errors(Info0 ^ module_info,
- ModuleInfo) },
- { Info = Info0 ^ module_info := ModuleInfo }
+:- pred check_expr_purity(purity::in, prog_context::in,
+ transform_info::in, transform_info::out, io__state::di, io__state::uo)
+ is det.
+
+check_expr_purity(Purity, Context, !Info, !IO) :-
+ ( Purity \= pure ->
+ impure_unification_expr_error(Context, Purity, !IO),
+ module_info_incr_errors(!.Info ^ module_info, ModuleInfo),
+ !:Info = !.Info ^ module_info := ModuleInfo
;
- { Info = Info0 }
+ true
).
%-----------------------------------------------------------------------------%
@@ -8301,18 +7897,17 @@
%-----------------------------------------------------------------------------%
-:- pred build_lambda_expression(prog_var, purity, pred_or_func,
- lambda_eval_method, list(prog_term), list(mode), determinism,
- goal, prog_varset,
- prog_context, unify_main_context, unify_sub_contexts,
- hlds_goal, prog_varset, transform_info, transform_info,
- svar_info, io__state, io__state).
-:- mode build_lambda_expression(in, in, in, in, in, in, in, in, in,
- in, in, in, out, out, in, out, in, di, uo) is det.
+:- pred build_lambda_expression(prog_var::in, purity::in, pred_or_func::in,
+ lambda_eval_method::in, list(prog_term)::in, list(mode)::in,
+ determinism::in, goal::in, prog_context::in, unify_main_context::in,
+ unify_sub_contexts::in, hlds_goal::out,
+ prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out,
+ svar_info::in, io__state::di, io__state::uo) is det.
build_lambda_expression(X, Purity, PredOrFunc, EvalMethod, Args0, Modes, Det,
- ParsedGoal, VarSet0, Context, MainContext, SubContext,
- Goal, VarSet, Info1, Info, SInfo0) -->
+ ParsedGoal, Context, MainContext, SubContext, Goal, !VarSet,
+ !Info, SInfo0, !IO) :-
%
% In the parse tree, the lambda arguments can be any terms.
% But in the HLDS, they must be distinct variables. So we introduce
@@ -8349,96 +7944,90 @@
% to avoid the function result term becoming lambda-quantified.
%
(
- { illegal_state_var_func_result(PredOrFunc, Args0, StateVar) }
+ illegal_state_var_func_result(PredOrFunc, Args0, StateVar)
+ ->
+ report_illegal_func_svar_result(Context, !.VarSet, StateVar,
+ !IO),
+ true_goal(Goal)
+ ;
+ lambda_args_contain_bang_state_var(Args0, StateVar)
->
- report_illegal_func_svar_result(Context, VarSet0, StateVar),
- { true_goal(Goal) },
- { VarSet = VarSet0 },
- { Info = Info1 }
- ;
- { lambda_args_contain_bang_state_var(Args0, StateVar) }
- ->
- report_illegal_bang_svar_lambda_arg(Context, VarSet0, StateVar),
- { true_goal(Goal) },
- { VarSet = VarSet0 },
- { Info = Info1 }
- ;
- { prepare_for_lambda(SInfo0, SInfo1) },
- substitute_state_var_mappings(Args0, Args, VarSet0, VarSet1,
- SInfo1, SInfo2),
-
- { list__length(Args, NumArgs) },
- { varset__new_vars(VarSet1, NumArgs, LambdaVars, VarSet2) },
- { map__init(Substitution) },
- { hlds_goal__true_goal(Head0) },
- { ArgContext = head(PredOrFunc, NumArgs) },
+ report_illegal_bang_svar_lambda_arg(Context, !.VarSet,
+ StateVar, !IO),
+ true_goal(Goal)
+ ;
+ prepare_for_lambda(SInfo0, SInfo1),
+ substitute_state_var_mappings(Args0, Args, !VarSet,
+ SInfo1, SInfo2, !IO),
+
+ list__length(Args, NumArgs),
+ varset__new_vars(!.VarSet, NumArgs, LambdaVars, !:VarSet),
+ map__init(Substitution),
+ hlds_goal__true_goal(Head0),
+ ArgContext = head(PredOrFunc, NumArgs),
insert_arg_unifications(LambdaVars, Args, Context, ArgContext,
- Head0, VarSet2, Head, VarSet3, Info1, Info2,
- SInfo2, SInfo3),
+ Head0, Head, !VarSet, !Info, SInfo2, SInfo3, !IO),
- { prepare_for_body(FinalSVarMap, VarSet3, VarSet4,
- SInfo3, SInfo4) },
+ prepare_for_body(FinalSVarMap, !VarSet, SInfo3, SInfo4),
- transform_goal(ParsedGoal, VarSet4, Substitution,
- Body, VarSet, Info2, Info3, SInfo4, SInfo5),
+ transform_goal(ParsedGoal, Substitution,
+ Body, !VarSet, !Info, SInfo4, SInfo5, !IO),
- { finish_head_and_body(Context, FinalSVarMap,
- Head, Body, HLDS_Goal0, SInfo5) },
+ finish_head_and_body(Context, FinalSVarMap,
+ Head, Body, HLDS_Goal0, SInfo5),
%
% Now figure out which variables we need to
% explicitly existentially quantify.
%
- {
+ (
PredOrFunc = predicate,
QuantifiedArgs = Args
;
PredOrFunc = function,
pred_args_to_func_args(Args, QuantifiedArgs,
_ReturnValTerm)
- },
- { term__vars_list(QuantifiedArgs, QuantifiedVars0) },
- { list__sort_and_remove_dups(QuantifiedVars0, QuantifiedVars) },
+ ),
+ term__vars_list(QuantifiedArgs, QuantifiedVars0),
+ list__sort_and_remove_dups(QuantifiedVars0, QuantifiedVars),
- { goal_info_init(Context, GoalInfo) },
- { HLDS_Goal = some(QuantifiedVars, can_remove, HLDS_Goal0) -
- GoalInfo },
+ goal_info_init(Context, GoalInfo),
+ HLDS_Goal = some(QuantifiedVars, can_remove, HLDS_Goal0) -
+ GoalInfo,
%
% We set the lambda nonlocals here to anything that
% could possibly be nonlocal. Quantification will
% reduce this down to the proper set of nonlocal arguments.
%
- { goal_util__goal_vars(HLDS_Goal, LambdaGoalVars0) },
- { set__delete_list(LambdaGoalVars0, LambdaVars,
- LambdaGoalVars1) },
- { set__delete_list(LambdaGoalVars1, QuantifiedVars,
- LambdaGoalVars2) },
- { set__to_sorted_list(LambdaGoalVars2, LambdaNonLocals) },
+ goal_util__goal_vars(HLDS_Goal, LambdaGoalVars0),
+ set__delete_list(LambdaGoalVars0, LambdaVars,
+ LambdaGoalVars1),
+ set__delete_list(LambdaGoalVars1, QuantifiedVars,
+ LambdaGoalVars2),
+ set__to_sorted_list(LambdaGoalVars2, LambdaNonLocals),
- { make_atomic_unification(X,
+ make_atomic_unification(X,
lambda_goal(Purity, PredOrFunc, EvalMethod,
modes_are_ok, LambdaNonLocals, LambdaVars,
Modes, Det, HLDS_Goal),
- Context, MainContext, SubContext, Goal, Info3, Info) }
+ Context, MainContext, SubContext, Goal, !Info)
).
%-----------------------------------------------------------------------------%
-:- pred construct_pred_or_func_call(pred_id, pred_or_func, sym_name,
- list(prog_var), hlds_goal_info, hlds_goal,
- transform_info, transform_info).
-:- mode construct_pred_or_func_call(in, in, in, in, in, out, in, out) is det.
+:- pred construct_pred_or_func_call(pred_id::in, pred_or_func::in,
+ sym_name::in, list(prog_var)::in, hlds_goal_info::in, hlds_goal::out,
+ transform_info::in, transform_info::out) is det.
-construct_pred_or_func_call(PredId, PredOrFunc, SymName, Args,
- GoalInfo, Goal, Info0, Info) :-
+construct_pred_or_func_call(PredId, PredOrFunc, SymName, Args, GoalInfo, Goal,
+ !Info) :-
do_construct_pred_or_func_call(PredId, PredOrFunc, SymName, Args,
GoalInfo, Goal),
list__length(Args, Arity),
adjust_func_arity(PredOrFunc, OrigArity, Arity),
- record_called_pred_or_func(PredOrFunc, SymName, OrigArity,
- Info0, Info).
+ record_called_pred_or_func(PredOrFunc, SymName, OrigArity, !Info).
:- pred do_construct_pred_or_func_call(pred_id, pred_or_func, sym_name,
list(prog_var), hlds_goal_info, hlds_goal).
@@ -8591,7 +8180,6 @@
substitute_vars(Vars0, Subst, Vars) :-
Vars = list__map(substitute_var(Subst), Vars0).
-
:- func substitute_var(substitution(T), var(T)) = var(T).
substitute_var(Subst, Var0) = Var :-
@@ -8608,75 +8196,64 @@
% Goal is a tree of conjuncts. Flatten it into a list (applying Subst),
% append Conj0, and return the result in reverse order in Conj.
-:- pred get_rev_conj(goal, prog_substitution, list(hlds_goal), prog_varset,
- list(hlds_goal), prog_varset, transform_info, transform_info,
- svar_info, svar_info, io__state, io__state).
-:- mode get_rev_conj(in, in, in, in, out, out, in, out, in, out, di, uo) is det.
-
-get_rev_conj(Goal, Subst, RevConj0, VarSet0, RevConj,
- VarSet, Info0, Info, SInfo0, SInfo) -->
- (
- { Goal = (A,B) - _Context }
- ->
- get_rev_conj(A, Subst, RevConj0, VarSet0, RevConj1,
- VarSet1, Info0, Info1, SInfo0, SInfo1),
- get_rev_conj(B, Subst, RevConj1, VarSet1, RevConj,
- VarSet, Info1, Info, SInfo1, SInfo)
- ;
- transform_goal(Goal, VarSet0, Subst, Goal1, VarSet,
- Info0, Info, SInfo0, SInfo),
- { goal_to_conj_list(Goal1, ConjList) },
- { RevConj = list__reverse(ConjList) ++ RevConj0 }
+:- pred get_rev_conj(goal::in, prog_substitution::in, list(hlds_goal)::in,
+ list(hlds_goal)::out, prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
+
+get_rev_conj(Goal, Subst, RevConj0, RevConj, !VarSet, !Info, !SInfo, !IO) :-
+ ( Goal = (A,B) - _Context ->
+ get_rev_conj(A, Subst, RevConj0, RevConj1,
+ !VarSet, !Info, !SInfo, !IO),
+ get_rev_conj(B, Subst, RevConj1, RevConj,
+ !VarSet, !Info, !SInfo, !IO)
+ ;
+ transform_goal(Goal, Subst, Goal1, !VarSet, !Info, !SInfo,
+ !IO),
+ goal_to_conj_list(Goal1, ConjList),
+ RevConj = list__reverse(ConjList) ++ RevConj0
).
% get_rev_par_conj(Goal, ParConj0, Subst, ParConj) :
% Goal is a tree of conjuncts. Flatten it into a list (applying Subst),
% append ParConj0, and return the result in reverse order in ParConj.
-:- pred get_rev_par_conj(goal, prog_substitution, list(hlds_goal), prog_varset,
- list(hlds_goal), prog_varset, transform_info, transform_info,
- svar_info, svar_info, io__state, io__state).
-:- mode get_rev_par_conj(in, in, in, in, out, out, in, out, in, out,
- di, uo) is det.
+:- pred get_rev_par_conj(goal::in, prog_substitution::in, list(hlds_goal)::in,
+ list(hlds_goal)::out, prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in, svar_info::out,
+ io__state::di, io__state::uo) is det.
-get_rev_par_conj(Goal, Subst, RevParConj0, VarSet0, RevParConj,
- VarSet, Info0, Info, SInfo0, SInfo) -->
- (
- { Goal = (A & B) - _Context }
- ->
- get_rev_par_conj(A, Subst, RevParConj0, VarSet0, RevParConj1,
- VarSet1, Info0, Info1, SInfo0, SInfo1),
- get_rev_par_conj(B, Subst, RevParConj1, VarSet1, RevParConj,
- VarSet, Info1, Info, SInfo1, SInfo)
- ;
- transform_goal(Goal, VarSet0, Subst, Goal1, VarSet,
- Info0, Info, SInfo0, SInfo),
- { goal_to_par_conj_list(Goal1, ParConjList) },
- { RevParConj = list__reverse(ParConjList) ++ RevParConj0 }
+get_rev_par_conj(Goal, Subst, RevParConj0, RevParConj, !VarSet, !Info, !SInfo,
+ !IO) :-
+ ( Goal = (A & B) - _Context ->
+ get_rev_par_conj(A, Subst, RevParConj0, RevParConj1,
+ !VarSet, !Info, !SInfo, !IO),
+ get_rev_par_conj(B, Subst, RevParConj1, RevParConj,
+ !VarSet, !Info, !SInfo, !IO)
+ ;
+ transform_goal(Goal, Subst, Goal1, !VarSet, !Info, !SInfo,
+ !IO),
+ goal_to_par_conj_list(Goal1, ParConjList),
+ RevParConj = list__reverse(ParConjList) ++ RevParConj0
).
% get_disj(Goal, Subst, Disj0, Disj) :
% Goal is a tree of disjuncts. Flatten it into a list (applying Subst)
% append Disj0, and return the result in Disj.
-:- pred get_disj(goal, prog_substitution, hlds_goal_svar_infos, prog_varset,
- hlds_goal_svar_infos, prog_varset,
- transform_info, transform_info,
- svar_info, io__state, io__state).
-:- mode get_disj(in, in, in, in, out, out, in, out, in, di, uo) is det.
-
-get_disj(Goal, Subst, Disj0, VarSet0, Disj, VarSet, Info0, Info, SInfo) -->
- (
- { Goal = (A;B) - _Context }
- ->
- get_disj(B, Subst, Disj0, VarSet0, Disj1, VarSet1,
- Info0, Info1, SInfo),
- get_disj(A, Subst, Disj1, VarSet1, Disj, VarSet,
- Info1, Info, SInfo)
- ;
- transform_goal(Goal, VarSet0, Subst, Goal1, VarSet,
- Info0, Info, SInfo, SInfo1),
- { Disj = [{Goal1, SInfo1} | Disj0] }
+:- pred get_disj(goal::in, prog_substitution::in, hlds_goal_svar_infos::in,
+ hlds_goal_svar_infos::out, prog_varset::in, prog_varset::out,
+ transform_info::in, transform_info::out, svar_info::in,
+ io__state::di, io__state::uo) is det.
+
+get_disj(Goal, Subst, Disj0, Disj, !VarSet, !Info, SInfo, !IO) :-
+ ( Goal = (A;B) - _Context ->
+ get_disj(B, Subst, Disj0, Disj1, !VarSet, !Info, SInfo, !IO),
+ get_disj(A, Subst, Disj1, Disj, !VarSet, !Info, SInfo, !IO)
+ ;
+ transform_goal(Goal, Subst, Goal1, !VarSet, !Info,
+ SInfo, SInfo1, !IO),
+ Disj = [{Goal1, SInfo1} | Disj0]
).
%-----------------------------------------------------------------------------%
@@ -8684,8 +8261,10 @@
% Information used to process explicit type qualifications.
:- type qual_info
---> qual_info(
- eqv_map :: eqv_map, % Used to expand equivalence types.
- tvarset :: tvarset, % All type variables for predicate.
+ eqv_map :: eqv_map,
+ % Used to expand equivalence types.
+ tvarset :: tvarset,
+ % All type variables for predicate.
tvar_renaming :: map(tvar, tvar),
% Map from clause type variable to
% actual type variable in tvarset.
@@ -8694,7 +8273,8 @@
% in the predicate's argument types
% indexed by name.
vartypes :: map(prog_var, type), % Var types
- mq_info :: mq_info, % Module qualification info.
+ mq_info :: mq_info,
+ % Module qualification info.
import_status :: import_status,
found_syntax_error :: bool
% Was there a syntax error
@@ -8715,49 +8295,45 @@
Index, VarTypes, MQInfo, local, FoundSyntaxError).
% Update the qual_info when processing a new clause.
-:- pred update_qual_info(qual_info, tvar_name_map, tvarset,
- map(prog_var, type), import_status, qual_info).
-:- mode update_qual_info(in, in, in, in, in, out) is det.
-
-update_qual_info(QualInfo0, TVarNameMap, TVarSet,
- VarTypes, Status, QualInfo) :-
- QualInfo0 = qual_info(EqvMap, _TVarSet0, _Renaming0, _TVarNameMap0,
+:- pred update_qual_info(tvar_name_map::in, tvarset::in,
+ map(prog_var, type)::in, import_status::in,
+ qual_info::in, qual_info::out) is det.
+
+update_qual_info(TVarNameMap, TVarSet, VarTypes, Status, !QualInfo) :-
+ !.QualInfo = qual_info(EqvMap, _TVarSet0, _Renaming0, _TVarNameMap0,
_VarTypes0, MQInfo, _Status, _FoundError),
% The renaming for one clause is useless in the others.
map__init(Renaming),
- QualInfo = qual_info(EqvMap, TVarSet, Renaming, TVarNameMap,
+ !:QualInfo = qual_info(EqvMap, TVarSet, Renaming, TVarNameMap,
VarTypes, MQInfo, Status, no).
-:- pred qual_info_get_mq_info(qual_info, mq_info).
-:- mode qual_info_get_mq_info(in, out) is det.
+:- pred qual_info_get_mq_info(qual_info::in, mq_info::out) is det.
qual_info_get_mq_info(Info, Info ^ mq_info).
-:- pred qual_info_set_mq_info(qual_info, mq_info, qual_info).
-:- mode qual_info_set_mq_info(in, in, out) is det.
+:- pred qual_info_set_mq_info(mq_info::in, qual_info::in, qual_info::out)
+ is det.
-qual_info_set_mq_info(Info0, MQInfo, Info0 ^ mq_info := MQInfo).
+qual_info_set_mq_info(MQInfo, Info, Info ^ mq_info := MQInfo).
-:- pred qual_info_get_var_types(qual_info, map(prog_var, type)).
-:- mode qual_info_get_var_types(in, out) is det.
+:- pred qual_info_get_var_types(qual_info::in, map(prog_var, type)::out)
+ is det.
qual_info_get_var_types(Info, Info ^ vartypes).
-:- pred qual_info_get_found_syntax_error(qual_info, bool).
-:- mode qual_info_get_found_syntax_error(in, out) is det.
+:- pred qual_info_get_found_syntax_error(qual_info::in, bool::out) is det.
qual_info_get_found_syntax_error(Info, Info ^ found_syntax_error).
-:- pred qual_info_set_found_syntax_error(bool, qual_info, qual_info).
-:- mode qual_info_set_found_syntax_error(in, in, out) is det.
+:- pred qual_info_set_found_syntax_error(bool::in,
+ qual_info::in, qual_info::out) is det.
qual_info_set_found_syntax_error(FoundError, Info,
Info ^ found_syntax_error := FoundError).
:- pred apply_to_recompilation_info(
- pred(recompilation_info, recompilation_info),
- transform_info, transform_info).
-:- mode apply_to_recompilation_info(pred(in, out) is det, in, out) is det.
+ pred(recompilation_info, recompilation_info)::in(pred(in, out) is det),
+ transform_info::in, transform_info::out) is det.
apply_to_recompilation_info(Pred, Info0, Info) :-
MQInfo0 = Info0 ^ qual_info ^ mq_info,
@@ -8773,14 +8349,12 @@
Info = Info0
).
-set_module_recompilation_info(QualInfo, ModuleInfo0, ModuleInfo) :-
+set_module_recompilation_info(QualInfo, !ModuleInfo) :-
mq_info_get_recompilation_info(QualInfo ^ mq_info, RecompInfo),
- module_info_set_maybe_recompilation_info(ModuleInfo0,
- RecompInfo, ModuleInfo).
+ module_info_set_maybe_recompilation_info(RecompInfo, !ModuleInfo).
-:- pred record_called_pred_or_func(pred_or_func, sym_name, arity,
- transform_info, transform_info).
-:- mode record_called_pred_or_func(in, in, in, in, out) is det.
+:- pred record_called_pred_or_func(pred_or_func::in, sym_name::in, arity::in,
+ transform_info::in, transform_info::out) is det.
record_called_pred_or_func(PredOrFunc, SymName, Arity) -->
{ Id = SymName - Arity },
@@ -8907,51 +8481,46 @@
io__state::di, io__state::uo) is det.
undeclared_mode_error(ModeList, VarSet, PredId, PredInfo, ModuleInfo,
- Context) -->
- prog_out__write_context(Context),
- io__write_string("In clause for "),
- hlds_out__write_pred_id(ModuleInfo, PredId),
- io__write_string(":\n"),
- prog_out__write_context(Context),
- io__write_string(
- " error: mode annotation specifies undeclared mode\n"),
- prog_out__write_context(Context),
- io__write_string(" `"),
- { strip_builtin_qualifiers_from_mode_list(ModeList,
- StrippedModeList) },
- { PredOrFunc = pred_info_is_pred_or_func(PredInfo) },
- { Name = pred_info_name(PredInfo) },
- { MaybeDet = no },
- mercury_output_mode_subdecl(PredOrFunc,
- varset__coerce(VarSet),
- unqualified(Name), StrippedModeList,
- MaybeDet, Context),
- io__write_string("'\n"),
- prog_out__write_context(Context),
- io__write_string(" of "),
- hlds_out__write_pred_id(ModuleInfo, PredId),
- io__write_string(".\n"),
- globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
- { ProcIds = pred_info_all_procids(PredInfo) },
- ( { ProcIds = [] } ->
- prog_out__write_context(Context),
+ Context, !IO) :-
+ prog_out__write_context(Context, !IO),
+ io__write_string("In clause for ", !IO),
+ hlds_out__write_pred_id(ModuleInfo, PredId, !IO),
+ io__write_string(":\n", !IO),
+ prog_out__write_context(Context, !IO),
io__write_string(
- " (There are no declared modes for this "),
- hlds_out__write_pred_or_func(PredOrFunc),
- io__write_string(".)\n")
- ; { VerboseErrors = yes } ->
- io__write_string(
- "\tThe declared modes for this "),
- hlds_out__write_pred_or_func(PredOrFunc),
- io__write_string(" are the following:\n"),
- { OutputProc =
- (pred(ProcId::in, di, uo) is det -->
+ " error: mode annotation specifies undeclared mode\n", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" `", !IO),
+ strip_builtin_qualifiers_from_mode_list(ModeList, StrippedModeList),
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ Name = pred_info_name(PredInfo),
+ MaybeDet = no,
+ mercury_output_mode_subdecl(PredOrFunc, varset__coerce(VarSet),
+ unqualified(Name), StrippedModeList, MaybeDet, Context, !IO),
+ io__write_string("'\n", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" of ", !IO),
+ hlds_out__write_pred_id(ModuleInfo, PredId, !IO),
+ io__write_string(".\n", !IO),
+ globals__io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
+ ProcIds = pred_info_all_procids(PredInfo),
+ ( ProcIds = [] ->
+ prog_out__write_context(Context, !IO),
+ io__write_string(" (There are no declared modes for this ",
+ !IO),
+ hlds_out__write_pred_or_func(PredOrFunc, !IO),
+ io__write_string(".)\n", !IO)
+ ; VerboseErrors = yes ->
+ io__write_string("\tThe declared modes for this ", !IO),
+ hlds_out__write_pred_or_func(PredOrFunc, !IO),
+ io__write_string(" are the following:\n", !IO),
+ OutputProc = (pred(ProcId::in, di, uo) is det -->
io__write_string("\t\t:- mode "),
output_mode_decl(ProcId, PredInfo),
- io__write_string(".\n")) },
- list__foldl(OutputProc, ProcIds)
+ io__write_string(".\n")),
+ list__foldl(OutputProc, ProcIds, !IO)
;
- []
+ true
).
:- pred maybe_undefined_pred_error(sym_name, int, pred_or_func, import_status,
@@ -9137,70 +8706,67 @@
% for the fact_table and then creates separate pieces of `pragma c_code' to
% access the table in each mode of the fact table predicate.
-:- pred module_add_pragma_fact_table(sym_name, arity, string,
- import_status, prog_context, module_info, module_info,
- qual_info, qual_info, io__state, io__state).
-:- mode module_add_pragma_fact_table(in, in, in, in, in, in, out, in, out,
- di, uo) is det.
+:- pred module_add_pragma_fact_table(sym_name::in, arity::in, string::in,
+ import_status::in, prog_context::in, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, io__state::di, io__state::uo) is det.
module_add_pragma_fact_table(Pred, Arity, FileName, Status, Context,
- Module0, Module, Info0, Info) -->
- { module_info_get_predicate_table(Module0, PredicateTable) },
+ !Module, !Info, !IO) :-
+ module_info_get_predicate_table(!.Module, PredicateTable),
(
- { predicate_table_search_sym_arity(PredicateTable,
- is_fully_qualified, Pred, Arity, PredIDs0) },
- { PredIDs0 = [PredID | PredIDs1] }
+ predicate_table_search_sym_arity(PredicateTable,
+ is_fully_qualified, Pred, Arity, PredIDs0),
+ PredIDs0 = [PredID | PredIDs1]
->
(
- { PredIDs1 = [] }, % only one predicate found
- { module_info_pred_info(Module0, PredID, PredInfo0) },
+ PredIDs1 = [], % only one predicate found
+ module_info_pred_info(!.Module, PredID, PredInfo0),
- % compile the fact table into a separate .o file
+ % compile the fact table into a separate
+ % .o file
fact_table_compile_facts(Pred, Arity, FileName,
- PredInfo0, PredInfo, Context, Module0, C_HeaderCode,
- PrimaryProcID),
-
- {module_info_set_pred_info(Module0, PredID, PredInfo, Module1)},
- { pred_info_procedures(PredInfo, ProcTable) },
- { pred_info_arg_types(PredInfo, ArgTypes) },
- { ProcIDs = pred_info_procids(PredInfo) },
- { PredOrFunc = pred_info_is_pred_or_func(PredInfo) },
- { adjust_func_arity(PredOrFunc, Arity, NumArgs) },
+ PredInfo0, PredInfo, Context, !.Module,
+ C_HeaderCode, PrimaryProcID, !IO),
- % create pragma c_header_code to declare extern variables
- { module_add_foreign_decl(c, C_HeaderCode, Context,
- Module1, Module2) },
-
- io__get_exit_status(ExitStatus),
- (
- { ExitStatus = 1 }
- ->
- { Module = Module2 },
- { Info = Info0 }
- ;
- % create some pragma c_code to access table in each mode
- module_add_fact_table_procedures(ProcIDs, PrimaryProcID,
- ProcTable, Pred, PredOrFunc, NumArgs, ArgTypes,
- Status, Context, Module2, Module, Info0, Info)
- )
- ;
- { PredIDs1 = [_ | _] }, % >1 predicate found
- io__set_exit_status(1),
- prog_out__write_context(Context),
- io__write_string("In pragma fact_table for `"),
- prog_out__write_sym_name_and_arity(Pred/Arity),
- io__write_string("':\n"),
- prog_out__write_context(Context),
- io__write_string(
- " error: ambiguous predicate/function name.\n"),
- { Module = Module0 },
- { Info = Info0 }
+ module_info_set_pred_info(PredID, PredInfo, !Module),
+ pred_info_procedures(PredInfo, ProcTable),
+ pred_info_arg_types(PredInfo, ArgTypes),
+ ProcIDs = pred_info_procids(PredInfo),
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ adjust_func_arity(PredOrFunc, Arity, NumArgs),
+
+ % create pragma c_header_code to declare
+ % extern variables
+ module_add_foreign_decl(c, C_HeaderCode, Context,
+ !Module),
+
+ io__get_exit_status(ExitStatus, !IO),
+ (
+ ExitStatus = 1
+ ->
+ true
+ ;
+ % create some pragma c_code to access table
+ % in each mode
+ module_add_fact_table_procedures(ProcIDs,
+ PrimaryProcID, ProcTable, Pred,
+ PredOrFunc, NumArgs, ArgTypes, Status,
+ Context, !Module, !Info, !IO)
+ )
+ ;
+ PredIDs1 = [_ | _], % >1 predicate found
+ io__set_exit_status(1, !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string("In pragma fact_table for `", !IO),
+ prog_out__write_sym_name_and_arity(Pred/Arity, !IO),
+ io__write_string("':\n", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" error: " ++
+ "ambiguous predicate/function name.\n", !IO)
)
;
undefined_pred_or_func_error(Pred, Arity, Context,
- "`:- pragma fact_table' declaration"),
- { Module = Module0 },
- { Info = Info0 }
+ "`:- pragma fact_table' declaration", !IO)
).
% Add a `pragma c_code' for each mode of the fact table lookup to the
@@ -9226,50 +8792,44 @@
SymName, PredOrFunc, Arity, ArgTypes, Status, Context,
Module1, Module, Info1, Info).
-:- pred module_add_fact_table_proc(proc_id, proc_id, proc_table, sym_name,
- pred_or_func, arity, list(type), import_status,
- prog_context, module_info, module_info, qual_info, qual_info,
- io__state, io__state).
-:- mode module_add_fact_table_proc(in, in, in, in, in, in, in, in, in, in,
- out, in, out, di, uo) is det.
+:- pred module_add_fact_table_proc(proc_id::in, proc_id::in, proc_table::in,
+ sym_name::in, pred_or_func::in, arity::in, list(type)::in,
+ import_status::in, prog_context::in, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, io__state::di, io__state::uo) is det.
module_add_fact_table_proc(ProcID, PrimaryProcID, ProcTable, SymName,
- PredOrFunc, Arity, ArgTypes, Status, Context,
- Module0, Module, Info0, Info) -->
- { map__lookup(ProcTable, ProcID, ProcInfo) },
- { varset__init(VarSet0) },
- { varset__new_vars(VarSet0, Arity, Vars, VarSet) },
- { proc_info_argmodes(ProcInfo, Modes) },
- { fact_table_pragma_vars(Vars, Modes, VarSet, PragmaVars) },
+ PredOrFunc, Arity, ArgTypes, Status, Context, !Module,
+ !Info, !IO) :-
+ map__lookup(ProcTable, ProcID, ProcInfo),
+ varset__init(VarSet0),
+ varset__new_vars(VarSet0, Arity, Vars, VarSet),
+ proc_info_argmodes(ProcInfo, Modes),
+ fact_table_pragma_vars(Vars, Modes, VarSet, PragmaVars),
fact_table_generate_c_code(SymName, PragmaVars, ProcID, PrimaryProcID,
- ProcInfo, ArgTypes, Module0, C_ProcCode, C_ExtraCode),
+ ProcInfo, ArgTypes, !.Module, C_ProcCode, C_ExtraCode, !IO),
% XXX this should be modified to use nondet pragma c_code.
- { default_attributes(c, Attrs0) },
- { set_may_call_mercury(Attrs0, will_not_call_mercury, Attrs1) },
- { set_thread_safe(Attrs1, thread_safe, Attrs2) },
+ default_attributes(c, Attrs0),
+ set_may_call_mercury(Attrs0, will_not_call_mercury, Attrs1),
+ set_thread_safe(Attrs1, thread_safe, Attrs2),
% fact tables procedures should be considered pure
- { set_purity(Attrs2, pure, Attrs) },
+ set_purity(Attrs2, pure, Attrs),
module_add_pragma_foreign_proc(Attrs, SymName, PredOrFunc,
PragmaVars, VarSet, ordinary(C_ProcCode, no),
- Status, Context, Module0, Module1, Info0, Info),
- {
- C_ExtraCode = ""
- ->
- Module2 = Module1
+ Status, Context, !Module, !Info, !IO),
+ ( C_ExtraCode = "" ->
+ true
;
- module_add_foreign_body_code(c, C_ExtraCode, Context,
- Module1, Module2)
- },
+ module_add_foreign_body_code(c, C_ExtraCode, Context, !Module)
+ ),
%
% The C code for fact tables includes C labels;
% we cannot inline this code, because if we try,
% the result may be duplicate labels in the generated code.
% So we must disable inlining for fact_table procedures.
%
- add_pred_marker(Module2, "fact_table", SymName, Arity,
- Status, Context, no_inline, [], Module).
-
+ add_pred_marker("fact_table", SymName, Arity, Status, Context,
+ no_inline, [], !Module, !IO).
% Create a list(pragma_var) that looks like the ones that are created
% for pragma c_code in prog_io.m.
@@ -9293,7 +8853,6 @@
PragmaVars0 = []
).
-
%-----------------------------------------------------------------------------%
%
% promise ex error checking
@@ -9407,7 +8966,6 @@
)
).
-
% called for any error in the above checks
:- pred promise_ex_error(promise_type, prog_context, string,
io__state, io__state).
@@ -9483,7 +9041,6 @@
:- type hlds_goal_svar_infos == list(hlds_goal_svar_info).
-
% Create a new svar_info set up to start processing a clause head.
%
:- func new_svar_info = svar_info.
@@ -9550,7 +9107,6 @@
)
).
-
:- pred svar_info `has_svar_colon_mapping_for` svar.
:- mode in `has_svar_colon_mapping_for` in is semidet.
@@ -9613,7 +9169,6 @@
)
).
-
:- func svar_info `with_updated_svar` svar = svar_info.
SInfo `with_updated_svar` StateVar =
@@ -9648,7 +9203,6 @@
varset__new_named_var(VarSet0, NameD, VarD, VarSet),
SInfo = ( SInfo0 ^ dot ^ elem(StateVar) := VarD ).
-
:- pred new_colon_state_var(svar, prog_var,
prog_varset, prog_varset, svar_info, svar_info).
:- mode new_colon_state_var(in, out, in, out, in, out) is det.
@@ -9660,7 +9214,6 @@
varset__new_named_var(VarSet0, NameC, VarC, VarSet),
SInfo = ( SInfo0 ^ colon ^ elem(StateVar) := VarC ).
-
:- pred new_final_state_var(svar, prog_var,
prog_varset, prog_varset, svar_info, svar_info).
:- mode new_final_state_var(in, out, in, out, in, out) is det.
@@ -9731,7 +9284,6 @@
Unifiers = svar_unifiers(Context, FinalSVarMap, SInfo ^ dot),
conj_list_to_goal(HeadGoals ++ BodyGoals ++ Unifiers, GoalInfo, Goal).
-
:- func svar_unifiers(prog_context, svar_map, svar_map) = hlds_goals.
svar_unifiers(Context, LHSMap, RHSMap) =
@@ -9764,7 +9316,6 @@
list__foldl2(add_new_local_state_var, StateVars,
VarSet0, VarSet, SInfo0, SInfo).
-
:- pred add_new_local_state_var(svar, prog_varset, prog_varset,
svar_info, svar_info).
:- mode add_new_local_state_var(in, in, out, in, out) is det.
@@ -9791,7 +9342,6 @@
SInfoBefore ^ colon,
SInfo0 ^ colon) ).
-
:- func svar_mappings(svar_map, svars) = svars.
svar_mappings(_, [] ) = [].
@@ -9802,7 +9352,6 @@
else svar_mappings(Map, StateVars)
).
-
:- func del_locals(svars, svar_map, svar_map) = svar_map.
del_locals(StateVars, MapBefore, Map) =
@@ -9865,7 +9414,6 @@
Else = add_disj_unifiers(Context, SInfo, StateVars,
{Else0, SInfoE}).
-
% If a new mapping was produced for state variable X in the
% condition-goal (i.e. the condition refers to !:X), but not
% in the then-goal, then we have to add a new unifier !:X = !.X
@@ -9910,7 +9458,6 @@
next_svar_mappings(N, StateVars, VarSet0, VarSet, Map) :-
next_svar_mappings_2(N, StateVars, VarSet0, VarSet, map__init, Map).
-
:- pred next_svar_mappings_2(int, svars, prog_varset, prog_varset,
svar_map, svar_map).
:- mode next_svar_mappings_2(in, in, in, out, in, out) is det.
@@ -9950,7 +9497,6 @@
add_disj_unifiers(Context, SInfo, StateVars),
DisjSInfos).
-
% Each arm of a disjunction may have a different mapping for
% !.X and/or !:X. The reconciled svar_info for the disjunction
% takes the highest numbered mapping for each disjunct (each
@@ -9983,7 +9529,6 @@
SInfo0
).
-
:- func union_dot_svars(svar_set, hlds_goal_svar_infos) = svar_set.
union_dot_svars(Dots, [] ) = Dots.
@@ -9995,7 +9540,6 @@
DisjSInfos
).
-
:- func union_colon_svars(svar_set, hlds_goal_svar_infos) = svar_set.
union_colon_svars(Colons, [] ) = Colons.
@@ -10007,7 +9551,6 @@
DisjSInfos
).
-
:- func reconciled_svar_infos(prog_varset, svar_set, svar_set,
hlds_goal_svar_info, svar_info) = svar_info.
@@ -10025,7 +9568,6 @@
),
SInfo = ( SInfo2 ^ num := max(SInfo0 ^ num, SInfoX ^ num) ).
-
:- func reconciled_svar_infos_dots(prog_varset, svar_info, svar, svar_info) =
svar_info.
@@ -10051,7 +9593,6 @@
SInfo = SInfo0
).
-
:- func reconciled_svar_infos_colons(prog_varset, svar_info, svar, svar_info) =
svar_info.
@@ -10077,7 +9618,6 @@
SInfo = SInfo0
).
-
:- func add_disj_unifiers(prog_context, svar_info, svars,
hlds_goal_svar_info) = hlds_goal.
@@ -10089,7 +9629,6 @@
goal_to_conj_list(GoalX, GoalsX),
conj_list_to_goal(GoalsX ++ Unifiers, GoalInfo, Goal).
-
:- func add_disj_unifier(prog_context, svar_info, svar_info, svar,
hlds_goals) = hlds_goals.
@@ -10121,14 +9660,12 @@
compare_svar_names(R, A, B) :-
compare(R, int_suffix_of(A), int_suffix_of(B)).
-
% Find the number suffix at the end of a string as an int.
%
:- func int_suffix_of(string) = int.
int_suffix_of(S) = int_suffix_2(S, length(S) - 1, 1, 0).
-
% int_suffix_2(String, Index, RadixOfIndexDigit, IntSoFar) = IntSuffix
%
:- func int_suffix_2(string, int, int, int) = int.
@@ -10183,50 +9720,46 @@
% been processing a function call which must appear as an
% expression and hence occur inside an atomic context.)
%
-:- pred finish_call(prog_varset, prog_varset, svar_info, svar_info).
-:- mode finish_call(in, out, in, out) is det.
+:- pred finish_call(prog_varset::in, prog_varset::out,
+ svar_info::in, svar_info::out) is det.
-finish_call(VarSet0, VarSet, SInfo0, SInfo) :-
- ( if SInfo0 ^ ctxt = in_atom(UpdatedStateVars, ParentSInfo0) then
- ParentSInfo = ( ParentSInfo0 ^ dot := SInfo0 ^ dot ),
- ( if ParentSInfo ^ ctxt = in_atom(_, GrandParentSInfo) then
- VarSet = VarSet0,
- SInfo = ( ParentSInfo ^ ctxt :=
- in_atom(UpdatedStateVars,
- GrandParentSInfo) )
- else
+finish_call(!VarSet, !SInfo) :-
+ ( !.SInfo ^ ctxt = in_atom(UpdatedStateVars, ParentSInfo0) ->
+ ParentSInfo = ( ParentSInfo0 ^ dot := !.SInfo ^ dot ),
+ ( ParentSInfo ^ ctxt = in_atom(_, GrandParentSInfo) ->
+ !:SInfo = ( ParentSInfo ^ ctxt :=
+ in_atom(UpdatedStateVars, GrandParentSInfo) )
+ ;
prepare_for_next_conjunct(UpdatedStateVars,
- VarSet0, VarSet, ParentSInfo, SInfo)
+ !VarSet, ParentSInfo, !:SInfo)
)
- else
+ ;
error("make_hlds__finish_call: ctxt is not in_atom")
).
%------------------------------------------------------------------------------%
-:- pred prepare_for_if_then_else_goal(svars, prog_varset, prog_varset,
- svar_info, svar_info).
-:- mode prepare_for_if_then_else_goal(in, in, out, in, out) is det.
+:- pred prepare_for_if_then_else_goal(svars::in,
+ prog_varset::in, prog_varset::out, svar_info::in, svar_info::out)
+ is det.
-prepare_for_if_then_else_goal(StateVars, VarSet0, VarSet, SInfo0, SInfo) :-
- prepare_for_local_state_vars(StateVars, VarSet0, VarSet, SInfo0, SInfo).
+prepare_for_if_then_else_goal(StateVars, !VarSet, !SInfo) :-
+ prepare_for_local_state_vars(StateVars, !VarSet, !SInfo).
%------------------------------------------------------------------------------%
-:- pred finish_if_then_else_goal_condition(svars,
- svar_info, svar_info, svar_info, svar_info).
-:- mode finish_if_then_else_goal_condition(in, in, in, out, out) is det.
+:- pred finish_if_then_else_goal_condition(svars::in,
+ svar_info::in, svar_info::in, svar_info::out, svar_info::out) is det.
-finish_if_then_else_goal_condition(StateVars,
- SInfoBefore, SInfoA0, SInfoA, SInfoB) :-
+finish_if_then_else_goal_condition(StateVars, SInfoBefore, SInfoA0, SInfoA,
+ SInfoB) :-
SInfoB = SInfoA0,
finish_local_state_vars(StateVars, _, SInfoBefore, SInfoA0, SInfoA).
%------------------------------------------------------------------------------%
-:- pred finish_if_then_else_goal_then_goal(svars,
- svar_info, svar_info, svar_info).
-:- mode finish_if_then_else_goal_then_goal(in, in, in, out) is det.
+:- pred finish_if_then_else_goal_then_goal(svars::in,
+ svar_info::in, svar_info::in, svar_info::out) is det.
finish_if_then_else_goal_then_goal(StateVars, SInfoBefore, SInfoB0, SInfoB) :-
finish_local_state_vars(StateVars, _, SInfoBefore, SInfoB0, SInfoB).
@@ -10239,21 +9772,20 @@
% quantifier.) The StateVars are local to the condition and then-
% goal.
%
-:- pred prepare_for_if_then_else_expr(svars, prog_varset, prog_varset,
- svar_info, svar_info).
-:- mode prepare_for_if_then_else_expr(in, in, out, in, out) is det.
+:- pred prepare_for_if_then_else_expr(svars::in,
+ prog_varset::in, prog_varset::out, svar_info::in, svar_info::out)
+ is det.
-prepare_for_if_then_else_expr(StateVars, VarSet0, VarSet, SInfo0, SInfo) :-
- SInfo1 = ((( new_svar_info ^ ctxt := in_body )
- ^ external_dot := SInfo0 ^ dot )
- ^ num := SInfo0 ^ num ),
- prepare_for_local_state_vars(StateVars, VarSet0, VarSet,
- SInfo1, SInfo).
+prepare_for_if_then_else_expr(StateVars, !VarSet, !SInfo) :-
+ !:SInfo = ((( new_svar_info ^ ctxt := in_body )
+ ^ external_dot := !.SInfo ^ dot )
+ ^ num := !.SInfo ^ num ),
+ prepare_for_local_state_vars(StateVars, !VarSet, !SInfo).
%------------------------------------------------------------------------------%
-:- pred finish_if_then_else_expr_condition(svar_info, svar_info, svar_info).
-:- mode finish_if_then_else_expr_condition(in, in, out) is det.
+:- pred finish_if_then_else_expr_condition(svar_info::in,
+ svar_info::in, svar_info::out) is det.
finish_if_then_else_expr_condition(SInfoBefore, SInfo0, SInfo) :-
SInfo = (((( SInfo0 ^ external_dot := SInfoBefore ^ external_dot )
@@ -10265,9 +9797,8 @@
%------------------------------------------------------------------------------%
-:- pred finish_if_then_else_expr_then_goal(svars,
- svar_info, svar_info, svar_info).
-:- mode finish_if_then_else_expr_then_goal(in, in, in, out) is det.
+:- pred finish_if_then_else_expr_then_goal(svars::in,
+ svar_info::in, svar_info::in, svar_info::out) is det.
finish_if_then_else_expr_then_goal(StateVars, SInfoBefore, SInfo0, SInfo) :-
finish_local_state_vars(StateVars, _, SInfoBefore, SInfo0, SInfo).
@@ -10292,25 +9823,24 @@
%
% p(X0, X1) and [!.X -> X1, !:X -> X2]
%
-:- pred prepare_for_next_conjunct(svar_set, prog_varset, prog_varset,
- svar_info, svar_info).
-:- mode prepare_for_next_conjunct(in, in, out, in, out) is det.
+:- pred prepare_for_next_conjunct(svar_set::in,
+ prog_varset::in, prog_varset::out, svar_info::in, svar_info::out)
+ is det.
-prepare_for_next_conjunct(UpdatedStateVars, VarSet0, VarSet, SInfo0, SInfo) :-
- Dot0 = SInfo0 ^ dot,
- Colon0 = SInfo0 ^ colon,
- N = SInfo0 ^ num + 1,
+prepare_for_next_conjunct(UpdatedStateVars, !VarSet, !SInfo) :-
+ Dot0 = !.SInfo ^ dot,
+ Colon0 = !.SInfo ^ colon,
+ N = !.SInfo ^ num + 1,
map__init(Nil),
map__foldl(next_dot_mapping(UpdatedStateVars, Dot0, Colon0), Colon0,
Nil, Dot),
map__foldl2(next_colon_mapping(UpdatedStateVars, Colon0, N), Colon0,
- VarSet0, VarSet, Nil, Colon),
- SInfo = (((( SInfo0 ^ ctxt := in_body )
+ !VarSet, Nil, Colon),
+ !:SInfo = (((( !.SInfo ^ ctxt := in_body )
^ num := N )
^ dot := Dot )
^ colon := Colon ).
-
% If the state variable has been updated (i.e. there was a !:X
% reference) then the next !.X mapping will be the current !:X
% mapping.
@@ -10331,7 +9861,6 @@
else Dot = Dot0
).
-
% If the state variable has been updated (i.e. there was a !:X
% reference) then create a new mapping for the next !:X.
% Otherwise, the next !:X mapping is the same as the current
@@ -10352,7 +9881,6 @@
OldColon ^ det_elem(StateVar) )
).
-
:- pred next_svar_mapping(int, svar, prog_var, prog_varset, prog_varset,
svar_map, svar_map).
:- mode next_svar_mapping(in, in, out, in, out, in, out) is det.
@@ -10372,18 +9900,16 @@
expand_bang_state_var_args(Args) =
list__foldr(expand_bang_state_var, Args, []).
-
-:- func expand_bang_state_var(prog_term, list(prog_term)) =
- list(prog_term).
+:- func expand_bang_state_var(prog_term, list(prog_term)) = list(prog_term).
expand_bang_state_var(T @ variable(_), Ts) = [T | Ts].
expand_bang_state_var(T @ functor(Const, Args, Ctxt), Ts) =
- ( if Const = atom("!"), Args = [variable(_StateVar)] then
+ ( Const = atom("!"), Args = [variable(_StateVar)] ->
[ functor(atom("!."), Args, Ctxt),
functor(atom("!:"), Args, Ctxt)
| Ts ]
- else
+ ;
[ T | Ts ]
).
@@ -10397,7 +9923,6 @@
expand_bang_state_var_args_in_instance_method_heads(concrete(Methods)) =
concrete(list__map(expand_method_bsvs, Methods)).
-
:- func expand_method_bsvs(instance_method) = instance_method.
expand_method_bsvs(IM) = IM :-
@@ -10414,7 +9939,6 @@
),
IM = instance_method(PredOrFunc, Method, clauses(Cs), Arity, Ctxt).
-
% The instance method clause items will all be clause items.
%
:- func expand_item_bsvs(item) = item.
@@ -10447,26 +9971,19 @@
substitute_state_var_mappings(Args0, Args,
VarSet1, VarSet, SInfo1, SInfo ).
+:- pred substitute_state_var_mapping(prog_term::in, prog_term::out,
+ prog_varset::in, prog_varset::out, svar_info::in, svar_info::out,
+ io::di, io::uo) is det.
-:- pred substitute_state_var_mapping(prog_term, prog_term,
- prog_varset, prog_varset, svar_info, svar_info, io, io).
-:- mode substitute_state_var_mapping(in, out, in, out, in, out, di, uo) is det.
-
-substitute_state_var_mapping(Arg0, Arg, VarSet0, VarSet, SInfo0, SInfo) -->
- ( if
- { Arg0 = functor(atom("!."), [variable(StateVar)], Context) }
- then
- dot(Context, StateVar, Var, VarSet0, VarSet, SInfo0, SInfo),
- { Arg = variable(Var) }
- else if
- { Arg0 = functor(atom("!:"), [variable(StateVar)], Context) }
- then
- colon(Context, StateVar, Var, VarSet0, VarSet, SInfo0, SInfo),
- { Arg = variable(Var) }
- else
- { VarSet = VarSet0 },
- { SInfo = SInfo0 },
- { Arg = Arg0 }
+substitute_state_var_mapping(Arg0, Arg, !VarSet, !SInfo, !IO) :-
+ ( Arg0 = functor(atom("!."), [variable(StateVar)], Context) ->
+ dot(Context, StateVar, Var, !VarSet, !SInfo, !IO),
+ Arg = variable(Var)
+ ; Arg0 = functor(atom("!:"), [variable(StateVar)], Context) ->
+ colon(Context, StateVar, Var, !VarSet, !SInfo, !IO),
+ Arg = variable(Var)
+ ;
+ Arg = Arg0
).
%------------------------------------------------------------------------------%
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.292
diff -u -b -r1.292 mercury_compile.m
--- compiler/mercury_compile.m 24 Oct 2003 06:17:42 -0000 1.292
+++ compiler/mercury_compile.m 30 Oct 2003 03:54:05 -0000
@@ -2368,68 +2368,64 @@
:- mode mercury_compile__backend_pass_by_preds_2(in, in, out, in, out, out,
di, uo) is det.
-mercury_compile__backend_pass_by_preds_2([], ModuleInfo, ModuleInfo,
- GlobalData, GlobalData, []) --> [].
-mercury_compile__backend_pass_by_preds_2([PredId | PredIds], ModuleInfo0,
- ModuleInfo, GlobalData0, GlobalData, Code) -->
- { module_info_preds(ModuleInfo0, PredTable) },
- { map__lookup(PredTable, PredId, PredInfo) },
- { ProcIds = pred_info_non_imported_procids(PredInfo) },
+mercury_compile__backend_pass_by_preds_2([], !ModuleInfo, !GlobalData, [],
+ !IO).
+mercury_compile__backend_pass_by_preds_2([PredId | PredIds], !ModuleInfo,
+ !GlobalData, Code, !IO) :-
+ module_info_preds(!.ModuleInfo, PredTable),
+ map__lookup(PredTable, PredId, PredInfo),
+ ProcIds = pred_info_non_imported_procids(PredInfo),
(
- { ProcIds = []
+ ( ProcIds = []
; hlds_pred__pred_info_is_aditi_relation(PredInfo)
- }
+ )
->
- { ModuleInfo3 = ModuleInfo0 },
- { GlobalData1 = GlobalData0 },
- { Code1 = [] }
+ Code1 = []
;
- globals__io_lookup_bool_option(verbose, Verbose),
- ( { Verbose = yes } ->
- io__write_string("% Generating code for "),
- hlds_out__write_pred_id(ModuleInfo0, PredId),
- io__write_string("\n")
+ globals__io_lookup_bool_option(verbose, Verbose, !IO),
+ ( Verbose = yes ->
+ io__write_string("% Generating code for ", !IO),
+ hlds_out__write_pred_id(!.ModuleInfo, PredId, !IO),
+ io__write_string("\n", !IO)
;
- []
+ true
),
(
- { PredModule = pred_info_module(PredInfo) },
- { PredName = pred_info_name(PredInfo) },
- { PredArity = pred_info_arity(PredInfo) },
- { no_type_info_builtin(PredModule, PredName,
- PredArity) }
+ PredModule = pred_info_module(PredInfo),
+ PredName = pred_info_name(PredInfo),
+ PredArity = pred_info_arity(PredInfo),
+ no_type_info_builtin(PredModule, PredName,
+ PredArity)
->
% These predicates should never be traced,
% since they do not obey typeinfo_liveness.
% Since they may be opt_imported into other
% modules, we must switch off the tracing
% of such preds on a pred-by-pred basis.
- { module_info_globals(ModuleInfo0, Globals0) },
- { globals__get_trace_level(Globals0, TraceLevel) },
- { globals__set_trace_level_none(Globals0, Globals1) },
- { module_info_set_globals(ModuleInfo0, Globals1,
- ModuleInfo1) },
- { copy(Globals1, Globals1Unique) },
- globals__io_set_globals(Globals1Unique),
+ module_info_globals(!.ModuleInfo, Globals0),
+ globals__get_trace_level(Globals0, TraceLevel),
+ globals__set_trace_level_none(Globals0, Globals1),
+ module_info_set_globals(Globals1, !ModuleInfo),
+ copy(Globals1, Globals1Unique),
+ globals__io_set_globals(Globals1Unique, !IO),
mercury_compile__backend_pass_by_preds_3(ProcIds,
- PredId, PredInfo, ModuleInfo1, ModuleInfo2,
- GlobalData0, GlobalData1, Code1),
- { module_info_globals(ModuleInfo2, Globals2) },
- { globals__set_trace_level(Globals2, TraceLevel,
- Globals) },
- { module_info_set_globals(ModuleInfo2, Globals,
- ModuleInfo3) },
- { copy(Globals, GlobalsUnique) },
- globals__io_set_globals(GlobalsUnique)
+ PredId, PredInfo, !ModuleInfo, !GlobalData,
+ Code1, !IO),
+ module_info_globals(!.ModuleInfo, Globals2),
+ globals__set_trace_level(Globals2, TraceLevel,
+ Globals),
+ module_info_set_globals(Globals, !ModuleInfo),
+ copy(Globals, GlobalsUnique),
+ globals__io_set_globals(GlobalsUnique, !IO)
;
mercury_compile__backend_pass_by_preds_3(ProcIds,
- PredId, PredInfo, ModuleInfo0, ModuleInfo3,
- GlobalData0, GlobalData1, Code1)
+ PredId, PredInfo, !ModuleInfo, !GlobalData,
+ Code1, !IO)
)
),
- mercury_compile__backend_pass_by_preds_2(PredIds,
- ModuleInfo3, ModuleInfo, GlobalData1, GlobalData, Code2),
- { list__append(Code1, Code2, Code) }.
+ mercury_compile__backend_pass_by_preds_2(PredIds, !ModuleInfo,
+ !GlobalData, Code2, !IO),
+ list__append(Code1, Code2, Code).
:- pred mercury_compile__backend_pass_by_preds_3(list(proc_id), pred_id,
pred_info, module_info, module_info, global_data, global_data,
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.75
diff -u -b -r1.75 ml_code_util.m
--- compiler/ml_code_util.m 24 Oct 2003 06:17:42 -0000 1.75
+++ compiler/ml_code_util.m 29 Oct 2003 16:44:25 -0000
@@ -2387,8 +2387,8 @@
%
% Save the new information back in the ml_gen_info
%
- module_info_set_pred_proc_info(ModuleInfo1, PredId, ProcId,
- PredInfo, ProcInfo, ModuleInfo),
+ module_info_set_pred_proc_info(PredId, ProcId, PredInfo, ProcInfo,
+ ModuleInfo1, ModuleInfo),
proc_info_varset(ProcInfo, VarSet),
proc_info_vartypes(ProcInfo, VarTypes),
MLGenInfo = (((MLGenInfo0 ^ module_info := ModuleInfo)
Index: compiler/modecheck_call.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_call.m,v
retrieving revision 1.46
diff -u -b -r1.46 modecheck_call.m
--- compiler/modecheck_call.m 24 Oct 2003 06:17:44 -0000 1.46
+++ compiler/modecheck_call.m 30 Oct 2003 07:19:20 -0000
@@ -504,7 +504,7 @@
% and insert it into the queue of requested procedures.
%
unify_proc__request_proc(PredId, Modes, InstVarSet, yes(ArgLives),
- MaybeDet, Context, ModuleInfo0, ProcId, ModuleInfo),
+ MaybeDet, Context, ProcId, ModuleInfo0, ModuleInfo),
mode_info_set_module_info(ModeInfo0, ModuleInfo, ModeInfo1),
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.273
diff -u -b -r1.273 modes.m
--- compiler/modes.m 24 Oct 2003 06:17:44 -0000 1.273
+++ compiler/modes.m 30 Oct 2003 04:42:49 -0000
@@ -428,8 +428,8 @@
% analyze the procedures whose "can-process" flag was no;
% those procedures were inserted into the unify requests queue.
- modecheck_queued_procs(WhatToCheck, OldPredTable0,
- ModuleInfo2, OldPredTable, ModuleInfo3, Changed2),
+ modecheck_queued_procs(WhatToCheck, OldPredTable0, OldPredTable,
+ ModuleInfo2, ModuleInfo3, Changed2),
io__get_exit_status(ExitStatus),
{ bool__or(Changed1, Changed2, Changed) },
@@ -503,11 +503,11 @@
% PredIds from OldPredTable into ModuleInfo0, giving ModuleInfo.
:- pred copy_pred_bodies(pred_table, list(pred_id), module_info, module_info).
:- mode copy_pred_bodies(in, in, in, out) is det.
-copy_pred_bodies(OldPredTable, PredIds, ModuleInfo0, ModuleInfo) :-
- module_info_preds(ModuleInfo0, PredTable0),
+copy_pred_bodies(OldPredTable, PredIds, !ModuleInfo) :-
+ module_info_preds(!.ModuleInfo, PredTable0),
list__foldl(copy_pred_body(OldPredTable), PredIds,
PredTable0, PredTable),
- module_info_set_preds(ModuleInfo0, PredTable, ModuleInfo).
+ module_info_set_preds(PredTable, !ModuleInfo).
% copy_pred_body(OldPredTable, ProcId, PredTable0, PredTable):
% copy the procedure bodies for all procedures of the specified
@@ -554,20 +554,18 @@
:- mode modecheck_pred_modes_2(in, in, in, in, out, in, out, in, out, di, uo)
is det.
-modecheck_pred_modes_2([], _, _, ModuleInfo, ModuleInfo, Changed, Changed,
- NumErrors, NumErrors) --> [].
+modecheck_pred_modes_2([], _, _, !ModuleInfo, !Changed, !NumErrors, !IO).
modecheck_pred_modes_2([PredId | PredIds], WhatToCheck, MayChangeCalledProc,
- ModuleInfo0, ModuleInfo, Changed0, Changed,
- NumErrors0, NumErrors) -->
- { module_info_preds(ModuleInfo0, Preds0) },
- { map__lookup(Preds0, PredId, PredInfo0) },
+ !ModuleInfo, !Changed, !NumErrors, !IO) :-
+ module_info_preds(!.ModuleInfo, Preds0),
+ map__lookup(Preds0, PredId, PredInfo0),
(
(
%
% don't modecheck imported predicates
%
- ( { pred_info_is_imported(PredInfo0) }
- ; { pred_info_is_pseudo_imported(PredInfo0) }
+ ( pred_info_is_imported(PredInfo0)
+ ; pred_info_is_pseudo_imported(PredInfo0)
)
;
%
@@ -575,34 +573,30 @@
% are generated already mode-correct and with
% correct instmap deltas.
%
- { pred_info_get_markers(PredInfo0, PredMarkers) },
- { check_marker(PredMarkers, class_method) }
+ pred_info_get_markers(PredInfo0, PredMarkers),
+ check_marker(PredMarkers, class_method)
)
->
- { ModuleInfo3 = ModuleInfo0 },
- { Changed1 = Changed0 },
- { NumErrors1 = NumErrors0 }
+ true
;
- write_modes_progress_message(PredId, PredInfo0, ModuleInfo0,
- WhatToCheck),
+ write_modes_progress_message(PredId, PredInfo0, !.ModuleInfo,
+ WhatToCheck, !IO),
modecheck_pred_mode_2(PredId, PredInfo0, WhatToCheck,
- MayChangeCalledProc, ModuleInfo0, ModuleInfo1,
- Changed0, Changed1, ErrsInThisPred),
- { ErrsInThisPred = 0 ->
- ModuleInfo3 = ModuleInfo1
+ MayChangeCalledProc, !ModuleInfo, !Changed,
+ ErrsInThisPred, !IO),
+ ( ErrsInThisPred = 0 ->
+ true
;
- module_info_num_errors(ModuleInfo1, ModNumErrors0),
+ module_info_num_errors(!.ModuleInfo, ModNumErrors0),
ModNumErrors1 = ModNumErrors0 + ErrsInThisPred,
- module_info_set_num_errors(ModuleInfo1, ModNumErrors1,
- ModuleInfo2),
- module_info_remove_predid(ModuleInfo2, PredId,
- ModuleInfo3)
- },
- { NumErrors1 = NumErrors0 + ErrsInThisPred }
+ module_info_set_num_errors(ModNumErrors1,
+ !ModuleInfo),
+ module_info_remove_predid(PredId, !ModuleInfo)
+ ),
+ !:NumErrors = !.NumErrors + ErrsInThisPred
),
modecheck_pred_modes_2(PredIds, WhatToCheck, MayChangeCalledProc,
- ModuleInfo3, ModuleInfo, Changed1, Changed,
- NumErrors1, NumErrors).
+ !ModuleInfo, !Changed, !NumErrors, !IO).
:- pred write_modes_progress_message(pred_id, pred_info, module_info,
how_to_check_goal, io__state, io__state).
@@ -633,113 +627,101 @@
% Mode-check the code for single predicate.
modecheck_pred_mode(PredId, PredInfo0, WhatToCheck, MayChangeCalledProc,
- ModuleInfo0, ModuleInfo, NumErrors) -->
+ !ModuleInfo, NumErrors) -->
modecheck_pred_mode_2(PredId, PredInfo0, WhatToCheck,
- MayChangeCalledProc, ModuleInfo0, ModuleInfo,
- no, _Changed, NumErrors).
+ MayChangeCalledProc, !ModuleInfo, no, _Changed, NumErrors).
-:- pred modecheck_pred_mode_2(pred_id, pred_info, how_to_check_goal,
- may_change_called_proc, module_info, module_info,
- bool, bool, int, io__state, io__state).
-:- mode modecheck_pred_mode_2(in, in, in, in, in,
- out, in, out, out, di, uo) is det.
+:- pred modecheck_pred_mode_2(pred_id::in, pred_info::in,
+ how_to_check_goal::in, may_change_called_proc::in,
+ module_info::in, module_info::out, bool::in, bool::out, int::out,
+ io__state::di, io__state::uo) is det.
modecheck_pred_mode_2(PredId, PredInfo0, WhatToCheck, MayChangeCalledProc,
- ModuleInfo0, ModuleInfo, Changed0, Changed, NumErrors) -->
- ( { WhatToCheck = check_modes } ->
- { pred_info_procedures(PredInfo0, ProcTable) },
+ !ModuleInfo, !Changed, NumErrors, !IO) :-
+ ( WhatToCheck = check_modes ->
+ pred_info_procedures(PredInfo0, ProcTable),
(
- some [ProcInfo] {
+ some [ProcInfo] (
map__member(ProcTable, _ProcId, ProcInfo),
proc_info_maybe_declared_argmodes(ProcInfo,
yes(_))
- }
+ )
->
- % there was at least one declared modes for this
+ % there was at least one declared mode for this
% procedure
- []
+ true
;
% there were no declared modes for this procedure
maybe_report_error_no_modes(PredId, PredInfo0,
- ModuleInfo0)
+ !.ModuleInfo, !IO)
)
;
- []
+ true
),
% Note that we use pred_info_procids rather than
% pred_info_all_procids here, which means that we
% don't process modes that have already been inferred
% as invalid.
- { ProcIds = pred_info_procids(PredInfo0) },
+ ProcIds = pred_info_procids(PredInfo0),
modecheck_procs(ProcIds, PredId, WhatToCheck, MayChangeCalledProc,
- ModuleInfo0, Changed0, 0,
- ModuleInfo, Changed, NumErrors).
+ !ModuleInfo, !Changed, 0, NumErrors, !IO).
% Iterate over the list of modes for a predicate.
-:- pred modecheck_procs(list(proc_id), pred_id, how_to_check_goal,
- may_change_called_proc, module_info, bool, int,
- module_info, bool, int, io__state, io__state).
-:- mode modecheck_procs(in, in, in, in, in, in, in,
- out, out, out, di, uo) is det.
+:- pred modecheck_procs(list(proc_id)::in, pred_id::in, how_to_check_goal::in,
+ may_change_called_proc::in, module_info::in, module_info::out,
+ bool::in, bool::out, int::in, int::out, io__state::di, io__state::uo)
+ is det.
-modecheck_procs([], _PredId, _, _, ModuleInfo, Changed, Errs,
- ModuleInfo, Changed, Errs) --> [].
+modecheck_procs([], _PredId, _, _, !ModuleInfo, !Changed, !Errs, !IO).
modecheck_procs([ProcId|ProcIds], PredId, WhatToCheck, MayChangeCalledProc,
- ModuleInfo0, Changed0, Errs0,
- ModuleInfo, Changed, Errs) -->
+ !ModuleInfo, !Changed, !Errs, !IO) :-
% mode-check that mode of the predicate
modecheck_proc_2(ProcId, PredId, WhatToCheck, MayChangeCalledProc,
- ModuleInfo0, Changed0,
- ModuleInfo1, Changed1, NumErrors),
- { Errs1 = Errs0 + NumErrors },
+ !ModuleInfo, !Changed, NumErrors, !IO),
+ !:Errs = !.Errs + NumErrors,
% recursively process the remaining modes
modecheck_procs(ProcIds, PredId, WhatToCheck, MayChangeCalledProc,
- ModuleInfo1, Changed1, Errs1,
- ModuleInfo, Changed, Errs).
+ !ModuleInfo, !Changed, !Errs, !IO).
%-----------------------------------------------------------------------------%
% Mode-check the code for predicate in a given mode.
-modecheck_proc(ProcId, PredId, ModuleInfo0, ModuleInfo, NumErrors, Changed) -->
+modecheck_proc(ProcId, PredId, !ModuleInfo, NumErrors, Changed) -->
modecheck_proc(ProcId, PredId, check_modes, may_change_called_proc,
- ModuleInfo0, ModuleInfo, NumErrors, Changed).
+ !ModuleInfo, NumErrors, Changed).
-modecheck_proc(ProcId, PredId, WhatToCheck, MayChangeCalledProc, ModuleInfo0,
- ModuleInfo, NumErrors, Changed) -->
+modecheck_proc(ProcId, PredId, WhatToCheck, MayChangeCalledProc, !ModuleInfo,
+ NumErrors, Changed) -->
modecheck_proc_2(ProcId, PredId, WhatToCheck, MayChangeCalledProc,
- ModuleInfo0, no, ModuleInfo, Changed, NumErrors).
+ !ModuleInfo, no, Changed, NumErrors).
-:- pred modecheck_proc_2(proc_id, pred_id, how_to_check_goal,
- may_change_called_proc, module_info, bool,
- module_info, bool, int, io__state, io__state).
-:- mode modecheck_proc_2(in, in, in, in, in, in, out, out, out, di, uo) is det.
+:- pred modecheck_proc_2(proc_id::in, pred_id::in, how_to_check_goal::in,
+ may_change_called_proc::in, module_info::in, module_info::out,
+ bool::in, bool::out, int::out, io__state::di, io__state::uo) is det.
modecheck_proc_2(ProcId, PredId, WhatToCheck, MayChangeCalledProc,
- ModuleInfo0, Changed0, ModuleInfo, Changed, NumErrors, !IO) :-
+ !ModuleInfo, !Changed, NumErrors, !IO) :-
% get the proc_info from the module_info
- module_info_pred_proc_info(ModuleInfo0, PredId, ProcId,
+ module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
_PredInfo0, ProcInfo0),
( proc_info_can_process(ProcInfo0, no) ->
- ModuleInfo = ModuleInfo0,
- Changed = Changed0,
NumErrors = 0
;
% modecheck it
modecheck_proc_3(ProcId, PredId, WhatToCheck,
- MayChangeCalledProc, ModuleInfo0, ModuleInfo1,
- ProcInfo0, ProcInfo, Changed0, Changed,
- NumErrors, !IO),
+ MayChangeCalledProc, !ModuleInfo, ProcInfo0, ProcInfo,
+ !Changed, NumErrors, !IO),
% save the proc_info back in the module_info
- module_info_preds(ModuleInfo1, Preds1),
+ module_info_preds(!.ModuleInfo, Preds1),
map__lookup(Preds1, PredId, PredInfo1),
pred_info_procedures(PredInfo1, Procs1),
map__set(Procs1, ProcId, ProcInfo, Procs),
pred_info_set_procedures(Procs, PredInfo1, PredInfo),
map__set(Preds1, PredId, PredInfo, Preds),
- module_info_set_preds(ModuleInfo1, Preds, ModuleInfo)
+ module_info_set_preds(Preds, !ModuleInfo)
).
modecheck_proc_info(ProcId, PredId, ModuleInfo0, ProcInfo0,
Index: compiler/passes_aux.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/passes_aux.m,v
retrieving revision 1.57
diff -u -b -r1.57 passes_aux.m
--- compiler/passes_aux.m 24 Oct 2003 06:17:45 -0000 1.57
+++ compiler/passes_aux.m 29 Oct 2003 22:06:49 -0000
@@ -307,23 +307,19 @@
:- mode process_nonimported_pred(in(pred_error_task), pred(in) is semidet, in,
in, out, di, uo) is det.
-process_nonimported_pred(Task, Filter, PredId, ModuleInfo0, ModuleInfo,
- IO0, IO) :-
- module_info_pred_info(ModuleInfo0, PredId, PredInfo0),
+process_nonimported_pred(Task, Filter, PredId, !ModuleInfo, !IO) :-
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
(
( pred_info_is_imported(PredInfo0)
; \+ call(Filter, PredInfo0)
)
->
- ModuleInfo = ModuleInfo0,
- IO = IO0
+ true
;
- call(Task, PredId, ModuleInfo0, ModuleInfo1,
- PredInfo0, PredInfo, WarnCnt, ErrCnt, IO0, IO1),
- module_info_set_pred_info(ModuleInfo1,
- PredId, PredInfo, ModuleInfo2),
- passes_aux__handle_errors(WarnCnt, ErrCnt,
- ModuleInfo2, ModuleInfo, IO1, IO)
+ call(Task, PredId, !ModuleInfo,
+ PredInfo0, PredInfo, WarnCnt, ErrCnt, !IO),
+ module_info_set_pred_info(PredId, PredInfo, !ModuleInfo),
+ passes_aux__handle_errors(WarnCnt, ErrCnt, !ModuleInfo, !IO)
).
:- pred process_nonimported_procs_in_preds(list(pred_id), task, task,
@@ -404,7 +400,7 @@
map__det_update(Procs8, ProcId, Proc, Procs),
pred_info_set_procedures(Procs, Pred8, Pred),
map__det_update(Preds8, PredId, Pred, Preds),
- module_info_set_preds(!.ModuleInfo, Preds, !:ModuleInfo),
+ module_info_set_preds(Preds, !ModuleInfo),
process_nonimported_procs(ProcIds, PredId, !Task, !ModuleInfo, !IO).
Index: compiler/pd_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.27
diff -u -b -r1.27 pd_util.m
--- compiler/pd_util.m 24 Oct 2003 06:17:46 -0000 1.27
+++ compiler/pd_util.m 29 Oct 2003 22:07:13 -0000
@@ -285,8 +285,8 @@
pd_info_get_io_state(IO0),
pd_info_get_pred_info(PredInfo0),
pd_info_get_proc_info(ProcInfo0),
- { module_info_set_pred_proc_info(ModuleInfo0, PredId, ProcId,
- PredInfo0, ProcInfo0, ModuleInfo1) },
+ { module_info_set_pred_proc_info(PredId, ProcId, PredInfo0, ProcInfo0,
+ ModuleInfo0, ModuleInfo1) },
% If we perform generalisation, we shouldn't change any called
% procedures, since that could cause a less efficient version to
@@ -374,8 +374,8 @@
pd_info_get_pred_info(PredInfo),
pd_info_get_proc_info(ProcInfo),
pd_info_get_module_info(ModuleInfo0),
- { module_info_set_pred_proc_info(ModuleInfo0, PredId, ProcId,
- PredInfo, ProcInfo, ModuleInfo) },
+ { module_info_set_pred_proc_info(PredId, ProcId, PredInfo, ProcInfo,
+ ModuleInfo0, ModuleInfo) },
pd_info_set_module_info(ModuleInfo),
{ module_info_globals(ModuleInfo, Globals) },
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.246
diff -u -b -r1.246 polymorphism.m
--- compiler/polymorphism.m 27 Oct 2003 05:36:47 -0000 1.246
+++ compiler/polymorphism.m 29 Oct 2003 22:07:39 -0000
@@ -497,7 +497,7 @@
),
map__det_update(PredTable0, PredId, PredInfo, PredTable),
- module_info_set_preds(!.ModuleInfo, PredTable, !:ModuleInfo).
+ module_info_set_preds(PredTable, !ModuleInfo).
%---------------------------------------------------------------------------%
@@ -543,8 +543,7 @@
ExtraArgModes), ProcIds, Procs0, Procs),
pred_info_set_procedures(Procs, PredInfo2, PredInfo),
- module_info_set_pred_info(!.ModuleInfo, PredId, PredInfo,
- !:ModuleInfo).
+ module_info_set_pred_info(PredId, PredInfo, !ModuleInfo).
:- pred polymorphism__process_clause_info(pred_info::in, module_info::in,
clauses_info::in, clauses_info::out, poly_info::out, list(mode)::out)
@@ -3232,7 +3231,7 @@
% We also mark the predicate as invalid, also to avoid
% flow-on errors.
Detism = nondet,
- module_info_remove_predid(!.ModuleInfo, PredId, !:ModuleInfo)
+ module_info_remove_predid(PredId, !ModuleInfo)
),
% Work out which argument corresponds to the constraint which
@@ -3277,7 +3276,7 @@
),
map__det_update(PredTable0, PredId, PredInfo, PredTable),
- module_info_set_preds(!.ModuleInfo, PredTable, !:ModuleInfo),
+ module_info_set_preds(PredTable, !ModuleInfo),
!:ProcNum = !.ProcNum + 1.
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.58
diff -u -b -r1.58 post_typecheck.m
--- compiler/post_typecheck.m 24 Oct 2003 06:17:46 -0000 1.58
+++ compiler/post_typecheck.m 30 Oct 2003 03:48:23 -0000
@@ -158,21 +158,18 @@
:- mode post_typecheck__finish_preds(in, in, in, out, in, out,
in, out, di, uo) is det.
-post_typecheck__finish_preds([], _, ModuleInfo, ModuleInfo,
- NumErrors, NumErrors,
- PostTypecheckError, PostTypecheckError) --> [].
+post_typecheck__finish_preds([], _, !ModuleInfo, !NumErrors,
+ !PostTypecheckError, !IO).
post_typecheck__finish_preds([PredId | PredIds], ReportTypeErrors,
- ModuleInfo0, ModuleInfo, NumErrors0, NumErrors,
- FoundTypeError0, FoundTypeError) -->
- { module_info_pred_info(ModuleInfo0, PredId, PredInfo0) },
+ !ModuleInfo, !NumErrors, !FoundTypeError, !IO) :-
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
(
- { pred_info_is_imported(PredInfo0)
- ; pred_info_is_pseudo_imported(PredInfo0) }
+ ( pred_info_is_imported(PredInfo0)
+ ; pred_info_is_pseudo_imported(PredInfo0)
+ )
->
- post_typecheck__finish_imported_pred(ModuleInfo0, PredId,
- PredInfo0, PredInfo),
- { NumErrors1 = NumErrors0 },
- { FoundTypeError1 = FoundTypeError0 }
+ post_typecheck__finish_imported_pred(!.ModuleInfo, PredId,
+ PredInfo0, PredInfo, !IO)
;
%
% Only report error messages for unbound type variables
@@ -180,8 +177,8 @@
% a lot of spurious diagnostics.
%
post_typecheck__check_type_bindings(PredId, PredInfo0,
- ModuleInfo0, ReportTypeErrors,
- PredInfo1, UnboundTypeErrsInThisPred),
+ !.ModuleInfo, ReportTypeErrors,
+ PredInfo1, UnboundTypeErrsInThisPred, !IO),
%
% if there were any unsatisfied type class constraints,
@@ -189,26 +186,26 @@
% if we try to continue, so we need to halt compilation
% after this pass.
%
- { UnboundTypeErrsInThisPred \= 0 ->
- FoundTypeError1 = yes
+ ( UnboundTypeErrsInThisPred \= 0 ->
+ !:FoundTypeError = yes
;
- FoundTypeError1 = FoundTypeError0
- },
+ true
+ ),
- { post_typecheck__finish_pred_no_io(ModuleInfo0,
- ErrorProcs, PredInfo1, PredInfo2) },
- report_unbound_inst_vars(ModuleInfo0, PredId,
- ErrorProcs, PredInfo2, PredInfo3),
- check_for_indistinguishable_modes(ModuleInfo0, PredId,
- PredInfo3, PredInfo),
+ post_typecheck__finish_pred_no_io(!.ModuleInfo,
+ ErrorProcs, PredInfo1, PredInfo2),
+ report_unbound_inst_vars(!.ModuleInfo, PredId,
+ ErrorProcs, PredInfo2, PredInfo3, !IO),
+ check_for_indistinguishable_modes(!.ModuleInfo, PredId,
+ PredInfo3, PredInfo, !IO),
%
% check that main/2 has the right type
%
- ( { ReportTypeErrors = yes } ->
- check_type_of_main(PredInfo)
+ ( ReportTypeErrors = yes ->
+ check_type_of_main(PredInfo, !IO)
;
- []
+ true
),
%
@@ -217,20 +214,18 @@
% of type inference -- the types of some Aditi predicates
% may not be known before.
%
- { pred_info_get_markers(PredInfo, Markers) },
- ( { ReportTypeErrors = yes, check_marker(Markers, aditi) } ->
- check_aditi_state(ModuleInfo0, PredInfo)
+ pred_info_get_markers(PredInfo, Markers),
+ ( ReportTypeErrors = yes, check_marker(Markers, aditi) ->
+ check_aditi_state(!.ModuleInfo, PredInfo, !IO)
;
- []
+ true
),
- { NumErrors1 = NumErrors0 + UnboundTypeErrsInThisPred }
+ !:NumErrors = !.NumErrors + UnboundTypeErrsInThisPred
),
- { module_info_set_pred_info(ModuleInfo0, PredId,
- PredInfo, ModuleInfo1) },
+ module_info_set_pred_info(PredId, PredInfo, !ModuleInfo),
post_typecheck__finish_preds(PredIds, ReportTypeErrors,
- ModuleInfo1, ModuleInfo, NumErrors1, NumErrors,
- FoundTypeError1, FoundTypeError).
+ !ModuleInfo, !NumErrors, !FoundTypeError, !IO).
%-----------------------------------------------------------------------------%
% Check for unbound type variables
@@ -764,7 +759,7 @@
{ store_promise(PromiseType, Module0, PromiseId, Module1, Goal) },
% Remove from further processing.
- { module_info_remove_predid(Module1, PromiseId, Module2) },
+ { module_info_remove_predid(PromiseId, Module1, Module2) },
% If the promise is in the interface, then ensure that
% it doesn't refer to any local symbols.
@@ -789,8 +784,8 @@
module_info_assertion_table(Module0, AssertTable0),
assertion_table_add_assertion(PromiseId, AssertTable0,
AssertionId, AssertTable),
- module_info_set_assertion_table(Module0, AssertTable,
- Module1),
+ module_info_set_assertion_table(AssertTable,
+ Module0, Module1),
assertion__goal(AssertionId, Module1, Goal),
assertion__record_preds_used_in(Goal, AssertionId, Module1,
Module)
@@ -807,7 +802,7 @@
module_info_exclusive_table(Module0, Table0),
list__foldl(exclusive_table_add(PromiseId), PredIds, Table0,
Table),
- module_info_set_exclusive_table(Module0, Table, Module)
+ module_info_set_exclusive_table(Table, Module0, Module)
;
% case for exhaustiveness -- XXX not yet implemented
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.62
diff -u -b -r1.62 pragma_c_gen.m
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.224
diff -u -b -r1.224 prog_io.m
--- compiler/prog_io.m 6 Aug 2003 12:38:11 -0000 1.224
+++ compiler/prog_io.m 30 Oct 2003 08:33:24 -0000
@@ -519,21 +519,19 @@
% and that the end_module declaration (if any) is correct,
% and construct the final parsing result.
-:- pred check_end_module(module_end, message_list, item_list, module_error,
- message_list, item_list, module_error, io__state, io__state).
-:- mode check_end_module(in, in, in, in, out, out, out, di, uo) is det.
+:- pred check_end_module(module_end::in, message_list::in, message_list::out,
+ item_list::in, item_list::out, module_error::in, module_error::out)
+ is det.
-check_end_module(EndModule, Messages0, Items0, Error0,
- Messages, Items, Error) -->
+check_end_module(EndModule, !Messages, !Items, !Error) :-
%
% double-check that the first item is a `:- module ModuleName'
% declaration, and remove it from the front of the item list
%
- {
- Items0 = [module_defn(_VarSet, module(ModuleName1)) - _Context1
- | Items1]
+ (
+ !.Items = [Item | !:Items],
+ Item = module_defn(_VarSet, module(ModuleName1)) - _Context1
->
- Items = Items1,
%
% check that the end module declaration (if any)
% matches the begin module declaration
@@ -543,19 +541,18 @@
ModuleName1 \= ModuleName2
->
dummy_term_with_context(Context2, Term),
- add_error(
-"`:- end_module' declaration doesn't match `:- module' declaration",
- Term, Messages0, Messages),
- Error = some_module_errors
+ add_error("`:- end_module' declaration doesn't " ++
+ "match `:- module' declaration",
+ Term, !Messages),
+ !:Error = some_module_errors
;
- Messages = Messages0,
- Error = Error0
+ true
)
;
% if there's no `:- module' declaration at this point, it is
% an internal error -- read_first_item should have inserted one
error("check_end_module: no `:- module' declaration")
- }.
+ ).
%-----------------------------------------------------------------------------%
@@ -627,32 +624,31 @@
%
% We use a continuation-passing style here.
-:- pred read_all_items(module_name, module_name,
- message_list, item_list, module_error,
- io__state, io__state).
-:- mode read_all_items(in, out, out, out, out, di, uo) is det.
+:- pred read_all_items(module_name::in, module_name::out,
+ message_list::out, item_list::out, module_error::out,
+ io__state::di, io__state::uo) is det.
-read_all_items(DefaultModuleName, ModuleName, Messages, Items, Error) -->
+read_all_items(DefaultModuleName, ModuleName, Messages, Items, Error, !IO) :-
%
% read all the items (the first one is handled specially)
%
- io__input_stream(Stream),
- io__input_stream_name(Stream, SourceFileName),
+ io__input_stream(Stream, !IO),
+ io__input_stream_name(Stream, SourceFileName, !IO),
read_first_item(DefaultModuleName, SourceFileName, ModuleName,
- RevMessages0, RevItems0, MaybeSecondTerm, Error0),
+ RevMessages0, RevItems0, MaybeSecondTerm, Error0, !IO),
(
- { MaybeSecondTerm = yes(SecondTerm) },
- { process_read_term(ModuleName, SecondTerm,
- MaybeSecondItem) },
+ MaybeSecondTerm = yes(SecondTerm),
+ process_read_term(ModuleName, SecondTerm,
+ MaybeSecondItem),
read_items_loop_2(MaybeSecondItem, ModuleName, SourceFileName,
- RevMessages0, RevItems0, Error0,
- RevMessages1, RevItems1, Error1)
+ RevMessages0, RevMessages1, RevItems0, RevItems1,
+ Error0, Error1, !IO)
;
- { MaybeSecondTerm = no },
+ MaybeSecondTerm = no,
read_items_loop(ModuleName, SourceFileName,
- RevMessages0, RevItems0, Error0,
- RevMessages1, RevItems1, Error1)
+ RevMessages0, RevMessages1, RevItems0, RevItems1,
+ Error0, Error1, !IO)
),
%
@@ -660,12 +656,11 @@
% check that it matches the initial module declaration (if any),
% and remove both of them from the final item list.
%
- { get_end_module(RevItems1, ModuleName, RevItems, EndModule) },
- check_end_module(EndModule,
- RevMessages1, Items0, Error1,
- RevMessages, Items, Error),
- { list__reverse(RevMessages, Messages) },
- { list__reverse(RevItems, Items0) }.
+ get_end_module(RevItems1, ModuleName, RevItems, EndModule),
+ check_end_module(EndModule, RevMessages1, RevMessages, Items0, Items,
+ Error1, Error),
+ list__reverse(RevMessages, Messages),
+ list__reverse(RevItems, Items0).
%
% We need to jump through a few hoops when reading the first item,
@@ -680,16 +675,16 @@
% and then if it turns out to not be a `:- module' declaration
% we reparse it in the default module scope. Blecchh.
%
-:- pred read_first_item(module_name, file_name, module_name,
- message_list, item_list, maybe(read_term), module_error,
- io__state, io__state).
-:- mode read_first_item(in, in, out, out, out, out, out, di, uo) is det.
+:- pred read_first_item(module_name::in, file_name::in, module_name::out,
+ message_list::out, item_list::out, maybe(read_term)::out,
+ module_error::out, io__state::di, io__state::uo) is det.
read_first_item(DefaultModuleName, SourceFileName, ModuleName,
- Messages, Items, MaybeSecondTerm, Error) -->
-
- globals__io_lookup_bool_option(warn_missing_module_name, WarnMissing),
- globals__io_lookup_bool_option(warn_wrong_module_name, WarnWrong),
+ Messages, Items, MaybeSecondTerm, Error, !IO) :-
+ globals__io_lookup_bool_option(warn_missing_module_name,
+ WarnMissing, !IO),
+ globals__io_lookup_bool_option(warn_wrong_module_name,
+ WarnWrong, !IO),
%
% parse the first term, treating it as occurring
@@ -697,36 +692,34 @@
% (so that any `:- module' declaration is taken to
% be a non-nested module unless explicitly qualified).
%
- parser__read_term(SourceFileName, MaybeFirstTerm),
- { root_module_name(RootModuleName) },
- { process_read_term(RootModuleName, MaybeFirstTerm, MaybeFirstItem) },
+ parser__read_term(SourceFileName, MaybeFirstTerm, !IO),
+ root_module_name(RootModuleName),
+ process_read_term(RootModuleName, MaybeFirstTerm, MaybeFirstItem),
(
%
% apply and then skip `pragma source_file' decls,
% by calling ourselves recursively with the new source
% file name
%
- { MaybeFirstItem = ok(FirstItem, _) },
- { FirstItem = pragma(source_file(NewSourceFileName)) }
+ MaybeFirstItem = ok(FirstItem, _),
+ FirstItem = pragma(source_file(NewSourceFileName))
->
read_first_item(DefaultModuleName, NewSourceFileName,
- ModuleName, Messages, Items, MaybeSecondTerm, Error)
+ ModuleName, Messages, Items, MaybeSecondTerm, Error,
+ !IO)
;
%
% check if the first term was a `:- module' decl
%
- { MaybeFirstItem = ok(FirstItem, FirstContext) },
- { FirstItem = module_defn(_VarSet, ModuleDefn) },
- { ModuleDefn = module(StartModuleName) }
+ MaybeFirstItem = ok(FirstItem, FirstContext),
+ FirstItem = module_defn(_VarSet, ModuleDefn),
+ ModuleDefn = module(StartModuleName)
->
-
%
% if so, then check that it matches the expected
% module name, and if not, report a warning
%
- {
- match_sym_name(StartModuleName, DefaultModuleName)
- ->
+ ( match_sym_name(StartModuleName, DefaultModuleName) ->
ModuleName = DefaultModuleName,
Messages = []
;
@@ -738,9 +731,11 @@
prog_out__sym_name_to_string(StartModuleName,
StartModuleNameString),
string__append_list(["source file `", SourceFileName,
- "' contains module named `", StartModuleNameString,
- "'"], WrongModuleWarning),
- maybe_add_warning(WarnWrong, MaybeFirstTerm, FirstContext,
+ "' contains module named `",
+ StartModuleNameString, "'"],
+ WrongModuleWarning),
+ maybe_add_warning(WarnWrong, MaybeFirstTerm,
+ FirstContext,
WrongModuleWarning, [], Messages),
% Which one should we use here?
@@ -748,41 +743,41 @@
% (computed from the filename)
% but now we use the declared one.
ModuleName = StartModuleName
- },
- { make_module_decl(ModuleName, FirstContext, FixedFirstItem) },
- { Items = [FixedFirstItem] },
- { Error = no_module_errors },
- { MaybeSecondTerm = no }
+ ),
+ make_module_decl(ModuleName, FirstContext, FixedFirstItem),
+ Items = [FixedFirstItem],
+ Error = no_module_errors,
+ MaybeSecondTerm = no
;
%
% if the first term was not a `:- module' decl,
% then issue a warning (if warning enabled), and
% insert an implicit `:- module ModuleName' decl.
%
- { MaybeFirstItem = ok(_FirstItem, FirstContext0) ->
+ ( MaybeFirstItem = ok(_FirstItem, FirstContext0) ->
FirstContext = FirstContext0
;
term__context_init(SourceFileName, 1, FirstContext)
- },
- { WarnMissing = yes ->
+ ),
+ ( WarnMissing = yes ->
dummy_term_with_context(FirstContext, FirstTerm),
- add_warning(
- "module should start with a `:- module' declaration",
- FirstTerm, [], Messages)
+ add_warning("module should start with a " ++
+ "`:- module' declaration", FirstTerm, [],
+ Messages)
;
Messages = []
- },
- { ModuleName = DefaultModuleName },
- { make_module_decl(ModuleName, FirstContext, FixedFirstItem) },
+ ),
+ ModuleName = DefaultModuleName,
+ make_module_decl(ModuleName, FirstContext, FixedFirstItem),
%
% reparse the first term, this time treating it as
% occuring within the scope of the implicit
% `:- module' decl rather than in the root module.
%
- { MaybeSecondTerm = yes(MaybeFirstTerm) },
- { Items = [FixedFirstItem] },
- { Error = no_module_errors }
+ MaybeSecondTerm = yes(MaybeFirstTerm),
+ Items = [FixedFirstItem],
+ Error = no_module_errors
).
:- pred make_module_decl(module_name, term__context, item_and_context).
@@ -817,87 +812,74 @@
% via io__gc_call/1, which called the goal with garbage collection.
% But optimizing for NU-Prolog is no longer a big priority...
-:- pred read_items_loop(module_name, file_name,
- message_list, item_list, module_error,
- message_list, item_list, module_error,
- io__state, io__state).
-:- mode read_items_loop(in, in, in, in, in, out, out, out, di, uo) is det.
+:- pred read_items_loop(module_name::in, file_name::in,
+ message_list::in, message_list::out, item_list::in, item_list::out,
+ module_error::in,module_error::out, io__state::di, io__state::uo)
+ is det.
-read_items_loop(ModuleName, SourceFileName, Msgs1, Items1, Error1,
- Msgs, Items, Error) -->
- read_item(ModuleName, SourceFileName, MaybeItem),
+read_items_loop(ModuleName, SourceFileName, !Msgs, !Items, !Error, !IO) :-
+ read_item(ModuleName, SourceFileName, MaybeItem, !IO),
read_items_loop_2(MaybeItem, ModuleName, SourceFileName,
- Msgs1, Items1, Error1, Msgs, Items, Error).
+ !Msgs, !Items, !Error, !IO).
%-----------------------------------------------------------------------------%
-:- pred read_items_loop_2(maybe_item_or_eof, module_name, file_name,
- message_list, item_list, module_error,
- message_list, item_list, module_error,
- io__state, io__state).
-:- mode read_items_loop_2(in, in, in, in, in, in, out, out, out, di, uo) is det.
+:- pred read_items_loop_2(maybe_item_or_eof::in, module_name::in,
+ file_name::in, message_list::in, message_list::out,
+ item_list::in, item_list::out, module_error::in, module_error::out,
+ io__state::di, io__state::uo) is det.
% do a switch on the type of the next item
-read_items_loop_2(eof, _ModuleName, _SourceFileName, Msgs, Items, Error,
- Msgs, Items, Error) --> [].
+read_items_loop_2(eof, _ModuleName, _SourceFile, !Msgs, !Items, !Error, !IO).
% if the next item was end-of-file, then we're done.
read_items_loop_2(syntax_error(ErrorMsg, LineNumber), ModuleName,
- SourceFileName, Msgs0, Items0, _Error0, Msgs, Items, Error) -->
+ SourceFileName, !Msgs, !Items, _Error0, Error, !IO) :-
% if the next item was a syntax error, then insert it in
% the list of messages and continue looping
- {
term__context_init(SourceFileName, LineNumber, Context),
dummy_term_with_context(Context, Term),
ThisError = ErrorMsg - Term,
- Msgs1 = [ThisError | Msgs0],
- Items1 = Items0,
- Error1 = some_module_errors
- },
- read_items_loop(ModuleName, SourceFileName, Msgs1, Items1, Error1,
- Msgs, Items, Error).
+ !:Msgs = [ThisError | !.Msgs],
+ Error1 = some_module_errors,
+ read_items_loop(ModuleName, SourceFileName, !Msgs, !Items,
+ Error1, Error, !IO).
-read_items_loop_2(error(M, T), ModuleName, SourceFileName,
- Msgs0, Items0, _Error0, Msgs, Items, Error) -->
+read_items_loop_2(error(M, T), ModuleName, SourceFileName, !Msgs, !Items,
+ _Error0, Error, !IO) :-
% if the next item was a semantic error, then insert it in
% the list of messages and continue looping
- {
- add_error(M, T, Msgs0, Msgs1),
- Items1 = Items0,
- Error1 = some_module_errors
- },
- read_items_loop(ModuleName, SourceFileName, Msgs1, Items1, Error1,
- Msgs, Items, Error).
+ add_error(M, T, !Msgs),
+ Error1 = some_module_errors,
+ read_items_loop(ModuleName, SourceFileName, !Msgs, !Items,
+ Error1, Error, !IO).
read_items_loop_2(ok(Item0, Context), ModuleName0, SourceFileName0,
- Msgs0, Items0, Error0, Msgs, Items, Error) -->
-
- ( { Item0 = nothing(yes(Warning)) } ->
- { Warning = item_warning(MaybeOption, Msg, Term) },
- ( { MaybeOption = yes(Option) } ->
- globals__io_lookup_bool_option(Option, Warn)
+ !Msgs, !Items, !Error, !IO) :-
+ ( Item0 = nothing(yes(Warning)) ->
+ Warning = item_warning(MaybeOption, Msg, Term),
+ ( MaybeOption = yes(Option) ->
+ globals__io_lookup_bool_option(Option, Warn, !IO)
;
- { Warn = yes }
+ Warn = yes
),
- ( { Warn = yes } ->
- { add_warning(Msg, Term, Msgs0, Msgs1) },
+ ( Warn = yes ->
+ add_warning(Msg, Term, !Msgs),
- globals__io_lookup_bool_option(halt_at_warn, Halt),
- { Halt = yes ->
- Error1 = some_module_errors
+ globals__io_lookup_bool_option(halt_at_warn, Halt,
+ !IO),
+ ( Halt = yes ->
+ !:Error = some_module_errors
;
- Error1 = Error0
- }
+ true
+ )
;
- { Error1 = Error0 },
- { Msgs1 = Msgs0 }
+ true
),
- { Item = nothing(no) }
+ Item = nothing(no)
;
- { Error1 = Error0 },
- { Msgs1 = Msgs0 },
- { Item = Item0 }
+ Item = Item0
),
% if the next item was a valid item, check whether it was
@@ -907,28 +889,27 @@
% parsing context according. Next, unless the item is a
% `pragma source_file' declaration, insert it into the item list.
% Then continue looping.
- { Item = pragma(source_file(NewSourceFileName)) ->
+ ( Item = pragma(source_file(NewSourceFileName)) ->
SourceFileName = NewSourceFileName,
- ModuleName = ModuleName0,
- Items1 = Items0
+ ModuleName = ModuleName0
; Item = module_defn(_VarSet, module(NestedModuleName)) ->
ModuleName = NestedModuleName,
SourceFileName = SourceFileName0,
- Items1 = [Item - Context | Items0]
+ !:Items = [Item - Context | !.Items]
; Item = module_defn(_VarSet, end_module(NestedModuleName)) ->
root_module_name(RootModuleName),
sym_name_get_module_name(NestedModuleName, RootModuleName,
ParentModuleName),
ModuleName = ParentModuleName,
SourceFileName = SourceFileName0,
- Items1 = [Item - Context | Items0]
+ !:Items = [Item - Context | !.Items]
;
SourceFileName = SourceFileName0,
ModuleName = ModuleName0,
- Items1 = [Item - Context | Items0]
- },
- read_items_loop(ModuleName, SourceFileName, Msgs1, Items1, Error1,
- Msgs, Items, Error).
+ !:Items = [Item - Context | !.Items]
+ ),
+ read_items_loop(ModuleName, SourceFileName, !Msgs, !Items, !Error,
+ !IO).
%-----------------------------------------------------------------------------%
@@ -1004,7 +985,7 @@
Body = term__functor(term__atom("true"), [], TheContext)
),
varset__coerce(VarSet, ProgVarSet),
- parse_goal(Body, ProgVarSet, Body2, ProgVarSet2),
+ parse_goal(Body, Body2, ProgVarSet, ProgVarSet2),
(
Head = term__functor(term__atom("="),
[FuncHead0, FuncResult], _),
@@ -1024,6 +1005,7 @@
:- pred process_pred_clause(maybe_functor, prog_varset, goal, maybe1(item)).
:- mode process_pred_clause(in, in, in, out) is det.
+
process_pred_clause(ok(Name, Args0), VarSet, Body,
ok(clause(VarSet, predicate, Name, Args, Body))) :-
list__map(term__coerce, Args0, Args).
@@ -1033,6 +1015,7 @@
:- pred process_func_clause(maybe_functor, term, prog_varset, goal,
maybe1(item)).
:- mode process_func_clause(in, in, in, in, out) is det.
+
process_func_clause(ok(Name, Args0), Result0, VarSet, Body,
ok(clause(VarSet, function, Name, Args, Body))) :-
list__append(Args0, [Result0], Args1),
@@ -1446,9 +1429,10 @@
:- pred parse_promise(module_name, promise_type, varset, list(term), decl_attrs,
maybe1(item)).
:- mode parse_promise(in, in, in, in, in, out) is semidet.
+
parse_promise(ModuleName, PromiseType, VarSet, [Term], Attributes, Result) :-
varset__coerce(VarSet, ProgVarSet0),
- parse_goal(Term, ProgVarSet0, Goal0, ProgVarSet),
+ parse_goal(Term, Goal0, ProgVarSet0, ProgVarSet),
% get universally quantified variables
( PromiseType = true ->
@@ -1471,6 +1455,7 @@
:- pred parse_type_decl(module_name, varset, term, decl_attrs, maybe1(item)).
:- mode parse_type_decl(in, in, in, in, out) is det.
+
parse_type_decl(ModuleName, VarSet, TypeDecl, Attributes, Result) :-
(
TypeDecl = term__functor(term__atom(Name), Args, _),
@@ -1519,6 +1504,7 @@
:- pred add_warning(string, term, message_list, message_list).
:- mode add_warning(in, in, in, out) is det.
+
add_warning(Warning, Term, Msgs, [Msg - Term | Msgs]) :-
string__append("Warning: ", Warning, Msg).
@@ -1526,6 +1512,7 @@
:- pred add_error(string, term, message_list, message_list).
:- mode add_error(in, in, in, out) is det.
+
add_error(Error, Term, Msgs, [Msg - Term | Msgs]) :-
string__append("Error: ", Error, Msg).
@@ -1570,11 +1557,10 @@
WithType, WithInst, MaybeDeterminism, VarSet, Body4,
Condition, Attributes, R).
-:- pred process_type_decl_pred_or_func(pred_or_func, module_name, maybe(type),
- maybe1(maybe(inst)), maybe1(maybe(determinism)), varset,
- term, condition, decl_attrs, maybe1(item)).
-:- mode process_type_decl_pred_or_func(in, in, in, in, in, in,
- in, in, in, out) is det.
+:- pred process_type_decl_pred_or_func(pred_or_func::in, module_name::in,
+ maybe(type)::in, maybe1(maybe(inst))::in,
+ maybe1(maybe(determinism))::in, varset::in, term::in, condition::in,
+ decl_attrs::in, maybe1(item)::out) is det.
process_type_decl_pred_or_func(PredOrFunc, ModuleName, WithType, WithInst0,
MaybeDeterminism0, VarSet, Body,
@@ -1584,22 +1570,28 @@
(
WithInst0 = ok(WithInst),
( MaybeDeterminism = yes(_), WithInst = yes(_) ->
- R = error("`with_inst` and determinism both specified", Body)
+ R = error("`with_inst` and determinism " ++
+ "both specified", Body)
; WithInst = yes(_), WithType = no ->
- R = error("`with_inst` specified without `with_type`", Body)
+ R = error("`with_inst` specified without " ++
+ "`with_type`", Body)
;
(
- % Function declarations with `with_type` annotations have
- % the same form as predicate declarations.
+ % Function declarations with
+ % `with_type` annotations have the
+ % same form as predicate declarations.
PredOrFunc = function,
WithType = no
->
- process_func(ModuleName, VarSet, Body, Condition,
- MaybeDeterminism, Attributes, R)
+ process_func(ModuleName, VarSet, Body,
+ Condition, MaybeDeterminism,
+ Attributes, R)
;
- process_pred_or_func(PredOrFunc, ModuleName, VarSet,
- Body, Condition, WithType, WithInst,
- MaybeDeterminism, Attributes, R)
+ process_pred_or_func(PredOrFunc,
+ ModuleName, VarSet, Body,
+ Condition, WithType, WithInst,
+ MaybeDeterminism, Attributes,
+ R)
)
)
;
@@ -1635,9 +1627,8 @@
% if Pred is a predicate mode declaration, and binds Condition
% to the condition for that declaration (if any), and Result to
% a representation of the declaration.
-:- pred parse_mode_decl_pred(module_name, varset, term, decl_attrs,
- maybe1(item)).
-:- mode parse_mode_decl_pred(in, in, in, in, out) is det.
+:- pred parse_mode_decl_pred(module_name::in, varset::in, term::in,
+ decl_attrs::in, maybe1(item)::out) is det.
parse_mode_decl_pred(ModuleName, VarSet, Pred, Attributes, Result) :-
get_condition(Pred, Body, Condition),
@@ -1651,11 +1642,12 @@
MaybeDeterminism = yes(_),
WithInst = yes(_)
->
- Result = error("`with_inst` and determinism both specified",
- Body)
+ Result = error("`with_inst` and " ++
+ "determinism both specified", Body)
;
- process_mode(ModuleName, VarSet, Body3, Condition,
- Attributes, WithInst, MaybeDeterminism, Result)
+ process_mode(ModuleName, VarSet, Body3,
+ Condition, Attributes, WithInst,
+ MaybeDeterminism, Result)
)
;
WithInst0 = error(E, T),
@@ -1759,11 +1751,9 @@
->
Body = Body1,
(
- (
Determinism1 = term__functor(term__atom(Determinism2),
[], _Context2),
standard_det(Determinism2, Determinism3)
- )
->
Determinism = ok(yes(Determinism3))
;
@@ -2145,12 +2135,10 @@
Result = error(String, Term)
).
-:- pred process_pred_or_func_2(pred_or_func, maybe_functor, term, varset,
- maybe(type), maybe(inst), maybe(determinism), condition,
- existq_tvars, class_constraints, inst_var_sub,
- decl_attrs, maybe1(item)).
-:- mode process_pred_or_func_2(in, in, in, in, in, in, in,
- in, in, in, in, in, out) is det.
+:- pred process_pred_or_func_2(pred_or_func::in, maybe_functor::in, term::in,
+ varset::in, maybe(type)::in, maybe(inst)::in, maybe(determinism)::in,
+ condition::in, existq_tvars::in, class_constraints::in,
+ inst_var_sub::in, decl_attrs::in, maybe1(item)::out) is det.
process_pred_or_func_2(PredOrFunc, ok(F, As0), PredType, VarSet0,
WithType, WithInst, MaybeDet, Cond, ExistQVars,
@@ -2161,22 +2149,21 @@
WithInst = yes(_),
As = [type_only(_) | _]
->
- Result = error("`with_inst` specified without argument modes",
- PredType)
+ Result = error("`with_inst` specified " ++
+ "without argument modes", PredType)
;
WithInst = no,
WithType = yes(_),
As = [type_and_mode(_, _) | _]
->
- Result = error(
- "arguments have modes but `with_inst` not specified",
- PredType)
+ Result = error("arguments have modes but " ++
+ "`with_inst` not specified", PredType)
;
\+ inst_var_constraints_are_consistent_in_type_and_modes(As)
->
- Result = error(
- "inconsistent constraints on inst variables in "
- ++ pred_or_func_decl_string(PredOrFunc),
+ Result = error("inconsistent constraints " ++
+ "on inst variables in " ++
+ pred_or_func_decl_string(PredOrFunc),
PredType)
;
get_purity(Attributes0, Purity, Attributes),
@@ -2186,10 +2173,12 @@
ExistQVars, PredOrFunc, F, As,
WithType, WithInst, MaybeDet, Cond,
Purity, ClassContext)),
- check_no_attributes(Result0, Attributes, Result)
+ check_no_attributes(Result0, Attributes,
+ Result)
)
;
- Result = error("some but not all arguments have modes", PredType)
+ Result = error("some but not all arguments " ++
+ "have modes", PredType)
)
;
Result = error("syntax error in " ++
@@ -2434,10 +2423,10 @@
Result = error("`=' expected in `:- func' declaration", Term)
).
-:- pred process_func_3(maybe_functor, term, term, term, varset,
- maybe(determinism), condition, existq_tvars, class_constraints,
- inst_var_sub, decl_attrs, maybe1(item)).
-:- mode process_func_3(in, in, in, in, in, in, in, in, in, in, in, out) is det.
+:- pred process_func_3(maybe_functor::in, term::in, term::in, term::in,
+ varset::in, maybe(determinism)::in, condition::in, existq_tvars::in,
+ class_constraints::in, inst_var_sub::in, decl_attrs::in,
+ maybe1(item)::out) is det.
process_func_3(ok(F, As0), FuncTerm, ReturnTypeTerm, FullTerm, VarSet0,
MaybeDet, Cond, ExistQVars, ClassContext, InstConstraints,
@@ -2456,15 +2445,15 @@
As = [type_and_mode(_, _) | _],
ReturnType = type_only(_)
->
- Result = error(
- "function arguments have modes, but function result doesn't",
+ Result = error("function arguments have " ++
+ "modes, but function result doesn't",
FuncTerm)
;
As = [type_only(_) | _],
ReturnType = type_and_mode(_, _)
->
- Result = error(
- "function result has mode, but function arguments don't",
+ Result = error("function result has mode, " ++
+ "but function arguments don't",
FuncTerm)
;
get_purity(Attributes0, Purity, Attributes),
@@ -2472,28 +2461,29 @@
varset__coerce(VarSet0, IVarSet),
list__append(As, [ReturnType], Args),
(
- inst_var_constraints_are_consistent_in_type_and_modes(
- Args)
+ inst_var_constraints_are_consistent_in_type_and_modes(Args)
->
-
- Result0 = ok(pred_or_func(TVarSet, IVarSet, ExistQVars,
- function, F, Args, no, no, MaybeDet, Cond, Purity,
+ Result0 = ok(pred_or_func(TVarSet,
+ IVarSet, ExistQVars,
+ function, F, Args, no, no,
+ MaybeDet, Cond, Purity,
ClassContext)),
- check_no_attributes(Result0, Attributes, Result)
+ check_no_attributes(Result0,
+ Attributes, Result)
;
- Result = error(
- "inconsistent constraints on inst variables in function declaration",
- FullTerm)
+ Result = error("inconsistent " ++
+ "constraints on inst " ++
+ "variables in function " ++
+ "declaration", FullTerm)
)
)
;
- Result = error(
- "syntax error in return type of `:- func' declaration",
- ReturnTypeTerm)
+ Result = error("syntax error in return type of " ++
+ "`:- func' declaration", ReturnTypeTerm)
)
;
- Result = error("syntax error in arguments of `:- func' declaration",
- FuncTerm)
+ Result = error("syntax error in arguments of `:- func' " ++
+ "declaration", FuncTerm)
).
process_func_3(error(M, T), _, _, _, _, _, _, _, _, _, _, error(M, T)).
@@ -2527,9 +2517,9 @@
% parse a `:- mode p(...)' declaration
-:- pred process_mode(module_name, varset, term, condition, decl_attrs,
- maybe(inst), maybe(determinism), maybe1(item)).
-:- mode process_mode(in, in, in, in, in, in, in, out) is det.
+:- pred process_mode(module_name::in, varset::in, term::in, condition::in,
+ decl_attrs::in, maybe(inst)::in, maybe(determinism)::in,
+ maybe1(item)::out) is det.
process_mode(ModuleName, VarSet, Term, Cond, Attributes,
WithInst, MaybeDet, Result) :-
@@ -2550,9 +2540,9 @@
WithInst, MaybeDet, Cond, Attributes, Result)
).
-:- pred process_pred_or_func_mode(maybe_functor, module_name, term, varset,
- maybe(inst), maybe(determinism), condition, decl_attrs, maybe1(item)).
-:- mode process_pred_or_func_mode(in, in, in, in, in, in, in, in, out) is det.
+:- pred process_pred_or_func_mode(maybe_functor::in, module_name::in, term::in,
+ varset::in, maybe(inst)::in, maybe(determinism)::in, condition::in,
+ decl_attrs::in, maybe1(item)::out) is det.
process_pred_or_func_mode(ok(F, As0), ModuleName, PredMode, VarSet0, WithInst,
MaybeDet, Cond, Attributes0, Result) :-
@@ -2572,15 +2562,18 @@
PredOrFunc = yes(predicate)
;
WithInst = yes(_),
- % We don't know whether it's a predicate or
- % a function until we expand out the inst.
+ % We don't know whether it's a
+ % predicate or a function until we
+ % expand out the inst.
PredOrFunc = no
),
- Result0 = ok(pred_or_func_mode(VarSet, PredOrFunc, F, As,
- WithInst, MaybeDet, Cond))
- ;
- Result0 = error("inconsistent constraints on inst variables in predicate mode declaration",
- PredMode)
+ Result0 = ok(pred_or_func_mode(VarSet,
+ PredOrFunc, F, As, WithInst, MaybeDet,
+ Cond))
+ ;
+ Result0 = error("inconsistent constraints " ++
+ "on inst variables in predicate " ++
+ "mode declaration", PredMode)
)
;
MaybeConstraints = error(String, Term),
@@ -2592,9 +2585,9 @@
).
process_pred_or_func_mode(error(M, T), _, _, _, _, _, _, _, error(M, T)).
-:- pred process_func_mode(maybe_functor, module_name, term, term, term, varset,
- maybe(determinism), condition, decl_attrs, maybe1(item)).
-:- mode process_func_mode(in, in, in, in, in, in, in, in, in, out) is det.
+:- pred process_func_mode(maybe_functor::in, module_name::in, term::in,
+ term::in, term::in, varset::in, maybe(determinism)::in, condition::in,
+ decl_attrs::in, maybe1(item)::out) is det.
process_func_mode(ok(F, As0), ModuleName, FuncMode, RetMode0, FullTerm,
VarSet0, MaybeDet, Cond, Attributes0, Result) :-
@@ -2608,23 +2601,26 @@
list__map(constrain_inst_vars_in_mode(InstConstraints),
As1, As),
(
- convert_mode(allow_constrained_inst_var, RetMode0, RetMode1)
+ convert_mode(allow_constrained_inst_var,
+ RetMode0, RetMode1)
->
- constrain_inst_vars_in_mode(InstConstraints, RetMode1,
- RetMode),
+ constrain_inst_vars_in_mode(InstConstraints,
+ RetMode1, RetMode),
varset__coerce(VarSet0, VarSet),
list__append(As, [RetMode], ArgModes),
( inst_var_constraints_are_consistent_in_modes(ArgModes) ->
- Result0 = ok(pred_or_func_mode(VarSet, yes(function),
- F, ArgModes, no, MaybeDet, Cond))
- ;
- Result0 = error(
- "inconsistent constraints on inst variables in function mode declaration",
- FullTerm)
+ Result0 = ok(pred_or_func_mode(VarSet,
+ yes(function), F, ArgModes,
+ no, MaybeDet, Cond))
+ ;
+ Result0 = error("inconsistent " ++
+ "constraints on inst " ++
+ "variables in function " ++
+ "mode declaration", FullTerm)
)
;
- Result0 = error(
- "syntax error in return mode of function mode declaration",
+ Result0 = error("syntax error in return " ++
+ "mode of function mode declaration",
RetMode0)
)
;
@@ -2633,9 +2629,8 @@
),
check_no_attributes(Result0, Attributes, Result)
;
- Result = error(
- "syntax error in arguments of function mode declaration",
- FuncMode)
+ Result = error("syntax error in arguments of function " ++
+ "mode declaration", FuncMode)
).
process_func_mode(error(M, T), _, _, _, _, _, _, _, _, error(M, T)).
@@ -2659,7 +2654,8 @@
constrain_inst_vars_in_inst(_, free(T), free(T)).
constrain_inst_vars_in_inst(InstConstraints, bound(U, BIs0), bound(U, BIs)) :-
list__map((pred(functor(C, Is0)::in, functor(C, Is)::out) is det :-
- list__map(constrain_inst_vars_in_inst(InstConstraints), Is0, Is)),
+ list__map(constrain_inst_vars_in_inst(InstConstraints),
+ Is0, Is)),
BIs0, BIs).
constrain_inst_vars_in_inst(_, ground(U, none), ground(U, none)).
constrain_inst_vars_in_inst(InstConstraints,
@@ -2681,10 +2677,10 @@
constrain_inst_vars_in_inst(_, not_reached, not_reached).
constrain_inst_vars_in_inst(InstConstraints, inst_var(Var),
constrained_inst_vars(set__make_singleton_set(Var), Inst)) :-
- Inst = ( map__search(InstConstraints, Var, Inst0) ->
- Inst0
+ ( map__search(InstConstraints, Var, Inst0) ->
+ Inst = Inst0
;
- ground(shared, none)
+ Inst = ground(shared, none)
).
constrain_inst_vars_in_inst(InstConstraints, defined_inst(Name0),
defined_inst(Name)) :-
@@ -3299,16 +3295,18 @@
% Matches only constructors with the specified argument
% and result types.
-:- pred parse_constructor_specifier(term, maybe1(cons_specifier)).
-:- mode parse_constructor_specifier(in, out) is det.
+:- pred parse_constructor_specifier(term::in, maybe1(cons_specifier)::out)
+ is det.
+
parse_constructor_specifier(Term, Result) :-
(
- Term = term__functor(term__atom("::"), [NameArgsTerm, TypeTerm],
- _Context)
+ Term = term__functor(term__atom("::"),
+ [NameArgsTerm, TypeTerm], _Context)
->
parse_arg_types_specifier(NameArgsTerm, NameArgsResult),
parse_type(TypeTerm, TypeResult),
- process_typed_constructor_specifier(NameArgsResult, TypeResult, Result)
+ process_typed_constructor_specifier(NameArgsResult, TypeResult,
+ Result)
;
parse_arg_types_specifier(Term, TermResult),
process_maybe1(make_untyped_cons_spec, TermResult, Result)
@@ -3322,21 +3320,25 @@
% types.
% SymbolNameSpecifier
-:- pred parse_predicate_specifier(term, maybe1(pred_specifier)).
-:- mode parse_predicate_specifier(in, out) is det.
+:- pred parse_predicate_specifier(term::in, maybe1(pred_specifier)::out)
+ is det.
+
parse_predicate_specifier(Term, Result) :-
(
Term = term__functor(term__atom("/"), [_,_], _Context)
->
parse_symbol_name_specifier(Term, NameResult),
- process_maybe1(make_arity_predicate_specifier, NameResult, Result)
+ process_maybe1(make_arity_predicate_specifier,
+ NameResult, Result)
;
- parse_qualified_term(Term, Term, "predicate specifier", TermResult),
+ parse_qualified_term(Term, Term, "predicate specifier",
+ TermResult),
process_typed_predicate_specifier(TermResult, Result)
).
-:- pred process_typed_predicate_specifier(maybe_functor, maybe1(pred_specifier)).
-:- mode process_typed_predicate_specifier(in, out) is det.
+:- pred process_typed_predicate_specifier(maybe_functor::in,
+ maybe1(pred_specifier)::out) is det.
+
process_typed_predicate_specifier(ok(Name, Args0), ok(Result)) :-
( Args0 = [] ->
Result = sym(name(Name))
@@ -3348,6 +3350,7 @@
:- pred make_arity_predicate_specifier(sym_name_specifier, pred_specifier).
:- mode make_arity_predicate_specifier(in, out) is det.
+
make_arity_predicate_specifier(Result, sym(Result)).
%-----------------------------------------------------------------------------%
@@ -3357,14 +3360,17 @@
:- pred parse_arg_types_specifier(term, maybe1(pred_specifier)).
:- mode parse_arg_types_specifier(in, out) is det.
+
parse_arg_types_specifier(Term, Result) :-
(
Term = term__functor(term__atom("/"), [_,_], _Context)
->
parse_symbol_name_specifier(Term, NameResult),
- process_maybe1(make_arity_predicate_specifier, NameResult, Result)
+ process_maybe1(make_arity_predicate_specifier,
+ NameResult, Result)
;
- parse_qualified_term(Term, Term, "constructor specifier", TermResult),
+ parse_qualified_term(Term, Term, "constructor specifier",
+ TermResult),
process_typed_predicate_specifier(TermResult, Result)
).
@@ -3399,32 +3405,38 @@
:- pred parse_symbol_name_specifier(term, maybe1(sym_name_specifier)).
:- mode parse_symbol_name_specifier(in, out) is det.
+
parse_symbol_name_specifier(Term, Result) :-
root_module_name(DefaultModule),
parse_implicitly_qualified_symbol_name_specifier(DefaultModule,
Term, Result).
-:- pred parse_implicitly_qualified_symbol_name_specifier(module_name,
- term, maybe1(sym_name_specifier)).
-:- mode parse_implicitly_qualified_symbol_name_specifier(in, in, out) is det.
+:- pred parse_implicitly_qualified_symbol_name_specifier(module_name::in,
+ term::in, maybe1(sym_name_specifier)::out) is det.
parse_implicitly_qualified_symbol_name_specifier(DefaultModule, Term, Result) :-
( %%% some [NameTerm, ArityTerm, Context]
- Term = term__functor(term__atom("/"), [NameTerm, ArityTerm], _Context)
+ Term = term__functor(term__atom("/"), [NameTerm, ArityTerm],
+ _Context)
->
( %%% some [Arity, Context2]
- ArityTerm = term__functor(term__integer(Arity), [], _Context2)
+ ArityTerm = term__functor(term__integer(Arity), [],
+ _Context2)
->
( Arity >= 0 ->
- parse_implicitly_qualified_symbol_name(DefaultModule,
- NameTerm, NameResult),
- process_maybe1(make_name_arity_specifier(Arity), NameResult,
- Result)
- ;
- Result = error("arity in symbol name specifier must be a non-negative integer", Term)
+ parse_implicitly_qualified_symbol_name(
+ DefaultModule, NameTerm, NameResult),
+ process_maybe1(
+ make_name_arity_specifier(Arity),
+ NameResult, Result)
+ ;
+ Result = error("arity in symbol name " ++
+ "specifier must be a non-negative " ++
+ "integer", Term)
)
;
- Result = error("arity in symbol name specifier must be an integer", Term)
+ Result = error("arity in symbol name " ++
+ "specifier must be an integer", Term)
)
;
parse_implicitly_qualified_symbol_name(DefaultModule,
@@ -3432,11 +3444,13 @@
process_maybe1(make_name_specifier, SymbolNameResult, Result)
).
-:- pred make_name_arity_specifier(arity, sym_name, sym_name_specifier).
-:- mode make_name_arity_specifier(in, in, out) is det.
+:- pred make_name_arity_specifier(arity::in, sym_name::in,
+ sym_name_specifier::out) is det.
+
make_name_arity_specifier(Arity, Name, name_arity(Name, Arity)).
:- pred make_name_specifier(sym_name::in, sym_name_specifier::out) is det.
+
make_name_specifier(Name, name(Name)).
%-----------------------------------------------------------------------------%
@@ -3453,8 +3467,8 @@
% We also allow the syntax `Module__Name'
% as an alternative for `Module:Name'.
-:- pred parse_symbol_name(term(T), maybe1(sym_name)).
-:- mode parse_symbol_name(in, out) is det.
+:- pred parse_symbol_name(term(T)::in, maybe1(sym_name)::out) is det.
+
parse_symbol_name(Term, Result) :-
(
Term = term__functor(term__atom(FunctorName),
@@ -3464,7 +3478,8 @@
)
->
(
- NameTerm = term__functor(term__atom(Name), [], _Context1)
+ NameTerm = term__functor(term__atom(Name), [],
+ _Context1)
->
parse_symbol_name(ModuleTerm, ModuleResult),
(
@@ -3473,11 +3488,14 @@
;
ModuleResult = error(_, _),
term__coerce(Term, ErrorTerm),
- Result = error("module name identifier expected before ':' in qualified symbol name", ErrorTerm)
+ Result = error("module name identifier " ++
+ "expected before ':' in qualified " ++
+ "symbol name", ErrorTerm)
)
;
term__coerce(Term, ErrorTerm),
- Result = error("identifier expected after ':' in qualified symbol name", ErrorTerm)
+ Result = error("identifier expected after ':' " ++
+ "in qualified symbol name", ErrorTerm)
)
;
(
@@ -3555,13 +3573,13 @@
parse_qualified_term(Term, ContainingTerm, Msg, Result) :-
(
Term = term__functor(term__atom(FunctorName),
- [ModuleTerm, NameArgsTerm], _Context),
+ [ModuleTerm, NameArgsTerm], _),
( FunctorName = "."
; FunctorName = ":"
)
->
(
- NameArgsTerm = term__functor(term__atom(Name), Args, _Context2)
+ NameArgsTerm = term__functor(term__atom(Name), Args, _)
->
parse_symbol_name(ModuleTerm, ModuleResult),
(
@@ -3570,15 +3588,18 @@
;
ModuleResult = error(_, _),
term__coerce(Term, ErrorTerm),
- Result = error("module name identifier expected before ':' in qualified symbol name", ErrorTerm)
+ Result = error("module name identifier " ++
+ "expected before ':' in " ++
+ "qualified symbol name", ErrorTerm)
)
;
term__coerce(Term, ErrorTerm),
- Result = error("identifier expected after ':' in qualified symbol name", ErrorTerm)
+ Result = error("identifier expected after ':' " ++
+ "in qualified symbol name", ErrorTerm)
)
;
(
- Term = term__functor(term__atom(Name), Args, _Context4)
+ Term = term__functor(term__atom(Name), Args, _)
->
string_to_sym_name(Name, "__", SymName),
Result = ok(SymName, Args)
Index: compiler/prog_io_dcg.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_dcg.m,v
retrieving revision 1.22
diff -u -b -r1.22 prog_io_dcg.m
--- compiler/prog_io_dcg.m 26 May 2003 09:00:06 -0000 1.22
+++ compiler/prog_io_dcg.m 30 Oct 2003 07:22:32 -0000
@@ -27,15 +27,14 @@
prog_context, maybe_item_and_context).
:- mode parse_dcg_clause(in, in, in, in, in, out) is det.
- % parse_dcg_pred_goal(GoalTerm, VarSet0, Goal,
- % DCGVarInitial, DCGVarFinal, Varset)
+ % parse_dcg_pred_goal(GoalTerm, Goal,
+ % DCGVarInitial, DCGVarFinal, VarSet0, Varset)
% parses `GoalTerm' and expands it as a DCG goal,
% `VarSet0' is the initial varset, and `VarSet' is
% the final varset. `DCGVarInitial' is the first DCG variable,
% and `DCGVarFinal' is the final DCG variable.
-:- pred parse_dcg_pred_goal(term, prog_varset, goal, prog_var,
- prog_var, prog_varset).
-:- mode parse_dcg_pred_goal(in, in, out, out, out, out) is det.
+:- pred parse_dcg_pred_goal(term::in, goal::out, prog_var::out, prog_var::out,
+ prog_varset::in, prog_varset::out) is det.
:- implementation.
@@ -51,10 +50,10 @@
parse_dcg_clause(ModuleName, VarSet0, DCG_Head, DCG_Body, DCG_Context,
Result) :-
varset__coerce(VarSet0, ProgVarSet0),
- new_dcg_var(ProgVarSet0, counter__init(0), ProgVarSet1,
- Counter0, DCG_0_Var),
- parse_dcg_goal(DCG_Body, ProgVarSet1, Counter0, DCG_0_Var,
- Body, ProgVarSet, _Counter, DCG_Var),
+ new_dcg_var(ProgVarSet0, ProgVarSet1, counter__init(0), Counter0,
+ DCG_0_Var),
+ parse_dcg_goal(DCG_Body, Body, ProgVarSet1, ProgVarSet,
+ Counter0, _Counter, DCG_0_Var, DCG_Var),
parse_implicitly_qualified_term(ModuleName,
DCG_Head, DCG_Body, "DCG clause head", HeadResult),
process_dcg_clause(HeadResult, ProgVarSet, DCG_0_Var, DCG_Var,
@@ -63,34 +62,33 @@
%-----------------------------------------------------------------------------%
-parse_dcg_pred_goal(GoalTerm, VarSet0, Goal, DCGVar0, DCGVar, VarSet) :-
- new_dcg_var(VarSet0, counter__init(0), VarSet1, Counter0, DCGVar0),
- parse_dcg_goal(GoalTerm, VarSet1, Counter0, DCGVar0,
- Goal, VarSet, _Counter, DCGVar).
+parse_dcg_pred_goal(GoalTerm, Goal, DCGVar0, DCGVar, !VarSet) :-
+ new_dcg_var(!VarSet, counter__init(0), Counter0, DCGVar0),
+ parse_dcg_goal(GoalTerm, Goal, !VarSet, Counter0, _Counter,
+ DCGVar0, DCGVar).
%-----------------------------------------------------------------------------%
% Used to allocate fresh variables needed for the DCG expansion.
-:- pred new_dcg_var(prog_varset, counter, prog_varset, counter, prog_var).
-:- mode new_dcg_var(in, in, out, out, out) is det.
+:- pred new_dcg_var(prog_varset::in, prog_varset::out,
+ counter::in, counter::out, prog_var::out) is det.
-new_dcg_var(VarSet0, Counter0, VarSet, Counter, DCG_0_Var) :-
- counter__allocate(N, Counter0, Counter),
+new_dcg_var(!VarSet, !Counter, DCG_0_Var) :-
+ counter__allocate(N, !Counter),
string__int_to_string(N, StringN),
string__append("DCG_", StringN, VarName),
- varset__new_var(VarSet0, DCG_0_Var, VarSet1),
- varset__name_var(VarSet1, DCG_0_Var, VarName, VarSet).
+ varset__new_var(!.VarSet, DCG_0_Var, !:VarSet),
+ varset__name_var(!.VarSet, DCG_0_Var, VarName, !:VarSet).
%-----------------------------------------------------------------------------%
% Expand a DCG goal.
-:- pred parse_dcg_goal(term, prog_varset, counter, prog_var, goal,
- prog_varset, counter, prog_var).
-:- mode parse_dcg_goal(in, in, in, in, out, out, out, out) is det.
+:- pred parse_dcg_goal(term::in, goal::out, prog_varset::in, prog_varset::out,
+ counter::in, counter::out, prog_var::in, prog_var::out) is det.
-parse_dcg_goal(Term, VarSet0, Counter0, Var0, Goal, VarSet, Counter, Var) :-
+parse_dcg_goal(Term, Goal, !VarSet, !Counter, !Var) :-
% first, figure out the context for the goal
(
Term = term__functor(_, _, Context)
@@ -108,33 +106,31 @@
SymName = unqualified(Functor),
list__map(term__coerce, Args0, Args1),
parse_dcg_goal_2(Functor, Args1, Context,
- VarSet0, Counter0, Var0, Goal1,
- VarSet1, Counter1, Var1)
+ Goal1, !VarSet, !Counter, !Var)
->
- Goal = Goal1,
- VarSet = VarSet1,
- Counter = Counter1,
- Var = Var1
+ Goal = Goal1
;
% It's the ordinary case of non-terminal.
% Create a fresh var as the DCG output var from this
% goal, and append the DCG argument pair to the
% non-terminal's argument list.
- new_dcg_var(VarSet0, Counter0, VarSet, Counter, Var),
+ new_dcg_var(!VarSet, !Counter, Var),
list__append(Args0,
- [term__variable(Var0),
+ [term__variable(!.Var),
term__variable(Var)], Args),
- Goal = call(SymName, Args, pure) - Context
+ Goal = call(SymName, Args, pure) - Context,
+ !:Var = Var
)
;
% A call to a free variable, or to a number or string.
% Just translate it into a call to call/3 - the typechecker
% will catch calls to numbers and strings.
- new_dcg_var(VarSet0, Counter0, VarSet, Counter, Var),
+ new_dcg_var(!VarSet, !Counter, Var),
term__coerce(Term, ProgTerm),
Goal = call(unqualified("call"), [ProgTerm,
- term__variable(Var0), term__variable(Var)],
- pure) - Context
+ term__variable(!.Var), term__variable(Var)],
+ pure) - Context,
+ !:Var = Var
).
% parse_dcg_goal_2(Functor, Args, Context, VarSet0, Counter0, Var0,
@@ -146,85 +142,78 @@
% for use in error messages, debugging, etc.).
% Var0 and Var are an accumulator pair we use to keep track of
% the current DCG variable.
-
-:- pred parse_dcg_goal_2(string, list(term), prog_context, prog_varset,
- counter, prog_var, goal, prog_varset, counter, prog_var).
-:- mode parse_dcg_goal_2(in, in, in, in, in, in, out, out, out, out)
- is semidet.
+ %
+ % Since (A -> B) has different semantics in standard Prolog
+ % (A -> B ; fail) than it does in NU-Prolog or Mercury (A -> B ; true),
+ % for the moment we'll just disallow it.
+
+:- pred parse_dcg_goal_2(string::in, list(term)::in, prog_context::in,
+ goal::out, prog_varset::in, prog_varset::out,
+ counter::in, counter::out, prog_var::in, prog_var::out) is semidet.
% Ordinary goal inside { curly braces }.
-parse_dcg_goal_2("{}", [G0 | Gs], Context, VarSet0, Counter, Var,
- Goal, VarSet, Counter, Var) :-
+parse_dcg_goal_2("{}", [G0 | Gs], Context, Goal, !VarSet, !Counter, !Var) :-
% The parser treats '{}/N' terms as tuples, so we need
% to undo the parsing of the argument conjunction here.
list_to_conjunction(Context, G0, Gs, G),
- parse_goal(G, VarSet0, Goal, VarSet).
-parse_dcg_goal_2("impure", [G], _, VarSet0, Counter0, Var0, Goal,
- VarSet, Counter, Var) :-
- parse_dcg_goal_with_purity(G, VarSet0, Counter0, Var0, (impure),
- Goal, VarSet, Counter, Var).
-parse_dcg_goal_2("semipure", [G], _, VarSet0, Counter0, Var0, Goal,
- VarSet, Counter, Var) :-
- parse_dcg_goal_with_purity(G, VarSet0, Counter0, Var0, (semipure),
- Goal, VarSet, Counter, Var).
+ parse_goal(G, Goal, !VarSet).
+parse_dcg_goal_2("impure", [G], _, Goal, !VarSet, !Counter, !Var) :-
+ parse_dcg_goal_with_purity(G, (impure), Goal, !VarSet, !Counter, !Var).
+parse_dcg_goal_2("semipure", [G], _, Goal, !VarSet, !Counter, !Var) :-
+ parse_dcg_goal_with_purity(G, (semipure), Goal, !VarSet, !Counter,
+ !Var).
% Empty list - just unify the input and output DCG args.
-parse_dcg_goal_2("[]", [], Context, VarSet0, Counter0, Var0,
- Goal, VarSet, Counter, Var) :-
- new_dcg_var(VarSet0, Counter0, VarSet, Counter, Var),
- Goal = unify(term__variable(Var0), term__variable(Var), pure) - Context.
+parse_dcg_goal_2("[]", [], Context, Goal, !VarSet, !Counter, Var0, Var) :-
+ new_dcg_var(!VarSet, !Counter, Var),
+ Goal = unify(term__variable(Var0), term__variable(Var), pure)
+ - Context.
% Non-empty list of terminals. Append the DCG output arg
% as the new tail of the list, and unify the result with
% the DCG input arg.
-parse_dcg_goal_2("[|]", [X, Xs], Context, VarSet0, Counter0, Var0,
- Goal, VarSet, Counter, Var) :-
- new_dcg_var(VarSet0, Counter0, VarSet, Counter, Var),
+parse_dcg_goal_2("[|]", [X, Xs], Context, Goal, !VarSet, !Counter,
+ Var0, Var) :-
+ new_dcg_var(!VarSet, !Counter, Var),
ConsTerm0 = term__functor(term__atom("[|]"), [X, Xs], Context),
term__coerce(ConsTerm0, ConsTerm),
term_list_append_term(ConsTerm, term__variable(Var), Term),
Goal = unify(term__variable(Var0), Term, pure) - Context.
% Call to '='/1 - unify argument with DCG input arg.
-parse_dcg_goal_2("=", [A0], Context, VarSet, Counter, Var,
- Goal, VarSet, Counter, Var) :-
+parse_dcg_goal_2("=", [A0], Context, Goal, !VarSet, !Counter, Var, Var) :-
term__coerce(A0, A),
Goal = unify(A, term__variable(Var), pure) - Context.
% Call to ':='/1 - unify argument with DCG output arg.
-parse_dcg_goal_2(":=", [A0], Context, VarSet0, Counter0, _Var0,
- Goal, VarSet, Counter, Var) :-
- new_dcg_var(VarSet0, Counter0, VarSet, Counter, Var),
+parse_dcg_goal_2(":=", [A0], Context, Goal, !VarSet, !Counter, _Var0, Var) :-
+ new_dcg_var(!VarSet, !Counter, Var),
term__coerce(A0, A),
Goal = unify(A, term__variable(Var), pure) - Context.
% If-then (Prolog syntax).
% We need to add an else part to unify the DCG args.
-/******
- Since (A -> B) has different semantics in standard Prolog
- (A -> B ; fail) than it does in NU-Prolog or Mercury (A -> B ; true),
- for the moment we'll just disallow it.
-parse_dcg_goal_2("->", [Cond0, Then0], Context, VarSet0, Counter0, Var0,
- Goal, VarSet, Counter, Var) :-
- parse_dcg_if_then(Cond0, Then0, Context, VarSet0, Counter0, Var0,
- SomeVars, StateVars, Cond, Then, VarSet, Counter, Var),
- ( Var = Var0 ->
- Goal = if_then(SomeVars, StateVars, Cond, Then) - Context
- ;
- Unify = unify(term__variable(Var), term__variable(Var0)),
- Goal = if_then_else(SomeVars, StateVars, Cond, Then,
- Unify - Context) - Context
- ).
-******/
+% /******
+% parse_dcg_goal_2("->", [Cond0, Then0], Context, VarSet0, Counter0, Var0,
+% Goal, VarSet, Counter, Var) :-
+% parse_dcg_if_then(Cond0, Then0, Context, VarSet0, Counter0, Var0,
+% SomeVars, StateVars, Cond, Then, VarSet, Counter, Var),
+% ( Var = Var0 ->
+% Goal = if_then(SomeVars, StateVars, Cond, Then) - Context
+% ;
+% Unify = unify(term__variable(Var), term__variable(Var0)),
+% Goal = if_then_else(SomeVars, StateVars, Cond, Then,
+% Unify - Context) - Context
+% ).
+% ******/
% If-then (NU-Prolog syntax).
parse_dcg_goal_2("if", [
term__functor(term__atom("then"), [Cond0, Then0], _)
- ], Context, VarSet0, Counter0, Var0, Goal,
- VarSet, Counter, Var) :-
- parse_dcg_if_then(Cond0, Then0, Context, VarSet0, Counter0, Var0,
- SomeVars, StateVars, Cond, Then, VarSet, Counter, Var),
+ ], Context, Goal, !VarSet, !Counter, Var0, Var) :-
+ parse_dcg_if_then(Cond0, Then0, Context, SomeVars, StateVars,
+ Cond, Then, !VarSet, !Counter, Var0, Var),
( Var = Var0 ->
Goal = if_then(SomeVars, StateVars, Cond, Then) - Context
;
@@ -234,29 +223,26 @@
).
% Conjunction.
-parse_dcg_goal_2(",", [A0, B0], Context, VarSet0, Counter0, Var0,
- (A, B) - Context, VarSet, Counter, Var) :-
- parse_dcg_goal(A0, VarSet0, Counter0, Var0, A, VarSet1, Counter1, Var1),
- parse_dcg_goal(B0, VarSet1, Counter1, Var1, B, VarSet, Counter, Var).
-
-parse_dcg_goal_2("&", [A0, B0], Context, VarSet0, Counter0, Var0,
- (A & B) - Context, VarSet, Counter, Var) :-
- parse_dcg_goal(A0, VarSet0, Counter0, Var0, A, VarSet1, Counter1, Var1),
- parse_dcg_goal(B0, VarSet1, Counter1, Var1, B, VarSet, Counter, Var).
+parse_dcg_goal_2(",", [A0, B0], Context, (A, B) - Context, !VarSet, !Counter,
+ !Var) :-
+ parse_dcg_goal(A0, A, !VarSet, !Counter, !Var),
+ parse_dcg_goal(B0, B, !VarSet, !Counter, !Var).
+
+parse_dcg_goal_2("&", [A0, B0], Context, (A & B) - Context,
+ !VarSet, !Counter, !Var) :-
+ parse_dcg_goal(A0, A, !VarSet, !Counter, !Var),
+ parse_dcg_goal(B0, B, !VarSet, !Counter, !Var).
% Disjunction or if-then-else (Prolog syntax).
-parse_dcg_goal_2(";", [A0, B0], Context, VarSet0, Counter0, Var0,
- Goal, VarSet, Counter, Var) :-
+parse_dcg_goal_2(";", [A0, B0], Context, Goal, !VarSet, !Counter, Var0, Var) :-
(
A0 = term__functor(term__atom("->"), [Cond0, Then0], _Context)
->
- parse_dcg_if_then_else(Cond0, Then0, B0, Context,
- VarSet0, Counter0, Var0, Goal, VarSet, Counter, Var)
+ parse_dcg_if_then_else(Cond0, Then0, B0, Context, Goal,
+ !VarSet, !Counter, Var0, Var)
;
- parse_dcg_goal(A0, VarSet0, Counter0, Var0,
- A1, VarSet1, Counter1, VarA),
- parse_dcg_goal(B0, VarSet1, Counter1, Var0,
- B1, VarSet, Counter, VarB),
+ parse_dcg_goal(A0, A1, !VarSet, !Counter, Var0, VarA),
+ parse_dcg_goal(B0, B1, !VarSet, !Counter, Var0, VarB),
( VarA = Var0, VarB = Var0 ->
Var = Var0,
Goal = (A1 ; B1) - Context
@@ -280,31 +266,28 @@
).
% If-then-else (NU-Prolog syntax).
-parse_dcg_goal_2( "else", [
+parse_dcg_goal_2("else", [
term__functor(term__atom("if"), [
term__functor(term__atom("then"), [Cond0, Then0], _)
], Context),
Else0
- ], _, VarSet0, Counter0, Var0, Goal, VarSet, Counter, Var) :-
- parse_dcg_if_then_else(Cond0, Then0, Else0, Context,
- VarSet0, Counter0, Var0, Goal, VarSet, Counter, Var).
+ ], _, Goal, !VarSet, !Counter, !Var) :-
+ parse_dcg_if_then_else(Cond0, Then0, Else0, Context, Goal,
+ !VarSet, !Counter, !Var).
% Negation (NU-Prolog syntax).
-parse_dcg_goal_2( "not", [A0], Context, VarSet0, Counter0, Var0,
- not(A) - Context, VarSet, Counter, Var ) :-
- parse_dcg_goal(A0, VarSet0, Counter0, Var0, A, VarSet, Counter, _),
- Var = Var0.
+parse_dcg_goal_2("not", [A0], Context, not(A) - Context,
+ !VarSet, !Counter, Var0, Var0) :-
+ parse_dcg_goal(A0, A, !VarSet, !Counter, Var0, _).
% Negation (Prolog syntax).
-parse_dcg_goal_2( "\\+", [A0], Context, VarSet0, Counter0, Var0,
- not(A) - Context, VarSet, Counter, Var ) :-
- parse_dcg_goal(A0, VarSet0, Counter0, Var0, A, VarSet, Counter, _),
- Var = Var0.
+parse_dcg_goal_2("\\+", [A0], Context, not(A) - Context,
+ !VarSet, !Counter, Var0, Var0) :-
+ parse_dcg_goal(A0, A, !VarSet, !Counter, Var0, _).
% Universal quantification.
-parse_dcg_goal_2("all", [QVars, A0], Context,
- VarSet0, Counter0, Var0, GoalExpr - Context,
- VarSet, Counter, Var) :-
+parse_dcg_goal_2("all", [QVars, A0], Context, GoalExpr - Context,
+ !VarSet, !Counter, !Var) :-
% Extract any state variables in the quantifier.
%
@@ -312,8 +295,8 @@
list__map(term__coerce_var, StateVars0, StateVars),
list__map(term__coerce_var, Vars0, Vars),
- parse_dcg_goal(A0, VarSet0, Counter0, Var0, A @ (GoalExprA - ContextA),
- VarSet, Counter, Var),
+ parse_dcg_goal(A0, A @ (GoalExprA - ContextA), !VarSet, !Counter,
+ !Var),
(
Vars = [], StateVars = [],
@@ -330,9 +313,8 @@
).
% Existential quantification.
-parse_dcg_goal_2("some", [QVars, A0], Context,
- VarSet0, Counter0, Var0, GoalExpr - Context,
- VarSet, Counter, Var) :-
+parse_dcg_goal_2("some", [QVars, A0], Context, GoalExpr - Context,
+ !VarSet, !Counter, !Var) :-
% Extract any state variables in the quantifier.
%
@@ -340,8 +322,8 @@
list__map(term__coerce_var, StateVars0, StateVars),
list__map(term__coerce_var, Vars0, Vars),
- parse_dcg_goal(A0, VarSet0, Counter0, Var0, A @ (GoalExprA - ContextA),
- VarSet, Counter, Var),
+ parse_dcg_goal(A0, A @ (GoalExprA - ContextA), !VarSet, !Counter,
+ !Var),
(
Vars = [], StateVars = [],
@@ -357,15 +339,12 @@
GoalExpr = some(Vars, some_state_vars(StateVars, A) - ContextA)
).
-:- pred parse_dcg_goal_with_purity(term, prog_varset, counter, prog_var,
- purity, goal, prog_varset, counter, prog_var).
-:- mode parse_dcg_goal_with_purity(in, in, in, in, in, out, out, out, out)
- is det.
-
-parse_dcg_goal_with_purity(G, VarSet0, Counter0, Var0, Purity, Goal, VarSet,
- Counter, Var) :-
- parse_dcg_goal(G, VarSet0, Counter0, Var0, Goal1,
- VarSet, Counter, Var),
+:- pred parse_dcg_goal_with_purity(term::in, purity::in, goal::out,
+ prog_varset::in, prog_varset::out, counter::in, counter::out,
+ prog_var::in, prog_var::out) is det.
+
+parse_dcg_goal_with_purity(G, Purity, Goal, !VarSet, !Counter, !Var) :-
+ parse_dcg_goal(G, Goal1, !VarSet, !Counter, !Var),
( Goal1 = call(Pred, Args, pure) - Context ->
Goal = call(Pred, Args, Purity) - Context
; Goal1 = unify(ProgTerm1, ProgTerm2, pure) - Context ->
@@ -380,8 +359,8 @@
Goal = call(unqualified(PurityString), [G1], pure) - Context
).
-:- pred append_to_disjunct(goal, goal_expr, prog_context, goal).
-:- mode append_to_disjunct(in, in, in, out) is det.
+:- pred append_to_disjunct(goal::in, goal_expr::in, prog_context::in,
+ goal::out) is det.
append_to_disjunct(Disjunct0, Goal, Context, Disjunct) :-
( Disjunct0 = (A0 ; B0) - Context2 ->
@@ -392,19 +371,18 @@
Disjunct = (Disjunct0, Goal - Context) - Context
).
-:- pred parse_some_vars_dcg_goal(term, list(prog_var), list(prog_var),
- prog_varset, counter, prog_var, goal, prog_varset, counter, prog_var).
-:- mode parse_some_vars_dcg_goal(in, out, out, in, in, in, out, out, out, out)
- is det.
+:- pred parse_some_vars_dcg_goal(term::in, list(prog_var)::out,
+ list(prog_var)::out, goal::out, prog_varset::in, prog_varset::out,
+ counter::in, counter::out, prog_var::in, prog_var::out) is det.
-parse_some_vars_dcg_goal(A0, SomeVars, StateVars, VarSet0, Counter0, Var0,
- A, VarSet, Counter, Var) :-
+parse_some_vars_dcg_goal(A0, SomeVars, StateVars, A, !VarSet, !Counter,
+ !Var) :-
( A0 = term__functor(term__atom("some"), [QVars0, A1], _Context) ->
term__coerce(QVars0, QVars),
- ( if parse_quantifier_vars(QVars, StateVars0, SomeVars0) then
+ ( parse_quantifier_vars(QVars, StateVars0, SomeVars0) ->
SomeVars = SomeVars0,
StateVars = StateVars0
- else
+ ;
% XXX a hack because we do not do
% error checking in this module.
term__vars(QVars, SomeVars),
@@ -416,7 +394,7 @@
StateVars = [],
A2 = A0
),
- parse_dcg_goal(A2, VarSet0, Counter0, Var0, A, VarSet, Counter, Var).
+ parse_dcg_goal(A2, A, !VarSet, !Counter, !Var).
% Parse the "if" and the "then" part of an if-then or an
% if-then-else.
@@ -438,40 +416,34 @@
% )
% so that the implicit quantification of DCG_2 is correct.
-:- pred parse_dcg_if_then(term, term, prog_context, prog_varset, counter,
- prog_var, list(prog_var), list(prog_var), goal, goal,
- prog_varset, counter, prog_var).
-:- mode parse_dcg_if_then(in, in, in, in, in, in, out, out, out, out, out, out,
- out) is det.
-
-parse_dcg_if_then(Cond0, Then0, Context, VarSet0, Counter0, Var0,
- SomeVars, StateVars, Cond, Then, VarSet, Counter, Var) :-
- parse_some_vars_dcg_goal(Cond0, SomeVars, StateVars,
- VarSet0, Counter0, Var0, Cond, VarSet1, Counter1, Var1),
- parse_dcg_goal(Then0, VarSet1, Counter1, Var1, Then1, VarSet2,
- Counter2, Var2),
+:- pred parse_dcg_if_then(term::in, term::in, prog_context::in,
+ list(prog_var)::out, list(prog_var)::out, goal::out, goal::out,
+ prog_varset::in, prog_varset::out, counter::in, counter::out,
+ prog_var::in, prog_var::out) is det.
+
+parse_dcg_if_then(Cond0, Then0, Context, SomeVars, StateVars, Cond, Then,
+ !VarSet, !Counter, Var0, Var) :-
+ parse_some_vars_dcg_goal(Cond0, SomeVars, StateVars, Cond,
+ !VarSet, !Counter, Var0, Var1),
+ parse_dcg_goal(Then0, Then1, !VarSet, !Counter, Var1, Var2),
( Var0 \= Var1, Var1 = Var2 ->
- new_dcg_var(VarSet2, Counter2, VarSet, Counter, Var),
+ new_dcg_var(!VarSet, !Counter, Var),
Unify = unify(term__variable(Var), term__variable(Var2), pure),
Then = (Then1, Unify - Context) - Context
;
Then = Then1,
- Counter = Counter2,
- Var = Var2,
- VarSet = VarSet2
+ Var = Var2
).
-:- pred parse_dcg_if_then_else(term, term, term, prog_context,
- prog_varset, counter, prog_var, goal, prog_varset, counter, prog_var).
-:- mode parse_dcg_if_then_else(in, in, in, in, in, in, in,
- out, out, out, out) is det.
-
-parse_dcg_if_then_else(Cond0, Then0, Else0, Context, VarSet0, Counter0, Var0,
- Goal, VarSet, Counter, Var) :-
- parse_dcg_if_then(Cond0, Then0, Context, VarSet0, Counter0, Var0,
- SomeVars, StateVars, Cond, Then1, VarSet1, Counter1, VarThen),
- parse_dcg_goal(Else0, VarSet1, Counter1, Var0, Else1, VarSet, Counter,
- VarElse),
+:- pred parse_dcg_if_then_else(term::in, term::in, term::in, prog_context::in,
+ goal::out, prog_varset::in, prog_varset::out,
+ counter::in, counter::out, prog_var::in, prog_var::out) is det.
+
+parse_dcg_if_then_else(Cond0, Then0, Else0, Context, Goal,
+ !VarSet, !Counter, Var0, Var) :-
+ parse_dcg_if_then(Cond0, Then0, Context, SomeVars, StateVars,
+ Cond, Then1, !VarSet, !Counter, Var0, VarThen),
+ parse_dcg_goal(Else0, Else1, !VarSet, !Counter, Var0, VarElse),
( VarThen = Var0, VarElse = Var0 ->
Var = Var0,
Then = Then1,
@@ -509,8 +481,8 @@
% this predicate will append the term Term
% onto the end of the list
-:- pred term_list_append_term(term(T), term(T), term(T)).
-:- mode term_list_append_term(in, in, out) is semidet.
+:- pred term_list_append_term(term(T)::in, term(T)::in, term(T)::out)
+ is semidet.
term_list_append_term(List0, Term, List) :-
( List0 = term__functor(term__atom("[]"), [], _Context) ->
@@ -523,13 +495,11 @@
term_list_append_term(Tail0, Term, Tail)
).
-:- pred process_dcg_clause(maybe_functor, prog_varset, prog_var,
- prog_var, goal, maybe1(item)).
-:- mode process_dcg_clause(in, in, in, in, in, out) is det.
+:- pred process_dcg_clause(maybe_functor::in, prog_varset::in, prog_var::in,
+ prog_var::in, goal::in, maybe1(item)::out) is det.
process_dcg_clause(ok(Name, Args0), VarSet, Var0, Var, Body,
ok(clause(VarSet, predicate, Name, Args, Body))) :-
list__map(term__coerce, Args0, Args1),
- list__append(Args1, [term__variable(Var0),
- term__variable(Var)], Args).
+ list__append(Args1, [term__variable(Var0), term__variable(Var)], Args).
process_dcg_clause(error(Message, Term), _, _, _, _, error(Message, Term)).
Index: compiler/prog_io_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_goal.m,v
retrieving revision 1.25
diff -u -b -r1.25 prog_io_goal.m
--- compiler/prog_io_goal.m 19 Sep 2003 11:10:04 -0000 1.25
+++ compiler/prog_io_goal.m 29 Oct 2003 20:34:42 -0000
@@ -19,17 +19,17 @@
% Convert a single term into a goal.
%
-:- pred parse_goal(term, prog_varset, goal, prog_varset).
-:- mode parse_goal(in, in, out, out) is det.
+:- pred parse_goal(term::in, goal::out, prog_varset::in, prog_varset::out)
+ is det.
% Convert a term, possibly starting with `some [Vars]', into
% a list of the quantified variables, a list of quantified
% state variables, and a goal. (If the term doesn't start
% with `some [Vars]', we return empty lists of variables.)
%
-:- pred parse_some_vars_goal(term, prog_varset, list(prog_var), list(prog_var),
- goal, prog_varset).
-:- mode parse_some_vars_goal(in, in, out, out, out, out) is det.
+:- pred parse_some_vars_goal(term::in, list(prog_var)::out,
+ list(prog_var)::out, goal::out, prog_varset::in, prog_varset::out)
+ is det.
% parse_lambda_expression/3 converts the first argument to a lambda/2
% expression into a list of arguments, a list of their corresponding
@@ -111,7 +111,7 @@
% We could do some error-checking here, but all errors are picked up
% in either the type-checker or parser anyway.
-parse_goal(Term, VarSet0, Goal, VarSet) :-
+parse_goal(Term, Goal, !VarSet) :-
% first, get the goal context
(
Term = term__functor(_, _, Context)
@@ -125,10 +125,9 @@
(
% check for builtins...
Term = term__functor(term__atom(Name), Args, Context),
- parse_goal_2(Name, Args, VarSet0, GoalExpr, VarSet1)
+ parse_goal_2(Name, Args, GoalExpr, !VarSet)
->
- Goal = GoalExpr - Context,
- VarSet = VarSet1
+ Goal = GoalExpr - Context
;
% it's not a builtin
term__coerce(Term, ArgsTerm),
@@ -136,80 +135,68 @@
% check for predicate calls
sym_name_and_args(ArgsTerm, SymName, Args)
->
- VarSet = VarSet0,
Goal = call(SymName, Args, pure) - Context
;
% A call to a free variable, or to a number or string.
- % Just translate it into a call to call/1 - the typechecker
- % will catch calls to numbers and strings.
+ % Just translate it into a call to call/1 - the
+ % typechecker will catch calls to numbers and strings.
Goal = call(unqualified("call"), [ArgsTerm], pure)
- - Context,
- VarSet = VarSet0
+ - Context
)
).
%-----------------------------------------------------------------------------%
-:- pred parse_goal_2(string, list(term), prog_varset, goal_expr, prog_varset).
-:- mode parse_goal_2(in, in, in, out, out) is semidet.
-parse_goal_2("true", [], V, true, V).
-parse_goal_2("fail", [], V, fail, V).
-parse_goal_2("=", [A0, B0], V, unify(A, B, pure), V) :-
+:- pred parse_goal_2(string::in, list(term)::in, goal_expr::out,
+ prog_varset::in, prog_varset::out) is semidet.
+
+ % Since (A -> B) has different semantics in standard Prolog
+ % (A -> B ; fail) than it does in NU-Prolog or Mercury (A -> B ; true),
+ % for the moment we'll just disallow it.
+ % For consistency we also disallow if-then without the else.
+
+parse_goal_2("true", [], true, !V).
+parse_goal_2("fail", [], fail, !V).
+parse_goal_2("=", [A0, B0], unify(A, B, pure), !V) :-
term__coerce(A0, A),
term__coerce(B0, B).
-/******
- Since (A -> B) has different semantics in standard Prolog
- (A -> B ; fail) than it does in NU-Prolog or Mercury (A -> B ; true),
- for the moment we'll just disallow it.
-parse_goal_2("->", [A0, B0], V0, if_then(Vars, StateVars, A, B), V) :-
- parse_some_vars_goal(A0, V0, Vars, A, V1),
- parse_goal(B0, V1, B, V).
-******/
-parse_goal_2(",", [A0, B0], V0, (A, B), V) :-
- parse_goal(A0, V0, A, V1),
- parse_goal(B0, V1, B, V).
-parse_goal_2("&", [A0, B0], V0, (A & B), V) :-
- parse_goal(A0, V0, A, V1),
- parse_goal(B0, V1, B, V).
-parse_goal_2(";", [A0, B0], V0, R, V) :-
+parse_goal_2(",", [A0, B0], (A, B), !V) :-
+ parse_goal(A0, A, !V),
+ parse_goal(B0, B, !V).
+parse_goal_2("&", [A0, B0], (A & B), !V) :-
+ parse_goal(A0, A, !V),
+ parse_goal(B0, B, !V).
+parse_goal_2(";", [A0, B0], R, !V) :-
(
A0 = term__functor(term__atom("->"), [X0, Y0], _Context)
->
- parse_some_vars_goal(X0, V0, Vars, StateVars, X, V1),
- parse_goal(Y0, V1, Y, V2),
- parse_goal(B0, V2, B, V),
+ parse_some_vars_goal(X0, Vars, StateVars, X, !V),
+ parse_goal(Y0, Y, !V),
+ parse_goal(B0, B, !V),
R = if_then_else(Vars, StateVars, X, Y, B)
;
- parse_goal(A0, V0, A, V1),
- parse_goal(B0, V1, B, V),
+ parse_goal(A0, A, !V),
+ parse_goal(B0, B, !V),
R = (A;B)
).
-/****
- For consistency we also disallow if-then
-parse_goal_2("if",
- [term__functor(term__atom("then"), [A0, B0], _)], V0,
- if_then(Vars, StateVars, A, B), V) :-
- parse_some_vars_goal(A0, V0, Vars, A, V1),
- parse_goal(B0, V1, B, V).
-****/
parse_goal_2("else", [
term__functor(term__atom("if"), [
term__functor(term__atom("then"), [A0, B0], _)
], _),
C0
- ], V0,
- if_then_else(Vars, StateVars, A, B, C), V) :-
- parse_some_vars_goal(A0, V0, Vars, StateVars, A, V1),
- parse_goal(B0, V1, B, V2),
- parse_goal(C0, V2, C, V).
+ ],
+ if_then_else(Vars, StateVars, A, B, C), !V) :-
+ parse_some_vars_goal(A0, Vars, StateVars, A, !V),
+ parse_goal(B0, B, !V),
+ parse_goal(C0, C, !V).
-parse_goal_2("not", [A0], V0, not(A), V) :-
- parse_goal(A0, V0, A, V).
+parse_goal_2("not", [A0], not(A), !V) :-
+ parse_goal(A0, A, !V).
-parse_goal_2("\\+", [A0], V0, not(A), V) :-
- parse_goal(A0, V0, A, V).
+parse_goal_2("\\+", [A0], not(A), !V) :-
+ parse_goal(A0, A, !V).
-parse_goal_2("all", [QVars, A0], V0, GoalExpr, V):-
+parse_goal_2("all", [QVars, A0], GoalExpr, !V):-
% Extract any state variables in the quantifier.
%
@@ -217,7 +204,7 @@
list__map(term__coerce_var, StateVars0, StateVars),
list__map(term__coerce_var, Vars0, Vars),
- parse_goal(A0, V0, A @ (GoalExprA - ContextA), V),
+ parse_goal(A0, A @ (GoalExprA - ContextA), !V),
(
Vars = [], StateVars = [],
@@ -234,20 +221,20 @@
).
% handle implication
-parse_goal_2("<=", [A0, B0], V0, implies(B, A), V):-
- parse_goal(A0, V0, A, V1),
- parse_goal(B0, V1, B, V).
-
-parse_goal_2("=>", [A0, B0], V0, implies(A, B), V):-
- parse_goal(A0, V0, A, V1),
- parse_goal(B0, V1, B, V).
+parse_goal_2("<=", [A0, B0], implies(B, A), !V):-
+ parse_goal(A0, A, !V),
+ parse_goal(B0, B, !V).
+
+parse_goal_2("=>", [A0, B0], implies(A, B), !V):-
+ parse_goal(A0, A, !V),
+ parse_goal(B0, B, !V).
% handle equivalence
-parse_goal_2("<=>", [A0, B0], V0, equivalent(A, B), V):-
- parse_goal(A0, V0, A, V1),
- parse_goal(B0, V1, B, V).
+parse_goal_2("<=>", [A0, B0], equivalent(A, B), !V):-
+ parse_goal(A0, A, !V),
+ parse_goal(B0, B, !V).
-parse_goal_2("some", [QVars, A0], V0, GoalExpr, V):-
+parse_goal_2("some", [QVars, A0], GoalExpr, !V):-
% Extract any state variables in the quantifier.
%
@@ -255,7 +242,7 @@
list__map(term__coerce_var, StateVars0, StateVars),
list__map(term__coerce_var, Vars0, Vars),
- parse_goal(A0, V0, A @ (GoalExprA - ContextA), V),
+ parse_goal(A0, A @ (GoalExprA - ContextA), !V),
(
Vars = [], StateVars = [],
@@ -275,21 +262,19 @@
% the parser - we ought to handle it in the code generation -
% but then `is/2' itself is a bit of a hack
%
-parse_goal_2("is", [A0, B0], V, unify(A, B, pure), V) :-
+parse_goal_2("is", [A0, B0], unify(A, B, pure), !V) :-
term__coerce(A0, A),
term__coerce(B0, B).
-parse_goal_2("impure", [A0], V0, A, V) :-
- parse_goal_with_purity(A0, V0, (impure), A, V).
-parse_goal_2("semipure", [A0], V0, A, V) :-
- parse_goal_with_purity(A0, V0, (semipure), A, V).
-
+parse_goal_2("impure", [A0], A, !V) :-
+ parse_goal_with_purity(A0, (impure), A, !V).
+parse_goal_2("semipure", [A0], A, !V) :-
+ parse_goal_with_purity(A0, (semipure), A, !V).
-:- pred parse_goal_with_purity(term, prog_varset, purity, goal_expr,
- prog_varset).
-:- mode parse_goal_with_purity(in, in, in, out, out) is det.
+:- pred parse_goal_with_purity(term::in, purity::in, goal_expr::out,
+ prog_varset::in, prog_varset::out) is det.
-parse_goal_with_purity(A0, V0, Purity, A, V) :-
- parse_goal(A0, V0, A1, V),
+parse_goal_with_purity(A0, Purity, A, !V) :-
+ parse_goal(A0, A1, !V),
( A1 = call(Pred, Args, pure) - _ ->
A = call(Pred, Args, Purity)
; A1 = unify(ProgTerm1, ProgTerm2, pure) - _ ->
@@ -305,18 +290,18 @@
%-----------------------------------------------------------------------------%
-parse_some_vars_goal(A0, VarSet0, Vars, StateVars, A, VarSet) :-
+parse_some_vars_goal(A0, Vars, StateVars, A, !VarSet) :-
(
A0 = term__functor(term__atom("some"), [QVars, A1], _Context),
parse_quantifier_vars(QVars, StateVars0, Vars0)
->
list__map(term__coerce_var, StateVars0, StateVars),
list__map(term__coerce_var, Vars0, Vars),
- parse_goal(A1, VarSet0, A, VarSet)
+ parse_goal(A1, A, !VarSet)
;
Vars = [],
StateVars = [],
- parse_goal(A0, VarSet0, A, VarSet)
+ parse_goal(A0, A, !VarSet)
).
%-----------------------------------------------------------------------------%
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.59
diff -u -b -r1.59 prog_io_pragma.m
--- compiler/prog_io_pragma.m 26 May 2003 09:00:06 -0000 1.59
+++ compiler/prog_io_pragma.m 30 Oct 2003 15:16:00 -0000
@@ -81,46 +81,51 @@
fail
).
-:- pred parse_pragma_type(module_name, string, list(term), term,
- varset, maybe1(item)).
-:- mode parse_pragma_type(in, in, in, in, in, out) is semidet.
+:- pred parse_pragma_type(module_name::in, string::in, list(term)::in,
+ term::in, varset::in, maybe1(item)::out) is semidet.
parse_pragma_type(_, "source_file", PragmaTerms, ErrorTerm, _VarSet, Result) :-
( PragmaTerms = [SourceFileTerm] ->
(
- SourceFileTerm = term__functor(term__string(SourceFile), [], _)
+ SourceFileTerm = term__functor(
+ term__string(SourceFile), [], _)
->
Result = ok(pragma(source_file(SourceFile)))
;
- Result = error(
- "string expected in `:- pragma source_file' declaration",
- SourceFileTerm)
+ Result = error("string expected in `:- pragma " ++
+ "source_file' declaration", SourceFileTerm)
)
;
- Result = error(
- "wrong number of arguments in `:- pragma source_file' declaration",
- ErrorTerm)
+ Result = error("wrong number of arguments in " ++
+ "`:- pragma source_file' declaration", ErrorTerm)
).
-parse_pragma_type(ModuleName, "foreign_type", PragmaTerms,
- ErrorTerm, VarSet, Result) :-
+parse_pragma_type(ModuleName, "foreign_type", PragmaTerms, ErrorTerm, VarSet,
+ Result) :-
( PragmaTerms = [LangTerm, MercuryTypeTerm, ForeignTypeTerm] ->
( parse_foreign_language(LangTerm, Language) ->
parse_foreign_language_type(ForeignTypeTerm, Language,
MaybeForeignType),
(
MaybeForeignType = ok(ForeignType),
- parse_type_defn_head(ModuleName, MercuryTypeTerm,
- ErrorTerm, MaybeTypeDefnHead),
- (
- MaybeTypeDefnHead = ok(MercuryTypeSymName, MercuryArgs0),
+ parse_type_defn_head(ModuleName,
+ MercuryTypeTerm, ErrorTerm,
+ MaybeTypeDefnHead),
+ (
+ MaybeTypeDefnHead = ok(
+ MercuryTypeSymName,
+ MercuryArgs0),
varset__coerce(VarSet, TVarSet),
- MercuryArgs = list__map(term__coerce, MercuryArgs0),
- Result = ok(pragma(foreign_type(ForeignType,
- TVarSet, MercuryTypeSymName,
+ MercuryArgs = list__map(term__coerce,
+ MercuryArgs0),
+ Result = ok(pragma(
+ foreign_type(ForeignType,
+ TVarSet,
+ MercuryTypeSymName,
MercuryArgs, no)))
;
- MaybeTypeDefnHead = error(String, Term),
+ MaybeTypeDefnHead =
+ error(String, Term),
Result = error(String, Term)
)
;
@@ -128,23 +133,22 @@
Result = error(String, Term)
)
;
- Result = error(
- "invalid foreign language in `:- pragma foreign_type' declaration",
+ Result = error("invalid foreign language in " ++
+ "`:- pragma foreign_type' declaration",
LangTerm)
)
;
- Result = error(
- "wrong number of arguments in `:- pragma foreign_type' declaration",
- ErrorTerm)
+ Result = error("wrong number of arguments in " ++
+ "`:- pragma foreign_type' declaration", ErrorTerm)
).
-parse_pragma_type(ModuleName, "foreign_decl", PragmaTerms,
- ErrorTerm, VarSet, Result) :-
+parse_pragma_type(ModuleName, "foreign_decl", PragmaTerms, ErrorTerm,
+ VarSet, Result) :-
parse_pragma_foreign_decl_pragma(ModuleName, "foreign_decl",
PragmaTerms, ErrorTerm, VarSet, Result).
-parse_pragma_type(ModuleName, "c_header_code", PragmaTerms,
- ErrorTerm, VarSet, Result) :-
+parse_pragma_type(ModuleName, "c_header_code", PragmaTerms, ErrorTerm,
+ VarSet, Result) :-
(
PragmaTerms = [term__functor(_, _, Context) | _]
->
@@ -152,17 +156,18 @@
parse_pragma_foreign_decl_pragma(ModuleName, "c_header_code",
[LangC | PragmaTerms], ErrorTerm, VarSet, Result)
;
- Result = error("wrong number of arguments or unexpected variable in `:- pragma c_header_code' declaration",
+ Result = error("wrong number of arguments or unexpected " ++
+ "variable in `:- pragma c_header_code' declaration",
ErrorTerm)
).
-parse_pragma_type(ModuleName, "foreign_code", PragmaTerms,
- ErrorTerm, VarSet, Result) :-
+parse_pragma_type(ModuleName, "foreign_code", PragmaTerms, ErrorTerm,
+ VarSet, Result) :-
parse_pragma_foreign_code_pragma(ModuleName, "foreign_code",
PragmaTerms, ErrorTerm, VarSet, Result).
-parse_pragma_type(ModuleName, "foreign_proc", PragmaTerms,
- ErrorTerm, VarSet, Result) :-
+parse_pragma_type(ModuleName, "foreign_proc", PragmaTerms, ErrorTerm,
+ VarSet, Result) :-
parse_pragma_foreign_proc_pragma(ModuleName, "foreign_proc",
PragmaTerms, ErrorTerm, VarSet, Result).
@@ -171,8 +176,8 @@
% There are a few differences (error messages, some deprecated
% syntax is still supported for c_code) so we pass the original
% pragma name to parse_pragma_foreign_code_pragma.
-parse_pragma_type(ModuleName, "c_code", PragmaTerms,
- ErrorTerm, VarSet, Result) :-
+parse_pragma_type(ModuleName, "c_code", PragmaTerms, ErrorTerm,
+ VarSet, Result) :-
(
% arity = 1 (same as foreign_code)
PragmaTerms = [term__functor(_, _, Context)]
@@ -188,24 +193,26 @@
parse_pragma_foreign_proc_pragma(ModuleName, "c_code",
[LangC | PragmaTerms], ErrorTerm, VarSet, Result)
;
- Result = error("wrong number of arguments or unexpected variable in `:- pragma c_code' declaration",
+ Result = error("wrong number of arguments or unexpected " ++
+ "variable in `:- pragma c_code' declaration",
ErrorTerm)
).
-parse_pragma_type(_ModuleName, "c_import_module", PragmaTerms,
- ErrorTerm, _VarSet, Result) :-
+parse_pragma_type(_ModuleName, "c_import_module", PragmaTerms, ErrorTerm,
+ _VarSet, Result) :-
(
PragmaTerms = [ImportTerm],
sym_name_and_args(ImportTerm, Import, [])
->
Result = ok(pragma(foreign_import_module(c, Import)))
;
- Result = error("wrong number of arguments or invalid module name in `:- pragma c_import_module' declaration",
- ErrorTerm)
+ Result = error("wrong number of arguments or invalid " ++
+ "module name in `:- pragma c_import_module' " ++
+ "declaration", ErrorTerm)
).
-parse_pragma_type(_ModuleName, "foreign_import_module", PragmaTerms,
- ErrorTerm, _VarSet, Result) :-
+parse_pragma_type(_ModuleName, "foreign_import_module", PragmaTerms, ErrorTerm,
+ _VarSet, Result) :-
(
PragmaTerms = [LangTerm, ImportTerm],
sym_name_and_args(ImportTerm, Import, [])
@@ -214,13 +221,14 @@
Result = ok(pragma(
foreign_import_module(Language, Import)))
;
- Result = error("invalid foreign language in `:- pragma foreign_import_module' declaration",
- LangTerm)
+ Result = error("invalid foreign language in " ++
+ "`:- pragma foreign_import_module' " ++
+ "declaration", LangTerm)
)
;
- Result = error("wrong number of arguments or invalid module name in `:- pragma foreign_import_module' declaration",
- ErrorTerm)
-
+ Result = error("wrong number of arguments or invalid " ++
+ "module name in `:- pragma foreign_import_module' " ++
+ "declaration", ErrorTerm)
).
:- pred parse_foreign_language(term, foreign_language).
@@ -383,8 +391,8 @@
Lang)
)
;
- string__format("invalid `:- pragma %s' declaration ", [s(Pragma)],
- ErrorStr),
+ string__format("invalid `:- pragma %s' declaration ",
+ [s(Pragma)], ErrorStr),
Result = error(ErrorStr, ErrorTerm)
).
@@ -450,7 +458,6 @@
ErrorTerm)
).
-
% This predicate parses both c_code and foreign_proc pragmas.
:- pred parse_pragma_foreign_proc_pragma(module_name, string,
list(term), term, varset, maybe1(item)).
@@ -585,7 +592,6 @@
)
),
-
Check2 = (func(PTerms2, ForeignLanguage) = Res is semidet :-
PTerms2 = [PredAndVarsTerm, CodeTerm],
% XXX we should issue a warning; this syntax is deprecated.
@@ -664,7 +670,6 @@
ErrorTerm)
).
-
parse_pragma_type(ModuleName, "import", PragmaTerms,
ErrorTerm, _VarSet, Result) :-
% XXX we assume all imports are C
@@ -1264,7 +1269,6 @@
MaybeAttributes = error(ErrMsg, Term)
).
-
% Update the pragma_foreign_proc_attributes according to the given
% collected_pragma_foreign_proc_attribute.
:- pred process_attribute(collected_pragma_foreign_proc_attribute::in,
@@ -1285,7 +1289,6 @@
% Aliasing is currently ignored in the main branch compiler.
process_attribute(aliasing, Attrs, Attrs).
-
% Check whether all the required attributes have been set for
% a particular language
:- func check_required_attributes(foreign_language,
@@ -1492,7 +1495,6 @@
Error = yes("arguments not in form 'Var :: mode'")
).
-
:- pred parse_tabling_pragma(module_name, string, eval_method, list(term),
term, maybe1(item)).
:- mode parse_tabling_pragma(in, in, in, in, in, out) is det.
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.61
diff -u -b -r1.61 purity.m
--- compiler/purity.m 24 Oct 2003 06:17:47 -0000 1.61
+++ compiler/purity.m 30 Oct 2003 04:22:53 -0000
@@ -285,7 +285,7 @@
NumErrors1, NumErrors),
{ module_info_num_errors(ModuleInfo2, Errs0) },
{ Errs = Errs0 + NumErrors },
- { module_info_set_num_errors(ModuleInfo2, Errs, ModuleInfo) }.
+ { module_info_set_num_errors(Errs, ModuleInfo2, ModuleInfo) }.
:- pred check_preds_purity_2(list(pred_id), module_info, module_info,
int, int, io__state, io__state).
@@ -308,8 +308,8 @@
puritycheck_pred(PredId, PredInfo0, PredInfo, ModuleInfo0,
PurityErrsInThisPred),
{ NumErrors1 = NumErrors0 + PurityErrsInThisPred },
- { module_info_set_pred_info(ModuleInfo0, PredId,
- PredInfo, ModuleInfo1) }
+ { module_info_set_pred_info(PredId, PredInfo,
+ ModuleInfo0, ModuleInfo1) }
),
% finish processing of promise declarations
@@ -430,11 +430,11 @@
->
(
OldPurity = pure,
- remove_marker(Markers0, promised_semipure, Markers1),
- add_marker(Markers1, promised_pure, Markers)
+ remove_marker(promised_semipure, Markers0, Markers1),
+ add_marker(promised_pure, Markers1, Markers)
;
OldPurity = (semipure),
- add_marker(Markers0, promised_semipure, Markers)
+ add_marker(promised_semipure, Markers0, Markers)
;
OldPurity = (impure),
Markers = Markers0
@@ -455,12 +455,12 @@
(
Bodypurity = pure,
- remove_marker(Markers0, (impure), Markers1),
- remove_marker(Markers1, (semipure), Markers)
+ remove_marker((impure), Markers0, Markers1),
+ remove_marker((semipure), Markers1, Markers)
;
Bodypurity = (semipure),
- remove_marker(Markers0, (impure), Markers1),
- add_marker(Markers1, (semipure), Markers)
+ remove_marker((impure), Markers0, Markers1),
+ add_marker((semipure), Markers1, Markers)
;
Bodypurity = (impure),
Markers = Markers0
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.122
diff -u -b -r1.122 simplify.m
--- compiler/simplify.m 24 Oct 2003 06:17:48 -0000 1.122
+++ compiler/simplify.m 29 Oct 2003 22:12:13 -0000
@@ -280,8 +280,8 @@
PredInfo, ProcInfo0),
proc_info_set_vartypes(VarTypes4, ProcInfo0, ProcInfo1),
proc_info_set_varset(VarSet4, ProcInfo1, ProcInfo),
- module_info_set_pred_proc_info(ModuleInfo5, PredId, ProcId,
- PredInfo, ProcInfo, ModuleInfo6),
+ module_info_set_pred_proc_info(PredId, ProcId,
+ PredInfo, ProcInfo, ModuleInfo5, ModuleInfo6),
simplify_info_set_module_info(Info4, ModuleInfo6, Info),
simplify_info_get_det_info(Info, DetInfo),
@@ -1560,8 +1560,8 @@
% in the module_info and put the new module_info
% back in the simplify_info.
%
- module_info_set_pred_proc_info(ModuleInfo1, PredId, ProcId,
- PredInfo, ProcInfo, ModuleInfo),
+ module_info_set_pred_proc_info(PredId, ProcId, PredInfo, ProcInfo,
+ ModuleInfo1, ModuleInfo),
simplify_info_set_module_info(Info2, ModuleInfo, Info).
:- pred simplify__type_info_locn(tvar, prog_var, list(hlds_goal),
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_detection.m,v
retrieving revision 1.101
diff -u -b -r1.101 switch_detection.m
--- compiler/switch_detection.m 24 Oct 2003 06:17:49 -0000 1.101
+++ compiler/switch_detection.m 29 Oct 2003 22:12:37 -0000
@@ -108,8 +108,8 @@
detect_switches_in_proc(ProcId, PredId, ModuleInfo0, ModuleInfo1),
detect_switches_in_procs(ProcIds, PredId, ModuleInfo1, ModuleInfo).
-detect_switches_in_proc(ProcId, PredId, ModuleInfo0, ModuleInfo) :-
- module_info_preds(ModuleInfo0, PredTable0),
+detect_switches_in_proc(ProcId, PredId, !ModuleInfo) :-
+ module_info_preds(!.ModuleInfo, PredTable0),
map__lookup(PredTable0, PredId, PredInfo0),
pred_info_procedures(PredInfo0, ProcTable0),
map__lookup(ProcTable0, ProcId, ProcInfo0),
@@ -119,14 +119,14 @@
% and pass these to `detect_switches_in_goal'.
proc_info_goal(ProcInfo0, Goal0),
proc_info_vartypes(ProcInfo0, VarTypes),
- proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap0),
- detect_switches_in_goal(Goal0, InstMap0, VarTypes, ModuleInfo0, Goal),
+ proc_info_get_initial_instmap(ProcInfo0, !.ModuleInfo, InstMap0),
+ detect_switches_in_goal(Goal0, InstMap0, VarTypes, !.ModuleInfo, Goal),
proc_info_set_goal(Goal, ProcInfo0, ProcInfo),
map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
map__det_update(PredTable0, PredId, PredInfo, PredTable),
- module_info_set_preds(ModuleInfo0, PredTable, ModuleInfo).
+ module_info_set_preds(PredTable, !ModuleInfo).
%-----------------------------------------------------------------------------%
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.54
diff -u -b -r1.54 table_gen.m
--- compiler/table_gen.m 24 Oct 2003 06:17:49 -0000 1.54
+++ compiler/table_gen.m 30 Oct 2003 15:37:33 -0000
@@ -581,7 +581,7 @@
repuritycheck_proc(!.ModuleInfo, proc(PredId, ProcId), !PredInfo),
module_info_preds(!.ModuleInfo, PredTable1),
map__det_update(PredTable1, PredId, !.PredInfo, PredTable),
- module_info_set_preds(!.ModuleInfo, PredTable, !:ModuleInfo).
+ module_info_set_preds(PredTable, !ModuleInfo).
%-----------------------------------------------------------------------------%
@@ -837,8 +837,8 @@
; EvalMethod = eval_memo ->
SaveAnsGoal = SaveAnsGoal0
;
- error(
- "table_gen__create_new_det_goal: unsupported evaluation model")
+ error("table_gen__create_new_det_goal: " ++
+ "unsupported evaluation model")
),
generate_call("table_simple_is_active", [TableTipVar], semidet,
@@ -1002,8 +1002,8 @@
GenTrueAnsGoalInfo),
GenTrueAnsGoal = GenTrueAnsGoalEx - GenTrueAnsGoalInfo
;
- error(
- "table_gen__create_new_semi_goal: unsupported evaluation model")
+ error("table_gen__create_new_semi_goal: " ++
+ "unsupported evaluation model")
),
( Detism = failure ->
@@ -1354,8 +1354,8 @@
->
list__length(Ctors, EnumRange)
;
- error(
- "gen_lookup_call_for_type: enum type is not du_type?")
+ error("gen_lookup_call_for_type: " ++
+ "enum type is not du_type?")
),
gen_int_construction("RangeVar", EnumRange, !VarTypes,
!VarSet, RangeVar, RangeUnifyGoal),
@@ -1810,8 +1810,8 @@
InVars, OutVars0),
OutVars = [Var | OutVars0]
;
- error(
- "Only fully input/output arguments are allowed in tabled code!")
+ error("Only fully input/output arguments are allowed " ++
+ "in tabled code!")
).
:- pred create_instmap_delta(hlds_goals::in, instmap_delta::out) is det.
Index: compiler/term_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_util.m,v
retrieving revision 1.31
diff -u -b -r1.31 term_util.m
--- compiler/term_util.m 24 Oct 2003 06:17:49 -0000 1.31
+++ compiler/term_util.m 30 Oct 2003 04:23:01 -0000
@@ -286,10 +286,10 @@
%-----------------------------------------------------------------------------%
-set_pred_proc_ids_arg_size_info([], _ArgSize, Module, Module).
-set_pred_proc_ids_arg_size_info([PPId | PPIds], ArgSize, Module0, Module) :-
+set_pred_proc_ids_arg_size_info([], _ArgSize, !Module).
+set_pred_proc_ids_arg_size_info([PPId | PPIds], ArgSize, !Module) :-
PPId = proc(PredId, ProcId),
- module_info_preds(Module0, PredTable0),
+ module_info_preds(!.Module, PredTable0),
map__lookup(PredTable0, PredId, PredInfo0),
pred_info_procedures(PredInfo0, ProcTable0),
map__lookup(ProcTable0, ProcId, ProcInfo0),
@@ -299,14 +299,13 @@
map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
map__det_update(PredTable0, PredId, PredInfo, PredTable),
- module_info_set_preds(Module0, PredTable, Module1),
- set_pred_proc_ids_arg_size_info(PPIds, ArgSize, Module1, Module).
+ module_info_set_preds(PredTable, !Module),
+ set_pred_proc_ids_arg_size_info(PPIds, ArgSize, !Module).
-set_pred_proc_ids_termination_info([], _Termination, Module, Module).
-set_pred_proc_ids_termination_info([PPId | PPIds], Termination,
- Module0, Module) :-
+set_pred_proc_ids_termination_info([], _Termination, !Module).
+set_pred_proc_ids_termination_info([PPId | PPIds], Termination, !Module) :-
PPId = proc(PredId, ProcId),
- module_info_preds(Module0, PredTable0),
+ module_info_preds(!.Module, PredTable0),
map__lookup(PredTable0, PredId, PredInfo0),
pred_info_procedures(PredInfo0, ProcTable0),
map__lookup(ProcTable0, ProcId, ProcInfo0),
@@ -317,9 +316,8 @@
map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
map__det_update(PredTable0, PredId, PredInfo, PredTable),
- module_info_set_preds(Module0, PredTable, Module1),
- set_pred_proc_ids_termination_info(PPIds, Termination,
- Module1, Module).
+ module_info_set_preds(PredTable, !Module),
+ set_pred_proc_ids_termination_info(PPIds, Termination, !Module).
lookup_proc_termination_info(Module, PredProcId, MaybeTermination) :-
PredProcId = proc(PredId, ProcId),
Index: compiler/termination.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/termination.m,v
retrieving revision 1.33
diff -u -b -r1.33 termination.m
--- compiler/termination.m 30 Oct 2003 14:12:38 -0000 1.33
+++ compiler/termination.m 31 Oct 2003 00:00:49 -0000
@@ -360,10 +360,10 @@
used_args::in, module_info::in, module_info::out) is det.
set_finite_arg_size_infos([], _, Module, Module).
-set_finite_arg_size_infos([Soln | Solns], OutputSupplierMap, Module0, Module) :-
+set_finite_arg_size_infos([Soln | Solns], OutputSupplierMap, !Module) :-
Soln = PPId - Gamma,
PPId = proc(PredId, ProcId),
- module_info_preds(Module0, PredTable0),
+ module_info_preds(!.Module, PredTable0),
map__lookup(PredTable0, PredId, PredInfo),
pred_info_procedures(PredInfo, ProcTable),
map__lookup(ProcTable, ProcId, ProcInfo),
@@ -374,16 +374,16 @@
map__set(ProcTable, ProcId, ProcInfo1, ProcTable1),
pred_info_set_procedures(ProcTable1, PredInfo, PredInfo1),
map__set(PredTable0, PredId, PredInfo1, PredTable),
- module_info_set_preds(Module0, PredTable, Module1),
- set_finite_arg_size_infos(Solns, OutputSupplierMap, Module1, Module).
+ module_info_set_preds(PredTable, !Module),
+ set_finite_arg_size_infos(Solns, OutputSupplierMap, !Module).
:- pred set_infinite_arg_size_infos(list(pred_proc_id)::in,
arg_size_info::in, module_info::in, module_info::out) is det.
-set_infinite_arg_size_infos([], _, Module, Module).
-set_infinite_arg_size_infos([PPId | PPIds], ArgSizeInfo, Module0, Module) :-
+set_infinite_arg_size_infos([], _, !Module).
+set_infinite_arg_size_infos([PPId | PPIds], ArgSizeInfo, !Module) :-
PPId = proc(PredId, ProcId),
- module_info_preds(Module0, PredTable0),
+ module_info_preds(!.Module, PredTable0),
map__lookup(PredTable0, PredId, PredInfo),
pred_info_procedures(PredInfo, ProcTable),
map__lookup(ProcTable, ProcId, ProcInfo),
@@ -392,18 +392,18 @@
map__set(ProcTable, ProcId, ProcInfo1, ProcTable1),
pred_info_set_procedures(ProcTable1, PredInfo, PredInfo1),
map__set(PredTable0, PredId, PredInfo1, PredTable),
- module_info_set_preds(Module0, PredTable, Module1),
- set_infinite_arg_size_infos(PPIds, ArgSizeInfo, Module1, Module).
+ module_info_set_preds(PredTable, !Module),
+ set_infinite_arg_size_infos(PPIds, ArgSizeInfo, !Module).
%----------------------------------------------------------------------------%
:- pred set_termination_infos(list(pred_proc_id)::in, termination_info::in,
module_info::in, module_info::out) is det.
-set_termination_infos([], _, Module, Module).
-set_termination_infos([PPId | PPIds], TerminationInfo, Module0, Module) :-
+set_termination_infos([], _, !Module).
+set_termination_infos([PPId | PPIds], TerminationInfo, !Module) :-
PPId = proc(PredId, ProcId),
- module_info_preds(Module0, PredTable0),
+ module_info_preds(!.Module, PredTable0),
map__lookup(PredTable0, PredId, PredInfo0),
pred_info_procedures(PredInfo0, ProcTable0),
map__lookup(ProcTable0, ProcId, ProcInfo0),
@@ -412,8 +412,8 @@
map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
map__det_update(PredTable0, PredId, PredInfo, PredTable),
- module_info_set_preds(Module0, PredTable, Module1),
- set_termination_infos(PPIds, TerminationInfo, Module1, Module).
+ module_info_set_preds(PredTable, !Module),
+ set_termination_infos(PPIds, TerminationInfo, !Module).
:- pred report_termination_errors(list(pred_proc_id)::in,
list(term_errors__error)::in, module_info::in, module_info::out,
@@ -498,13 +498,12 @@
% about it (termination_info pragmas, terminates pragmas,
% check_termination pragmas, builtin/compiler generated).
-check_preds([], Module, Module, State, State).
-check_preds([PredId | PredIds] , Module0, Module, State0, State) :-
- write_pred_progress_message("% Checking ", PredId, Module0,
- State0, State1),
+check_preds([], !Module, !IO).
+check_preds([PredId | PredIds] , !Module, !IO) :-
+ write_pred_progress_message("% Checking ", PredId, !.Module, !IO),
globals__io_lookup_bool_option(make_optimization_interface,
- MakeOptInt, State1, State2),
- module_info_preds(Module0, PredTable0),
+ MakeOptInt, !IO),
+ module_info_preds(!.Module, PredTable0),
map__lookup(PredTable0, PredId, PredInfo0),
pred_info_import_status(PredInfo0, ImportStatus),
pred_info_context(PredInfo0, Context),
@@ -516,7 +515,7 @@
% predicates to be imported or locally defined, so they
% must be covered here, separately.
set_compiler_gen_terminates(PredInfo0, ProcIds, PredId,
- Module0, ProcTable0, ProcTable1)
+ !.Module, ProcTable0, ProcTable1)
->
ProcTable2 = ProcTable1
;
@@ -570,8 +569,8 @@
),
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
map__set(PredTable0, PredId, PredInfo, PredTable),
- module_info_set_preds(Module0, PredTable, Module1),
- check_preds(PredIds, Module1, Module, State2, State).
+ module_info_set_preds(PredTable, !Module),
+ check_preds(PredIds, !Module, !IO).
%----------------------------------------------------------------------------%
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.45
diff -u -b -r1.45 type_ctor_info.m
--- compiler/type_ctor_info.m 23 Oct 2003 02:07:57 -0000 1.45
+++ compiler/type_ctor_info.m 30 Oct 2003 03:44:21 -0000
@@ -83,14 +83,13 @@
%---------------------------------------------------------------------------%
-type_ctor_info__generate_hlds(ModuleInfo0, ModuleInfo) :-
- module_info_name(ModuleInfo0, ModuleName),
- module_info_types(ModuleInfo0, TypeTable),
+type_ctor_info__generate_hlds(!ModuleInfo) :-
+ module_info_name(!.ModuleInfo, ModuleName),
+ module_info_types(!.ModuleInfo, TypeTable),
map__keys(TypeTable, TypeCtors),
type_ctor_info__gen_type_ctor_gen_infos(TypeCtors, TypeTable,
- ModuleName, ModuleInfo0, TypeCtorGenInfos),
- module_info_set_type_ctor_gen_infos(ModuleInfo0, TypeCtorGenInfos,
- ModuleInfo).
+ ModuleName, !.ModuleInfo, TypeCtorGenInfos),
+ module_info_set_type_ctor_gen_infos(TypeCtorGenInfos, !ModuleInfo).
% Given a list of the ids of all the types in the type table,
% find the types defined in this module, and return a type_ctor_gen_info
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.343
diff -u -b -r1.343 typecheck.m
--- compiler/typecheck.m 24 Oct 2003 06:17:50 -0000 1.343
+++ compiler/typecheck.m 30 Oct 2003 07:31:01 -0000
@@ -194,49 +194,46 @@
% Type-check the code for all the predicates in a module.
-:- pred check_pred_types(module_info, module_info, bool, bool,
- io__state, io__state).
-:- mode check_pred_types(in, out, out, out, di, uo) is det.
+:- pred check_pred_types(module_info::in, module_info::out,
+ bool::out, bool::out, io__state::di, io__state::uo) is det.
-check_pred_types(Module0, Module, FoundError, ExceededIterationLimit) -->
- { module_info_predids(Module0, PredIds) },
+check_pred_types(!Module, FoundError, ExceededIterationLimit, !IO) :-
+ module_info_predids(!.Module, PredIds),
globals__io_lookup_int_option(type_inference_iteration_limit,
- MaxIterations),
- typecheck_to_fixpoint(1, MaxIterations, PredIds, Module0,
- Module, FoundError, ExceededIterationLimit),
- write_inference_messages(PredIds, Module).
+ MaxIterations, !IO),
+ typecheck_to_fixpoint(1, MaxIterations, PredIds, !Module,
+ FoundError, ExceededIterationLimit, !IO),
+ write_inference_messages(PredIds, !.Module, !IO).
% Repeatedly typecheck the code for a group of predicates
% until a fixpoint is reached, or until some errors are detected.
-:- pred typecheck_to_fixpoint(int, int, list(pred_id),
- module_info, module_info, bool, bool, io__state, io__state).
-:- mode typecheck_to_fixpoint(in, in, in, in, out, out, out, di, uo) is det.
-
-typecheck_to_fixpoint(Iteration, NumIterations, PredIds, Module0, Module,
- FoundError, ExceededIterationLimit) -->
- typecheck_pred_types_2(Iteration, PredIds, Module0, Module1,
- no, FoundError1, no, Changed),
- ( { Changed = no ; FoundError1 = yes } ->
- { Module = Module1 },
- { FoundError = FoundError1 },
- { ExceededIterationLimit = no }
- ;
- globals__io_lookup_bool_option(debug_types, DebugTypes),
- ( { DebugTypes = yes } ->
- write_inference_messages(PredIds, Module1)
+:- pred typecheck_to_fixpoint(int::in, int::in, list(pred_id)::in,
+ module_info::in, module_info::out, bool::out, bool::out,
+ io__state::di, io__state::uo) is det.
+
+typecheck_to_fixpoint(Iteration, NumIterations, PredIds, !Module,
+ FoundError, ExceededIterationLimit, !IO) :-
+ typecheck_pred_types_2(Iteration, PredIds, !Module,
+ no, FoundError1, no, Changed, !IO),
+ ( ( Changed = no ; FoundError1 = yes ) ->
+ FoundError = FoundError1,
+ ExceededIterationLimit = no
+ ;
+ globals__io_lookup_bool_option(debug_types, DebugTypes, !IO),
+ ( DebugTypes = yes ->
+ write_inference_messages(PredIds, !.Module, !IO)
;
- []
+ true
),
- ( { Iteration < NumIterations } ->
+ ( Iteration < NumIterations ->
typecheck_to_fixpoint(Iteration + 1, NumIterations,
- PredIds, Module1, Module,
- FoundError, ExceededIterationLimit)
+ PredIds, !Module,
+ FoundError, ExceededIterationLimit, !IO)
;
- typecheck_report_max_iterations_exceeded,
- { Module = Module1 },
- { FoundError = yes },
- { ExceededIterationLimit = yes }
+ typecheck_report_max_iterations_exceeded(!IO),
+ FoundError = yes,
+ ExceededIterationLimit = yes
)
).
@@ -260,73 +257,66 @@
% Iterate over the list of pred_ids in a module.
-:- pred typecheck_pred_types_2(int, list(pred_id), module_info, module_info,
- bool, bool, bool, bool, io__state, io__state).
-:- mode typecheck_pred_types_2(in, in, in, out,
- in, out, in, out, di, uo) is det.
-
-typecheck_pred_types_2(_, [], ModuleInfo, ModuleInfo,
- Error, Error, Changed, Changed) --> [].
-typecheck_pred_types_2(Iteration, [PredId | PredIds], ModuleInfo0, ModuleInfo,
- Error0, Error, Changed0, Changed) -->
- { module_info_preds(ModuleInfo0, Preds0) },
- { map__lookup(Preds0, PredId, PredInfo0) },
+:- pred typecheck_pred_types_2(int::in, list(pred_id)::in,
+ module_info::in, module_info::out, bool::in, bool::out,
+ bool::in, bool::out, io__state::di, io__state::uo) is det.
+
+typecheck_pred_types_2(_, [], !ModuleInfo, !Error, !Changed, !IO).
+typecheck_pred_types_2(Iteration, [PredId | PredIds], !ModuleInfo,
+ !Error, !Changed, !IO) :-
+ module_info_preds(!.ModuleInfo, Preds0),
+ map__lookup(Preds0, PredId, PredInfo0),
(
- { pred_info_is_imported(PredInfo0) }
+ pred_info_is_imported(PredInfo0)
->
- { Error2 = Error0 },
- { ModuleInfo3 = ModuleInfo0 },
- { Changed2 = Changed0 }
+ true
;
typecheck_pred_type(Iteration, PredId, PredInfo0, PredInfo1,
- ModuleInfo0, ModuleInfo1, Error1, Changed1),
+ !ModuleInfo, NewError, NewChanged, !IO),
(
- { Error1 = no },
- { map__det_update(Preds0, PredId, PredInfo1, Preds) },
- { module_info_set_preds(ModuleInfo1, Preds,
- ModuleInfo3) }
- ;
- { Error1 = yes },
- /********************
- This code is not needed at the moment,
- since currently we don't run mode analysis if
- there are any type errors.
- And this code also causes problems:
- if there are undefined modes,
- this code can end up calling error/1,
- since post_typecheck__finish_ill_typed_pred
- assumes that there are no undefined modes.
- %
- % if we get an error, we need to call
- % post_typecheck__finish_ill_typed_pred on the
- % pred, to ensure that its mode declaration gets
- % properly module qualified; then we call
- % `remove_predid', so that the predicate's definition
- % will be ignored by later passes (the declaration
- % will still be used to check any calls to it).
- %
- post_typecheck__finish_ill_typed_pred(ModuleInfo0,
- PredId, PredInfo1, PredInfo),
- { map__det_update(Preds0, PredId, PredInfo, Preds) },
- *******************/
- { map__det_update(Preds0, PredId, PredInfo1, Preds) },
- { module_info_set_preds(ModuleInfo1, Preds,
- ModuleInfo2) },
- { module_info_remove_predid(ModuleInfo2, PredId,
- ModuleInfo3) }
- ),
- { bool__or(Error0, Error1, Error2) },
- { bool__or(Changed0, Changed1, Changed2) }
- ),
- typecheck_pred_types_2(Iteration, PredIds, ModuleInfo3, ModuleInfo,
- Error2, Error, Changed2, Changed).
-
-:- pred typecheck_pred_type(int, pred_id, pred_info, pred_info,
- module_info, module_info, bool, bool, io__state, io__state).
-:- mode typecheck_pred_type(in, in, in, out, in, out, out, out, di, uo) is det.
+ NewError = no,
+ map__det_update(Preds0, PredId, PredInfo1, Preds),
+ module_info_set_preds(Preds, !ModuleInfo)
+ ;
+ NewError = yes,
+% /********************
+% This code is not needed at the moment,
+% since currently we don't run mode analysis if
+% there are any type errors.
+% And this code also causes problems:
+% if there are undefined modes,
+% this code can end up calling error/1,
+% since post_typecheck__finish_ill_typed_pred
+% assumes that there are no undefined modes.
+% %
+% % if we get an error, we need to call
+% % post_typecheck__finish_ill_typed_pred on the
+% % pred, to ensure that its mode declaration gets
+% % properly module qualified; then we call
+% % `remove_predid', so that the predicate's definition
+% % will be ignored by later passes (the declaration
+% % will still be used to check any calls to it).
+% %
+% post_typecheck__finish_ill_typed_pred(ModuleInfo0,
+% PredId, PredInfo1, PredInfo),
+% map__det_update(Preds0, PredId, PredInfo, Preds),
+% *******************/
+ map__det_update(Preds0, PredId, PredInfo1, Preds),
+ module_info_set_preds(Preds, !ModuleInfo),
+ module_info_remove_predid(PredId, !ModuleInfo)
+ ),
+ bool__or(!.Error, NewError, !:Error),
+ bool__or(!.Changed, NewChanged, !:Changed)
+ ),
+ typecheck_pred_types_2(Iteration, PredIds, !ModuleInfo,
+ !Error, !Changed, !IO).
+
+:- pred typecheck_pred_type(int::in, pred_id::in,
+ pred_info::in, pred_info::out, module_info::in, module_info::out,
+ bool::out, bool::out, io__state::di, io__state::uo) is det.
typecheck_pred_type(Iteration, PredId, !PredInfo,
- ModuleInfo0, ModuleInfo, Error, Changed, !IOState) :-
+ !ModuleInfo, Error, Changed, !IOState) :-
(
% Compiler-generated predicates are created already type-correct,
% there's no need to typecheck them. Same for builtins.
@@ -335,7 +325,7 @@
% or if it is a special pred for an existentially typed data type.
(
is_unify_or_compare_pred(!.PredInfo),
- \+ special_pred_needs_typecheck(!.PredInfo, ModuleInfo0)
+ \+ special_pred_needs_typecheck(!.PredInfo, !.ModuleInfo)
;
pred_info_is_builtin(!.PredInfo)
)
@@ -347,21 +337,19 @@
;
true
),
- ModuleInfo = ModuleInfo0,
Error = no,
Changed = no
;
globals__io_get_globals(Globals, !IOState),
( Iteration = 1 ->
- maybe_add_field_access_function_clause(ModuleInfo0, !PredInfo),
+ maybe_add_field_access_function_clause(!.ModuleInfo, !PredInfo),
maybe_improve_headvar_names(Globals, !PredInfo),
% The goal_type of the pred_info may have been changed
% by maybe_add_field_access_function_clause.
- module_info_set_pred_info(ModuleInfo0, PredId, !.PredInfo,
- ModuleInfo)
+ module_info_set_pred_info(PredId, !.PredInfo, !ModuleInfo)
;
- ModuleInfo = ModuleInfo0
+ true
),
pred_info_arg_types(!.PredInfo, _ArgTypeVarSet, ExistQVars0,
ArgTypes0),
@@ -382,13 +370,13 @@
->
( globals__lookup_bool_option(Globals, warn_stubs, yes) ->
report_no_clauses("Warning", PredId, !.PredInfo,
- ModuleInfo, !IOState)
+ !.ModuleInfo, !IOState)
;
true
),
- error_util__describe_one_pred_name(ModuleInfo, PredId,
+ error_util__describe_one_pred_name(!.ModuleInfo, PredId,
PredName),
- generate_stub_clause(PredName, !PredInfo, ModuleInfo,
+ generate_stub_clause(PredName, !PredInfo, !.ModuleInfo,
StubClause, VarSet0, VarSet),
Clauses1 = [StubClause],
clauses_info_set_clauses(Clauses1, ClausesInfo0, ClausesInfo1),
@@ -424,7 +412,7 @@
Changed = no
;
report_no_clauses("Error", PredId, !.PredInfo,
- ModuleInfo, !IOState),
+ !.ModuleInfo, !IOState),
Error = yes,
Changed = no
)
@@ -440,13 +428,13 @@
% `pred foo(T1, T2, ..., TN)' by make_hlds.m.
Inferring = yes,
write_pred_progress_message("% Inferring type of ",
- PredId, ModuleInfo, !IOState),
+ PredId, !.ModuleInfo, !IOState),
HeadTypeParams1 = [],
PredConstraints = constraints([], [])
;
Inferring = no,
write_pred_progress_message("% Type-checking ",
- PredId, ModuleInfo, !IOState),
+ PredId, !.ModuleInfo, !IOState),
term__vars_list(ArgTypes0, HeadTypeParams0),
list__delete_elems(HeadTypeParams0, ExistQVars0,
HeadTypeParams1),
@@ -463,13 +451,16 @@
%
dual_constraints(PredConstraints, Constraints),
- ( pred_info_is_field_access_function(ModuleInfo, !.PredInfo) ->
+ (
+ pred_info_is_field_access_function(!.ModuleInfo,
+ !.PredInfo)
+ ->
IsFieldAccessFunction = yes
;
IsFieldAccessFunction = no
),
pred_info_get_markers(!.PredInfo, Markers),
- typecheck_info_init(!.IOState, ModuleInfo, PredId,
+ typecheck_info_init(!.IOState, !.ModuleInfo, PredId,
IsFieldAccessFunction, TypeVarSet0, VarSet,
ExplicitVarTypes0, HeadTypeParams1,
Constraints, Status, Markers, TypeCheckInfo1),
@@ -647,9 +638,9 @@
% private_builtin.sorry(PredName).
% depending on whether the predicate is part of
% the Mercury standard library or not.
-:- pred generate_stub_clause(string, pred_info, pred_info, module_info, clause,
- prog_varset, prog_varset).
-:- mode generate_stub_clause(in, in, out, in, out, in, out) is det.
+:- pred generate_stub_clause(string::in, pred_info::in, pred_info::out,
+ module_info::in, clause::out, prog_varset::in, prog_varset::out)
+ is det.
generate_stub_clause(PredName, !PredInfo, ModuleInfo, StubClause, !VarSet) :-
%
@@ -657,7 +648,7 @@
% (i.e. record that it originally had no clauses)
%
pred_info_get_markers(!.PredInfo, Markers0),
- add_marker(Markers0, stub, Markers),
+ add_marker(stub, Markers0, Markers),
pred_info_set_markers(Markers, !PredInfo),
%
@@ -920,7 +911,7 @@
pred_info_update_goal_type(clauses, !PredInfo),
pred_info_set_clauses_info(ClausesInfo, !PredInfo),
pred_info_get_markers(!.PredInfo, Markers0),
- add_marker(Markers0, calls_are_fully_qualified, Markers),
+ add_marker(calls_are_fully_qualified, Markers0, Markers),
pred_info_set_markers(Markers, !PredInfo)
;
true
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.134
diff -u -b -r1.134 unify_gen.m
--- compiler/unify_gen.m 27 Oct 2003 05:42:37 -0000 1.134
+++ compiler/unify_gen.m 30 Oct 2003 15:41:48 -0000
@@ -551,7 +551,8 @@
code_info__produce_variable(CallPred, OldClosureCode,
OldClosure, !CI),
NewClosureCode = node([
- comment("build new closure from old closure") - "",
+ comment("build new closure from old closure")
+ - "",
assign(NumOldArgs,
lval(field(yes(0), OldClosure, Two)))
- "get number of arguments",
@@ -566,18 +567,22 @@
lval(field(yes(0), OldClosure, One)))
- "set closure code pointer",
assign(field(yes(0), lval(NewClosure), Two),
- binop(+, lval(NumOldArgs), NumNewArgs_Rval))
+ binop(+, lval(NumOldArgs),
+ NumNewArgs_Rval))
- "set new number of arguments",
- assign(NumOldArgs, binop(+, lval(NumOldArgs), Three))
+ assign(NumOldArgs, binop(+, lval(NumOldArgs),
+ Three))
- "set up loop limit",
assign(LoopCounter, Three)
- "initialize loop counter",
- % It is possible for the number of hidden arguments
- % to be zero, in which case the body of this loop
- % should not be executed at all. This is why we
- % jump to the loop condition test.
+ % It is possible for the number of hidden
+ % arguments to be zero, in which case the body
+ % of this loop should not be executed at all.
+ % This is why we jump to the loop condition
+ % test.
goto(label(LoopTest))
- - "enter the copy loop at the conceptual top",
+ - ("enter the copy loop " ++
+ "at the conceptual top"),
label(LoopStart) - "start of loop",
assign(field(yes(0), lval(NewClosure),
lval(LoopCounter)),
@@ -588,8 +593,10 @@
binop(+, lval(LoopCounter), One))
- "increment loop counter",
label(LoopTest)
- - "do we have more old arguments to copy?",
- if_val(binop(<, lval(LoopCounter), lval(NumOldArgs)),
+ - ("do we have more old arguments " ++
+ "to copy?"),
+ if_val(binop(<, lval(LoopCounter),
+ lval(NumOldArgs)),
label(LoopStart))
- "repeat the loop?"
]),
@@ -598,8 +605,8 @@
code_info__release_reg(LoopCounter, !CI),
code_info__release_reg(NumOldArgs, !CI),
code_info__release_reg(NewClosure, !CI),
- code_info__assign_lval_to_var(Var, NewClosure, AssignCode,
- !CI),
+ code_info__assign_lval_to_var(Var, NewClosure,
+ AssignCode, !CI),
Code =
tree(OldClosureCode,
tree(NewClosureCode,
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.126
diff -u -b -r1.126 unify_proc.m
--- compiler/unify_proc.m 24 Oct 2003 06:17:50 -0000 1.126
+++ compiler/unify_proc.m 30 Oct 2003 07:41:31 -0000
@@ -78,10 +78,10 @@
:- pred unify_proc__request_proc(pred_id::in, list(mode)::in, inst_varset::in,
maybe(list(is_live))::in, maybe(determinism)::in, prog_context::in,
- module_info::in, proc_id::out, module_info::out) is det.
+ proc_id::out, module_info::in, module_info::out) is det.
-% unify_proc__add_lazily_generated_unify_pred(TypeCtor,
- % UnifyPredId_for_Type, ModuleInfo0, ModuleInfo).
+ % unify_proc__add_lazily_generated_unify_pred(TypeCtor,
+ % UnifyPredId_for_Type, !ModuleInfo).
%
% For most imported unification procedures, we delay
% generating declarations and clauses until we know
@@ -93,7 +93,7 @@
pred_id::out, module_info::in, module_info::out) is det.
% unify_proc__add_lazily_generated_compare_pred_decl(TypeCtor,
- % ComparePredId_for_Type, ModuleInfo0, ModuleInfo).
+ % ComparePredId_for_Type, !ModuleInfo).
%
% Add declarations, but not clauses, for a compare or index predicate.
:- pred unify_proc__add_lazily_generated_compare_pred_decl(type_ctor::in,
@@ -108,7 +108,7 @@
% we can restore them before doing the next analysis pass.
:- pred modecheck_queued_procs(how_to_check_goal::in,
- pred_table::in, module_info::in, pred_table::out, module_info::out,
+ pred_table::in, pred_table::out, module_info::in, module_info::out,
bool::out, io__state::di, io__state::uo) is det.
% Given the type and mode of a unification, look up the
@@ -261,20 +261,21 @@
%-----------------------------------------------------------------------------%
unify_proc__request_unify(UnifyId, InstVarSet, Determinism, Context,
- ModuleInfo0, ModuleInfo) :-
+ !ModuleInfo) :-
UnifyId = TypeCtor - UnifyMode,
%
% Generating a unification procedure for a type uses its body.
%
- module_info_get_maybe_recompilation_info(ModuleInfo0, MaybeRecompInfo0),
+ module_info_get_maybe_recompilation_info(!.ModuleInfo,
+ MaybeRecompInfo0),
( MaybeRecompInfo0 = yes(RecompInfo0) ->
recompilation__record_used_item(type_body,
TypeCtor, TypeCtor, RecompInfo0, RecompInfo),
- module_info_set_maybe_recompilation_info(ModuleInfo0,
- yes(RecompInfo), ModuleInfo1)
+ module_info_set_maybe_recompilation_info(yes(RecompInfo),
+ !ModuleInfo)
;
- ModuleInfo1 = ModuleInfo0
+ true
),
%
@@ -283,16 +284,16 @@
%
(
(
- unify_proc__search_mode_num(ModuleInfo1, TypeCtor,
+ unify_proc__search_mode_num(!.ModuleInfo, TypeCtor,
UnifyMode, Determinism, _)
;
- module_info_types(ModuleInfo1, TypeTable),
+ module_info_types(!.ModuleInfo, TypeTable),
map__search(TypeTable, TypeCtor, TypeDefn),
hlds_data__get_type_defn_body(TypeDefn, TypeBody),
(
TypeCtor = TypeName - _TypeArity,
TypeName = qualified(TypeModuleName, _),
- module_info_name(ModuleInfo1, ModuleName),
+ module_info_name(!.ModuleInfo, ModuleName),
ModuleName = TypeModuleName,
TypeBody = abstract_type(_)
;
@@ -301,22 +302,21 @@
)
)
->
- ModuleInfo = ModuleInfo1
+ true
;
%
% lookup the pred_id for the unification procedure
% that we are going to generate
%
- module_info_get_special_pred_map(ModuleInfo1, SpecialPredMap),
+ module_info_get_special_pred_map(!.ModuleInfo, SpecialPredMap),
( map__search(SpecialPredMap, unify - TypeCtor, PredId0) ->
- PredId = PredId0,
- ModuleInfo2 = ModuleInfo1
+ PredId = PredId0
;
% We generate unification predicates for most
% imported types lazily, so add the declarations
% and clauses now.
unify_proc__add_lazily_generated_unify_pred(TypeCtor,
- PredId, ModuleInfo1, ModuleInfo2)
+ PredId, !ModuleInfo)
),
% convert from `uni_mode' to `list(mode)'
@@ -332,26 +332,24 @@
ArgLives = no, % XXX ArgLives should be part of the UnifyId
unify_proc__request_proc(PredId, ArgModes, InstVarSet, ArgLives,
- yes(Determinism), Context, ModuleInfo2,
- ProcId, ModuleInfo3),
+ yes(Determinism), Context, ProcId, !ModuleInfo),
%
% save the proc_id for this unify_proc_id
%
- module_info_get_proc_requests(ModuleInfo3, Requests0),
+ module_info_get_proc_requests(!.ModuleInfo, Requests0),
unify_proc__get_unify_req_map(Requests0, UnifyReqMap0),
map__set(UnifyReqMap0, UnifyId, ProcId, UnifyReqMap),
unify_proc__set_unify_req_map(Requests0, UnifyReqMap, Requests),
- module_info_set_proc_requests(ModuleInfo3, Requests,
- ModuleInfo)
+ module_info_set_proc_requests(Requests, !ModuleInfo)
).
unify_proc__request_proc(PredId, ArgModes, InstVarSet, ArgLives, MaybeDet,
- Context, ModuleInfo0, ProcId, ModuleInfo) :-
+ Context, ProcId, !ModuleInfo) :-
%
% create a new proc_info for this procedure
%
- module_info_preds(ModuleInfo0, Preds0),
+ module_info_preds(!.ModuleInfo, Preds0),
map__lookup(Preds0, PredId, PredInfo0),
list__length(ArgModes, Arity),
DeclaredArgModes = no,
@@ -377,32 +375,31 @@
map__det_update(Procs1, ProcId, ProcInfo, Procs2),
pred_info_set_procedures(Procs2, PredInfo1, PredInfo2),
map__det_update(Preds0, PredId, PredInfo2, Preds2),
- module_info_set_preds(ModuleInfo0, Preds2, ModuleInfo2),
+ module_info_set_preds(Preds2, !ModuleInfo),
%
% insert the pred_proc_id into the request queue
%
- module_info_get_proc_requests(ModuleInfo2, Requests0),
+ module_info_get_proc_requests(!.ModuleInfo, Requests0),
unify_proc__get_req_queue(Requests0, ReqQueue0),
queue__put(ReqQueue0, proc(PredId, ProcId), ReqQueue),
unify_proc__set_req_queue(Requests0, ReqQueue, Requests),
- module_info_set_proc_requests(ModuleInfo2, Requests, ModuleInfo).
+ module_info_set_proc_requests(Requests, !ModuleInfo).
%-----------------------------------------------------------------------------%
% XXX these belong in modes.m
-modecheck_queued_procs(HowToCheckGoal, OldPredTable0, ModuleInfo0,
- OldPredTable, ModuleInfo, Changed) -->
- { module_info_get_proc_requests(ModuleInfo0, Requests0) },
- { unify_proc__get_req_queue(Requests0, RequestQueue0) },
+modecheck_queued_procs(HowToCheckGoal, OldPredTable0, OldPredTable,
+ !ModuleInfo, Changed, !IO) :-
+ module_info_get_proc_requests(!.ModuleInfo, Requests0),
+ unify_proc__get_req_queue(Requests0, RequestQueue0),
(
- { queue__get(RequestQueue0, PredProcId, RequestQueue1) }
+ queue__get(RequestQueue0, PredProcId, RequestQueue1)
->
- { unify_proc__set_req_queue(Requests0, RequestQueue1,
- Requests1) },
- { module_info_set_proc_requests(ModuleInfo0, Requests1,
- ModuleInfo1) },
+ unify_proc__set_req_queue(Requests0, RequestQueue1,
+ Requests1),
+ module_info_set_proc_requests(Requests1, !ModuleInfo),
%
% Check that the procedure is valid (i.e. type-correct),
% before we attempt to do mode analysis on it.
@@ -410,26 +407,24 @@
% caused by doing mode analysis on type-incorrect code.
% XXX inefficient! This is O(N*M).
%
- { PredProcId = proc(PredId, _ProcId) },
- { module_info_predids(ModuleInfo1, ValidPredIds) },
- ( { list__member(PredId, ValidPredIds) } ->
+ PredProcId = proc(PredId, _ProcId),
+ module_info_predids(!.ModuleInfo, ValidPredIds),
+ ( list__member(PredId, ValidPredIds) ->
queued_proc_progress_message(PredProcId,
- HowToCheckGoal, ModuleInfo1),
+ HowToCheckGoal, !.ModuleInfo, !IO),
modecheck_queued_proc(HowToCheckGoal, PredProcId,
- OldPredTable0, ModuleInfo1,
- OldPredTable2, ModuleInfo2, Changed1)
+ OldPredTable0, OldPredTable2,
+ !ModuleInfo, Changed1, !IO)
;
- { OldPredTable2 = OldPredTable0 },
- { ModuleInfo2 = ModuleInfo1 },
- { Changed1 = no }
+ OldPredTable2 = OldPredTable0,
+ Changed1 = no
),
modecheck_queued_procs(HowToCheckGoal, OldPredTable2,
- ModuleInfo2, OldPredTable, ModuleInfo, Changed2),
- { bool__or(Changed1, Changed2, Changed) }
+ OldPredTable, !ModuleInfo, Changed2, !IO),
+ bool__or(Changed1, Changed2, Changed)
;
- { OldPredTable = OldPredTable0 },
- { ModuleInfo = ModuleInfo0 },
- { Changed = no }
+ OldPredTable = OldPredTable0,
+ Changed = no
).
:- pred queued_proc_progress_message(pred_proc_id, how_to_check_goal,
@@ -443,39 +438,37 @@
% print progress message
%
( { HowToCheckGoal = check_unique_modes } ->
- io__write_string(
- "% Analyzing modes, determinism, and unique-modes for\n% ")
+ io__write_string("% Analyzing modes, determinism, " ++
+ "and unique-modes for\n% ")
;
io__write_string("% Mode-analyzing ")
),
{ PredProcId = proc(PredId, ProcId) },
hlds_out__write_pred_proc_id(ModuleInfo, PredId, ProcId),
io__write_string("\n")
- /*****
- { mode_list_get_initial_insts(Modes, ModuleInfo1,
- InitialInsts) },
- io__write_string("% Initial insts: `"),
- { varset__init(InstVarSet) },
- mercury_output_inst_list(InitialInsts, InstVarSet),
- io__write_string("'\n")
- *****/
+% /*****
+% { mode_list_get_initial_insts(Modes, ModuleInfo1,
+% InitialInsts) },
+% io__write_string("% Initial insts: `"),
+% { varset__init(InstVarSet) },
+% mercury_output_inst_list(InitialInsts, InstVarSet),
+% io__write_string("'\n")
+% *****/
;
[]
).
-:- pred modecheck_queued_proc(how_to_check_goal, pred_proc_id, pred_table,
- module_info, pred_table, module_info, bool,
- io__state, io__state).
-:- mode modecheck_queued_proc(in, in, in, in, out, out, out, di, uo) is det.
-
-modecheck_queued_proc(HowToCheckGoal, PredProcId, OldPredTable0, ModuleInfo0,
- OldPredTable, ModuleInfo, Changed) -->
- {
+:- pred modecheck_queued_proc(how_to_check_goal::in, pred_proc_id::in,
+ pred_table::in, pred_table::out, module_info::in, module_info::out,
+ bool::out, io__state::di, io__state::uo) is det.
+
+modecheck_queued_proc(HowToCheckGoal, PredProcId, OldPredTable0, OldPredTable,
+ !ModuleInfo, Changed, !IO) :-
%
% mark the procedure as ready to be processed
%
PredProcId = proc(PredId, ProcId),
- module_info_preds(ModuleInfo0, Preds0),
+ module_info_preds(!.ModuleInfo, Preds0),
map__lookup(Preds0, PredId, PredInfo0),
pred_info_procedures(PredInfo0, Procs0),
map__lookup(Procs0, ProcId, ProcInfo0),
@@ -483,39 +476,31 @@
map__det_update(Procs0, ProcId, ProcInfo1, Procs1),
pred_info_set_procedures(Procs1, PredInfo0, PredInfo1),
map__det_update(Preds0, PredId, PredInfo1, Preds1),
- module_info_set_preds(ModuleInfo0, Preds1, ModuleInfo1)
- },
+ module_info_set_preds(Preds1, !ModuleInfo),
%
% modecheck the procedure
%
- modecheck_proc(ProcId, PredId, ModuleInfo1, ModuleInfo2, NumErrors,
- Changed1),
- (
- { NumErrors \= 0 }
- ->
- io__set_exit_status(1),
- { OldPredTable = OldPredTable0 },
- { module_info_remove_predid(ModuleInfo2, PredId, ModuleInfo) },
- { Changed = Changed1 }
+ modecheck_proc(ProcId, PredId, !ModuleInfo, NumErrors, Changed1, !IO),
+ ( NumErrors \= 0 ->
+ io__set_exit_status(1, !IO),
+ OldPredTable = OldPredTable0,
+ module_info_remove_predid(PredId, !ModuleInfo),
+ Changed = Changed1
+ ;
+ ( HowToCheckGoal = check_unique_modes ->
+ detect_switches_in_proc(ProcId, PredId, !ModuleInfo),
+ detect_cse_in_proc(ProcId, PredId, !ModuleInfo, !IO),
+ determinism_check_proc(ProcId, PredId, !ModuleInfo,
+ !IO),
+ save_proc_info(ProcId, PredId, !.ModuleInfo,
+ OldPredTable0, OldPredTable),
+ unique_modes__check_proc(ProcId, PredId, !ModuleInfo,
+ Changed2, !IO),
+ bool__or(Changed1, Changed2, Changed)
;
- ( { HowToCheckGoal = check_unique_modes } ->
- { detect_switches_in_proc(ProcId, PredId,
- ModuleInfo2, ModuleInfo3) },
- detect_cse_in_proc(ProcId, PredId,
- ModuleInfo3, ModuleInfo4),
- determinism_check_proc(ProcId, PredId,
- ModuleInfo4, ModuleInfo5),
- { save_proc_info(ProcId, PredId, ModuleInfo5,
- OldPredTable0, OldPredTable) },
- unique_modes__check_proc(ProcId, PredId,
- ModuleInfo5, ModuleInfo,
- Changed2),
- { bool__or(Changed1, Changed2, Changed) }
- ;
- { OldPredTable = OldPredTable0 },
- { ModuleInfo = ModuleInfo2 },
- { Changed = Changed1 }
+ OldPredTable = OldPredTable0,
+ Changed = Changed1
)
).
@@ -614,33 +599,32 @@
TVarSet, Type, TypeCtor, TypeBody, Context, ImportStatus,
PredId, ModuleInfo0, ModuleInfo).
-:- pred unify_proc__add_lazily_generated_special_pred(special_pred_id,
- unify_pred_item, tvarset, type, type_ctor, hlds_type_body,
- context, import_status, pred_id, module_info, module_info).
-:- mode unify_proc__add_lazily_generated_special_pred(in, in, in, in, in, in,
- in, in, out, in, out) is det.
+:- pred unify_proc__add_lazily_generated_special_pred(special_pred_id::in,
+ unify_pred_item::in, tvarset::in, (type)::in, type_ctor::in,
+ hlds_type_body::in, context::in, import_status::in, pred_id::out,
+ module_info::in, module_info::out) is det.
unify_proc__add_lazily_generated_special_pred(SpecialId, Item,
- TVarSet, Type, TypeCtor, TypeBody, Context, PredStatus,
- PredId, ModuleInfo0, ModuleInfo) :-
+ TVarSet, Type, TypeCtor, TypeBody, Context,
+ PredStatus, PredId, !ModuleInfo) :-
%
% Add the declaration and maybe clauses.
%
(
Item = clauses,
- make_hlds__add_special_pred_for_real(SpecialId, ModuleInfo0,
+ make_hlds__add_special_pred_for_real(SpecialId,
TVarSet, Type, TypeCtor, TypeBody, Context,
- PredStatus, ModuleInfo1)
+ PredStatus, !ModuleInfo)
;
Item = declaration,
make_hlds__add_special_pred_decl_for_real(SpecialId,
- ModuleInfo0, TVarSet, Type, TypeCtor,
- Context, PredStatus, ModuleInfo1)
+ TVarSet, Type, TypeCtor,
+ Context, PredStatus, !ModuleInfo)
),
- module_info_get_special_pred_map(ModuleInfo1, SpecialPredMap),
+ module_info_get_special_pred_map(!.ModuleInfo, SpecialPredMap),
map__lookup(SpecialPredMap, SpecialId - TypeCtor, PredId),
- module_info_pred_info(ModuleInfo1, PredId, PredInfo0),
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
%
% The clauses are generated with all type information computed,
@@ -648,21 +632,22 @@
%
(
Item = clauses,
- post_typecheck__finish_pred_no_io(ModuleInfo1,
+ post_typecheck__finish_pred_no_io(!.ModuleInfo,
ErrorProcs, PredInfo0, PredInfo)
;
Item = declaration,
- post_typecheck__finish_imported_pred_no_io(ModuleInfo1,
+ post_typecheck__finish_imported_pred_no_io(!.ModuleInfo,
ErrorProcs, PredInfo0, PredInfo)
),
require(unify(ErrorProcs, []),
-"unify_proc__add_lazily_generated_special_pred: error in post_typecheck"),
+ "unify_proc__add_lazily_generated_special_pred: " ++
+ "error in post_typecheck"),
%
% Call polymorphism to introduce type_info arguments
% for polymorphic types.
%
- module_info_set_pred_info(ModuleInfo1, PredId, PredInfo, ModuleInfo2),
+ module_info_set_pred_info(PredId, PredInfo, !ModuleInfo),
%
% Note that this will not work if the generated clauses call
@@ -671,12 +656,11 @@
% but unification predicates which contain such calls are never
% generated lazily.
%
- polymorphism__process_generated_pred(PredId, ModuleInfo2, ModuleInfo).
+ polymorphism__process_generated_pred(PredId, !ModuleInfo).
:- type unify_pred_item
---> declaration
- ; clauses
- .
+ ; clauses.
:- pred unify_proc__collect_type_defn(module_info,
type_ctor, type, tvarset, hlds_type_body, prog_context).
@@ -724,54 +708,56 @@
map__init(TI_VarMap),
map__init(TCI_VarMap),
HasForeignClauses = yes,
- ClauseInfo = clauses_info(VarSet, Types, TVarNameMap,
- Types, Args, Clauses, TI_VarMap, TCI_VarMap,
- HasForeignClauses).
+ ClauseInfo = clauses_info(VarSet, Types, TVarNameMap, Types, Args,
+ Clauses, TI_VarMap, TCI_VarMap, HasForeignClauses).
:- pred unify_proc__generate_unify_clauses(module_info::in, hlds_type_body::in,
prog_var::in, prog_var::in, prog_context::in, list(clause)::out,
unify_proc_info::in, unify_proc_info::out) is det.
unify_proc__generate_unify_clauses(ModuleInfo, TypeBody,
- H1, H2, Context, Clauses) -->
+ H1, H2, Context, Clauses, !Info) :-
(
- { type_body_has_user_defined_equality_pred(ModuleInfo,
- TypeBody, UserEqCompare) }
+ type_body_has_user_defined_equality_pred(ModuleInfo,
+ TypeBody, UserEqCompare)
->
- unify_proc__generate_user_defined_unify_clauses(
- UserEqCompare, H1, H2, Context, Clauses)
+ unify_proc__generate_user_defined_unify_clauses(UserEqCompare,
+ H1, H2, Context, Clauses, !Info)
;
(
- { Ctors = TypeBody ^ du_type_ctors },
- { IsEnum = TypeBody ^ du_type_is_enum },
- ( { IsEnum = yes } ->
+ Ctors = TypeBody ^ du_type_ctors,
+ IsEnum = TypeBody ^ du_type_is_enum,
+ (
%
- % Enumerations are atomic types, so modecheck_unify.m
- % will treat this unification as a simple_test, not
+ % Enumerations are atomic types, so
+ % modecheck_unify.m will treat this
+ % unification as a simple_test, not
% a complicated_unify.
%
- { create_atomic_unification(H1, var(H2),
- Context, explicit, [], Goal) },
- unify_proc__quantify_clauses_body([H1, H2], Goal,
- Context, Clauses)
+ IsEnum = yes,
+ create_atomic_unification(H1, var(H2),
+ Context, explicit, [], Goal),
+ unify_proc__quantify_clauses_body([H1, H2],
+ Goal, Context, Clauses, !Info)
;
- unify_proc__generate_du_unify_clauses(Ctors, H1, H2,
- Context, Clauses)
+ IsEnum = no,
+ unify_proc__generate_du_unify_clauses(Ctors,
+ H1, H2, Context, Clauses, !Info)
)
;
- { TypeBody = eqv_type(EqvType) },
+ TypeBody = eqv_type(EqvType),
generate_unify_clauses_eqv_type(EqvType, H1, H2,
- Context, Clauses)
+ Context, Clauses, !Info)
;
- { TypeBody = foreign_type(_, _) },
+ TypeBody = foreign_type(_, _),
% If no user defined equality predicate is given,
% we treat foreign_type as if they were an equivalent
% to the builtin type c_pointer.
generate_unify_clauses_eqv_type(c_pointer_type,
- H1, H2, Context, Clauses)
+ H1, H2, Context, Clauses, !Info)
;
- { TypeBody = abstract_type(_) },
- { error("trying to create unify proc for abstract type") }
+ TypeBody = abstract_type(_),
+ error("trying to create unify proc for abstract type")
)
).
@@ -780,14 +766,12 @@
unify_proc_info::in, unify_proc_info::out) is det.
unify_proc__generate_user_defined_unify_clauses(abstract_noncanonical_type,
- _, _, _, _) -->
- { error("trying to create unify proc for abstract noncanonical type") }.
+ _, _, _, _, !Info) :-
+ error("trying to create unify proc for abstract noncanonical type").
unify_proc__generate_user_defined_unify_clauses(UserEqCompare, H1, H2,
- Context, Clauses) -->
- { UserEqCompare = unify_compare(MaybeUnify, MaybeCompare) },
- (
- { MaybeUnify = yes(UnifyPredName) }
- ->
+ Context, Clauses, !Info) :-
+ UserEqCompare = unify_compare(MaybeUnify, MaybeCompare),
+ ( MaybeUnify = yes(UnifyPredName) ->
%
% Just generate a call to the specified predicate,
% which is the user-defined equality pred for this
@@ -795,15 +779,13 @@
% (The pred_id and proc_id will be figured
% out by type checking and mode analysis.)
%
- { PredId = invalid_pred_id },
- { ModeId = invalid_proc_id },
- { Call = call(PredId, ModeId, [H1, H2], not_builtin,
- no, UnifyPredName) },
- { goal_info_init(Context, GoalInfo) },
- { Goal = Call - GoalInfo }
- ;
- { MaybeCompare = yes(ComparePredName) }
- ->
+ PredId = invalid_pred_id,
+ ModeId = invalid_proc_id,
+ Call = call(PredId, ModeId, [H1, H2], not_builtin, no,
+ UnifyPredName),
+ goal_info_init(Context, GoalInfo),
+ Goal = Call - GoalInfo
+ ; MaybeCompare = yes(ComparePredName) ->
%
% Just generate a call to the specified predicate,
% which is the user-defined comparison pred for this
@@ -811,29 +793,31 @@
% (The pred_id and proc_id will be figured
% out by type checking and mode analysis.)
%
- unify_proc__info_new_var(comparison_result_type, ResultVar),
- { PredId = invalid_pred_id },
- { ModeId = invalid_proc_id },
- { Call = call(PredId, ModeId, [ResultVar, H1, H2],
- not_builtin, no, ComparePredName) },
- { goal_info_init(Context, GoalInfo) },
- { CallGoal = Call - GoalInfo },
+ unify_proc__info_new_var(comparison_result_type, ResultVar,
+ !Info),
+ PredId = invalid_pred_id,
+ ModeId = invalid_proc_id,
+ Call = call(PredId, ModeId, [ResultVar, H1, H2], not_builtin,
+ no, ComparePredName),
+ goal_info_init(Context, GoalInfo),
+ CallGoal = Call - GoalInfo,
- { mercury_public_builtin_module(Builtin) },
- { create_atomic_unification(ResultVar,
+ mercury_public_builtin_module(Builtin),
+ create_atomic_unification(ResultVar,
functor(cons(qualified(Builtin, "="), 0), no, []),
- Context, explicit, [], UnifyGoal) },
- { Goal = conj([CallGoal, UnifyGoal]) - GoalInfo }
+ Context, explicit, [], UnifyGoal),
+ Goal = conj([CallGoal, UnifyGoal]) - GoalInfo
;
- { error("unify_proc__generate_user_defined_unify_clauses") }
+ error("unify_proc__generate_user_defined_unify_clauses")
),
- unify_proc__quantify_clauses_body([H1, H2], Goal, Context, Clauses).
+ unify_proc__quantify_clauses_body([H1, H2], Goal, Context, Clauses,
+ !Info).
:- pred generate_unify_clauses_eqv_type((type)::in, prog_var::in, prog_var::in,
prog_context::in, list(clause)::out,
unify_proc_info::in, unify_proc_info::out) is det.
-generate_unify_clauses_eqv_type(EqvType, H1, H2, Context, Clauses) -->
+generate_unify_clauses_eqv_type(EqvType, H1, H2, Context, Clauses, !Info) :-
% We should check whether EqvType is a type variable,
% an abstract type or a concrete type.
% If it is type variable, then we should generate the same code
@@ -842,19 +826,19 @@
% we should generate the body of its unification procedure
% inline here.
unify_proc__make_fresh_named_var_from_type(EqvType,
- "Cast_HeadVar", 1, CastVar1),
+ "Cast_HeadVar", 1, CastVar1, !Info),
unify_proc__make_fresh_named_var_from_type(EqvType,
- "Cast_HeadVar", 2, CastVar2),
- { generate_unsafe_cast(H1, CastVar1, Context, Cast1Goal) },
- { generate_unsafe_cast(H2, CastVar2, Context, Cast2Goal) },
- { create_atomic_unification(CastVar1, var(CastVar2), Context,
- explicit, [], UnifyGoal) },
-
- { goal_info_init(GoalInfo0) },
- { goal_info_set_context(GoalInfo0, Context, GoalInfo) },
- { conj_list_to_goal([Cast1Goal, Cast2Goal, UnifyGoal],
- GoalInfo, Goal) },
- unify_proc__quantify_clauses_body([H1, H2], Goal, Context, Clauses).
+ "Cast_HeadVar", 2, CastVar2, !Info),
+ generate_unsafe_cast(H1, CastVar1, Context, Cast1Goal),
+ generate_unsafe_cast(H2, CastVar2, Context, Cast2Goal),
+ create_atomic_unification(CastVar1, var(CastVar2), Context,
+ explicit, [], UnifyGoal),
+
+ goal_info_init(GoalInfo0),
+ goal_info_set_context(GoalInfo0, Context, GoalInfo),
+ conj_list_to_goal([Cast1Goal, Cast2Goal, UnifyGoal], GoalInfo, Goal),
+ unify_proc__quantify_clauses_body([H1, H2], Goal, Context, Clauses,
+ !Info).
% This predicate generates the bodies of index predicates for the
% types that need index predicates.
@@ -868,8 +852,8 @@
unify_proc_info::in, unify_proc_info::out) is det.
unify_proc__generate_index_clauses(ModuleInfo, TypeBody,
- X, Index, Context, Clauses) -->
- ( { type_body_has_user_defined_equality_pred(ModuleInfo, TypeBody, _) } ->
+ X, Index, Context, Clauses, !Info) :-
+ ( type_body_has_user_defined_equality_pred(ModuleInfo, TypeBody, _) ->
%
% For non-canonical types, the generated comparison
% predicate either calls a user-specified comparison
@@ -877,40 +861,43 @@
% type's index predicate, so do not generate an index
% predicate for such types.
%
- { error("trying to create index proc for non-canonical type") }
+ error("trying to create index proc for non-canonical type")
;
(
- { Ctors = TypeBody ^ du_type_ctors },
- { IsEnum = TypeBody ^ du_type_is_enum },
- ( { IsEnum = yes } ->
- %
- % For enum types, the generated comparison predicate
- % performs an integer comparison, and does not call the
- % type's index predicate, so do not generate an index
- % predicate for such types.
+ Ctors = TypeBody ^ du_type_ctors,
+ IsEnum = TypeBody ^ du_type_is_enum,
+ (
%
- { error("trying to create index proc for enum type") }
+ % For enum types, the generated comparison
+ % predicate performs an integer comparison,
+ % and does not call the type's index predicate,
+ % so do not generate an index predicate for
+ % such types.
+ %
+ IsEnum = yes,
+ error("trying to create index proc " ++
+ "for enum type")
;
- unify_proc__generate_du_index_clauses(Ctors, X, Index,
- Context, 0, Clauses)
+ IsEnum = no,
+ unify_proc__generate_du_index_clauses(Ctors,
+ X, Index, Context, 0, Clauses, !Info)
)
;
- { TypeBody = eqv_type(_Type) },
- % The only place that the index predicate for a type can ever
- % be called from is the compare predicate for that type.
- % However, the compare predicate for an equivalence type
- % never calls the index predicate for that type; it calls
- % the compare predicate of the expanded type instead.
- %
- % Therefore the clause body we are generating should never be
- % invoked.
- { error("trying to create index proc for eqv type") }
+ TypeBody = eqv_type(_Type),
+ % The only place that the index predicate for a type
+ % can ever be called from is the compare predicate
+ % for that type. However, the compare predicate for
+ % an equivalence type never calls the index predicate
+ % for that type; it calls the compare predicate of
+ % the expanded type instead. Therefore the clause body
+ % we are generating should never be invoked.
+ error("trying to create index proc for eqv type")
;
- { TypeBody = foreign_type(_, _) },
- { error("trying to create index proc for a foreign type") }
+ TypeBody = foreign_type(_, _),
+ error("trying to create index proc for a foreign type")
;
- { TypeBody = abstract_type(_) },
- { error("trying to create index proc for abstract type") }
+ TypeBody = abstract_type(_),
+ error("trying to create index proc for abstract type")
)
).
@@ -920,53 +907,59 @@
unify_proc_info::in, unify_proc_info::out) is det.
unify_proc__generate_compare_clauses(ModuleInfo, Type, TypeBody, Res,
- H1, H2, Context, Clauses) -->
+ H1, H2, Context, Clauses, !Info) :-
(
- { type_body_has_user_defined_equality_pred(ModuleInfo,
- TypeBody, UserEqComp) }
+ type_body_has_user_defined_equality_pred(ModuleInfo,
+ TypeBody, UserEqComp)
->
generate_user_defined_compare_clauses(UserEqComp,
- Res, H1, H2, Context, Clauses)
+ Res, H1, H2, Context, Clauses, !Info)
;
(
- { Ctors = TypeBody ^ du_type_ctors },
- { IsEnum = TypeBody ^ du_type_is_enum },
- ( { IsEnum = yes } ->
- { IntType = int_type },
- unify_proc__make_fresh_named_var_from_type(IntType,
- "Cast_HeadVar", 1, CastVar1),
- unify_proc__make_fresh_named_var_from_type(IntType,
- "Cast_HeadVar", 2, CastVar2),
- { generate_unsafe_cast(H1, CastVar1, Context,
- Cast1Goal) },
- { generate_unsafe_cast(H2, CastVar2, Context,
- Cast2Goal) },
+ Ctors = TypeBody ^ du_type_ctors,
+ IsEnum = TypeBody ^ du_type_is_enum,
+ (
+ IsEnum = yes,
+ IntType = int_type,
+ unify_proc__make_fresh_named_var_from_type(
+ IntType, "Cast_HeadVar", 1, CastVar1,
+ !Info),
+ unify_proc__make_fresh_named_var_from_type(
+ IntType, "Cast_HeadVar", 2, CastVar2,
+ !Info),
+ generate_unsafe_cast(H1, CastVar1, Context,
+ Cast1Goal),
+ generate_unsafe_cast(H2, CastVar2, Context,
+ Cast2Goal),
unify_proc__build_call("builtin_compare_int",
[Res, CastVar1, CastVar2], Context,
- CompareGoal),
+ CompareGoal, !Info),
- { goal_info_init(GoalInfo0) },
- { goal_info_set_context(GoalInfo0, Context,
- GoalInfo) },
- { conj_list_to_goal([Cast1Goal, Cast2Goal,
- CompareGoal], GoalInfo, Goal) },
- unify_proc__quantify_clauses_body([Res, H1, H2], Goal,
- Context, Clauses)
+ goal_info_init(GoalInfo0),
+ goal_info_set_context(GoalInfo0, Context,
+ GoalInfo),
+ conj_list_to_goal([Cast1Goal, Cast2Goal,
+ CompareGoal], GoalInfo, Goal),
+ unify_proc__quantify_clauses_body(
+ [Res, H1, H2], Goal, Context, Clauses,
+ !Info)
;
- unify_proc__generate_du_compare_clauses(Type, Ctors,
- Res, H1, H2, Context, Clauses)
+ IsEnum = no,
+ unify_proc__generate_du_compare_clauses(Type,
+ Ctors, Res, H1, H2, Context, Clauses,
+ !Info)
)
;
- { TypeBody = eqv_type(EqvType) },
+ TypeBody = eqv_type(EqvType),
generate_compare_clauses_eqv_type(EqvType,
- Res, H1, H2, Context, Clauses)
+ Res, H1, H2, Context, Clauses, !Info)
;
- { TypeBody = foreign_type(_, _) },
+ TypeBody = foreign_type(_, _),
generate_compare_clauses_eqv_type(c_pointer_type,
- Res, H1, H2, Context, Clauses)
+ Res, H1, H2, Context, Clauses, !Info)
;
- { TypeBody = abstract_type(_) },
- { error("trying to create compare proc for abstract type") }
+ TypeBody = abstract_type(_),
+ error("trying to create compare proc for abstract type")
)
).
@@ -976,13 +969,12 @@
unify_proc_info::in, unify_proc_info::out) is det.
generate_user_defined_compare_clauses(abstract_noncanonical_type,
- _, _, _, _, _) -->
- { error(
- "trying to create compare proc for abstract noncanonical type") }.
+ _, _, _, _, _, !Info) :-
+ error("trying to create compare proc for abstract noncanonical type").
generate_user_defined_compare_clauses(unify_compare(_, MaybeCompare),
- Res, H1, H2, Context, Clauses) -->
- { ArgVars = [Res, H1, H2] },
- ( { MaybeCompare = yes(ComparePredName) } ->
+ Res, H1, H2, Context, Clauses, !Info) :-
+ ArgVars = [Res, H1, H2],
+ ( MaybeCompare = yes(ComparePredName) ->
%
% Just generate a call to the specified predicate,
% which is the user-defined comparison pred for this
@@ -990,28 +982,29 @@
% (The pred_id and proc_id will be figured
% out by type checking and mode analysis.)
%
- { PredId = invalid_pred_id },
- { ModeId = invalid_proc_id },
- { Call = call(PredId, ModeId, ArgVars, not_builtin,
- no, ComparePredName) },
- { goal_info_init(Context, GoalInfo) },
- { Goal = Call - GoalInfo }
+ PredId = invalid_pred_id,
+ ModeId = invalid_proc_id,
+ Call = call(PredId, ModeId, ArgVars, not_builtin,
+ no, ComparePredName),
+ goal_info_init(Context, GoalInfo),
+ Goal = Call - GoalInfo
;
%
% just generate code that will call error/1
%
- unify_proc__build_call(
- "builtin_compare_non_canonical_type",
- ArgVars, Context, Goal)
+ unify_proc__build_call("builtin_compare_non_canonical_type",
+ ArgVars, Context, Goal, !Info)
),
- unify_proc__quantify_clauses_body(ArgVars, Goal, Context, Clauses).
+ unify_proc__quantify_clauses_body(ArgVars, Goal, Context, Clauses,
+ !Info).
:- pred generate_compare_clauses_eqv_type((type)::in,
prog_var::in, prog_var::in, prog_var::in,
prog_context::in, list(clause)::out,
unify_proc_info::in, unify_proc_info::out) is det.
-generate_compare_clauses_eqv_type(EqvType, Res, H1, H2, Context, Clauses) -->
+generate_compare_clauses_eqv_type(EqvType, Res, H1, H2, Context, Clauses,
+ !Info) :-
% We should check whether EqvType is a type variable,
% an abstract type or a concrete type.
% If it is type variable, then we should generate the same code
@@ -1020,28 +1013,29 @@
% we should generate the body of its comparison procedure
% inline here.
unify_proc__make_fresh_named_var_from_type(EqvType,
- "Cast_HeadVar", 1, CastVar1),
+ "Cast_HeadVar", 1, CastVar1, !Info),
unify_proc__make_fresh_named_var_from_type(EqvType,
- "Cast_HeadVar", 2, CastVar2),
- { generate_unsafe_cast(H1, CastVar1, Context, Cast1Goal) },
- { generate_unsafe_cast(H2, CastVar2, Context, Cast2Goal) },
+ "Cast_HeadVar", 2, CastVar2, !Info),
+ generate_unsafe_cast(H1, CastVar1, Context, Cast1Goal),
+ generate_unsafe_cast(H2, CastVar2, Context, Cast2Goal),
unify_proc__build_call("compare", [Res, CastVar1, CastVar2],
- Context, CompareGoal),
+ Context, CompareGoal, !Info),
- { goal_info_init(GoalInfo0) },
- { goal_info_set_context(GoalInfo0, Context, GoalInfo) },
- { conj_list_to_goal([Cast1Goal, Cast2Goal, CompareGoal],
- GoalInfo, Goal) },
+ goal_info_init(GoalInfo0),
+ goal_info_set_context(GoalInfo0, Context, GoalInfo),
+ conj_list_to_goal([Cast1Goal, Cast2Goal, CompareGoal],
+ GoalInfo, Goal),
unify_proc__quantify_clauses_body([Res, H1, H2], Goal, Context,
- Clauses).
+ Clauses, !Info).
:- pred unify_proc__quantify_clauses_body(list(prog_var)::in, hlds_goal::in,
prog_context::in, list(clause)::out,
unify_proc_info::in, unify_proc_info::out) is det.
-unify_proc__quantify_clauses_body(HeadVars, Goal, Context, Clauses) -->
- unify_proc__quantify_clause_body(HeadVars, Goal, Context, Clause),
- { Clauses = [Clause] }.
+unify_proc__quantify_clauses_body(HeadVars, Goal, Context, Clauses, !Info) :-
+ unify_proc__quantify_clause_body(HeadVars, Goal, Context, Clause,
+ !Info),
+ Clauses = [Clause].
:- pred unify_proc__quantify_clause_body(list(prog_var)::in, hlds_goal::in,
prog_context::in, clause::out,
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.87
diff -u -b -r1.87 unused_args.m
--- compiler/unused_args.m 24 Oct 2003 06:17:51 -0000 1.87
+++ compiler/unused_args.m 29 Oct 2003 22:31:25 -0000
@@ -316,8 +316,7 @@
FuncId, unused_args_func_info(PredArity),
any_call, MaybeBestResult,
AnalysisInfo0, AnalysisInfo, !IO),
- module_info_set_analysis_info(!.ModuleInfo,
- AnalysisInfo, !:ModuleInfo),
+ module_info_set_analysis_info(AnalysisInfo, !ModuleInfo),
( MaybeBestResult = yes(_ - unused_args(UnusedArgs)) ->
proc_info_headvars(ProcInfo, HeadVars),
list__map(list__index1_det(HeadVars),
@@ -898,8 +897,8 @@
unused_args(UnusedArgs),
AnalysisInfo1, AnalysisInfo)
),
- module_info_set_analysis_info(!.ModuleInfo,
- AnalysisInfo, !:ModuleInfo),
+ module_info_set_analysis_info(AnalysisInfo,
+ !ModuleInfo),
%
% XXX Mark versions which have more unused arguments
@@ -954,8 +953,7 @@
module_info_get_predicate_table(!.ModuleInfo, PredTable0),
predicate_table_insert(PredTable0,
NewPredInfo, NewPredId, PredTable),
- module_info_set_predicate_table(!.ModuleInfo,
- PredTable, !:ModuleInfo),
+ module_info_set_predicate_table(PredTable, !ModuleInfo),
% add the new proc to the proc_call_info map
PredSymName = qualified(PredModule, NewPredName),
@@ -967,9 +965,8 @@
% original interface.
create_call_goal(UnusedArgs, NewPredId, ProcId, PredModule,
NewPredName, OrigProcInfo, ForwardingProcInfo),
- module_info_set_pred_proc_info(!.ModuleInfo,
- PredId, ProcId, OrigPredInfo,
- ForwardingProcInfo, !:ModuleInfo),
+ module_info_set_pred_proc_info(PredId, ProcId, OrigPredInfo,
+ ForwardingProcInfo, !ModuleInfo),
% add forwarding predicates for results
% produced in previous compilations.
@@ -1006,7 +1003,7 @@
pred_info_set_procedures(ExtraProcs, ExtraPredInfo0, ExtraPredInfo),
module_info_get_predicate_table(!.ModuleInfo, PredTable0),
predicate_table_insert(PredTable0, ExtraPredInfo, _, PredTable),
- module_info_set_predicate_table(!.ModuleInfo, PredTable, !:ModuleInfo).
+ module_info_set_predicate_table(PredTable, !ModuleInfo).
:- pred make_new_pred_info(module_info::in, list(int)::in, import_status::in,
pred_proc_id::in, pred_info::in, pred_info::out) is det.
@@ -1118,11 +1115,11 @@
module_info::in, module_info::out) is det.
make_imported_unused_args_pred_info(OptProc, UnusedArgs,
- ProcCallInfo0, ProcCallInfo, ModuleInfo0, ModuleInfo) :-
+ ProcCallInfo0, ProcCallInfo, !ModuleInfo) :-
OptProc = proc(PredId, ProcId),
- module_info_pred_proc_info(ModuleInfo0,
+ module_info_pred_proc_info(!.ModuleInfo,
PredId, ProcId, PredInfo0, ProcInfo0),
- make_new_pred_info(ModuleInfo0, UnusedArgs, imported(interface),
+ make_new_pred_info(!.ModuleInfo, UnusedArgs, imported(interface),
OptProc, PredInfo0, NewPredInfo0),
pred_info_procedures(NewPredInfo0, NewProcs0),
@@ -1137,9 +1134,9 @@
pred_info_set_procedures(NewProcs, NewPredInfo0, NewPredInfo),
% Add the new proc to the pred table.
- module_info_get_predicate_table(ModuleInfo0, PredTable0),
+ module_info_get_predicate_table(!.ModuleInfo, PredTable0),
predicate_table_insert(PredTable0, NewPredInfo, NewPredId, PredTable1),
- module_info_set_predicate_table(ModuleInfo0, PredTable1, ModuleInfo),
+ module_info_set_predicate_table(PredTable1, !ModuleInfo),
PredModule = pred_info_module(NewPredInfo),
PredName = pred_info_name(NewPredInfo),
PredSymName = qualified(PredModule, PredName),
@@ -1275,7 +1272,7 @@
map__set(Procs0, ProcId, FixedProc5, Procs),
pred_info_set_procedures(Procs, PredInfo0, PredInfo),
map__set(Preds0, PredId, PredInfo, Preds),
- module_info_set_preds(Mod0, Preds, Mod).
+ module_info_set_preds(Preds, Mod0, Mod).
% this is the important bit of the transformation
:- pred fixup_goal(module_info::in, list(prog_var)::in, proc_call_info::in,
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing java
cvs diff: Diffing java/library
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/list.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/list.m,v
retrieving revision 1.115
diff -u -b -r1.115 list.m
--- library/list.m 23 Oct 2003 02:02:26 -0000 1.115
+++ library/list.m 29 Oct 2003 18:54:39 -0000
@@ -528,10 +528,8 @@
:- func list__foldr(func(X, Y) = Y, list(X), Y) = Y.
- % list__foldl2(Pred, List, Start, End, Start2, End2)
- % calls Pred with each element of List (working left-to-right),
- % 2 accumulators (with the initial values of Start and Start2),
- % and returns the final values in End and End2.
+ % list__foldl2(Pred, List, !Acc1, !Acc2)
+ % Does the same job as list__foldl, but with two accumulators.
% (Although no more expressive than list__foldl, this is often
% a more convenient format, and a little more efficient).
:- pred list__foldl2(pred(X, Y, Y, Z, Z), list(X), Y, Y, Z, Z).
@@ -548,10 +546,8 @@
:- mode list__foldl2(pred(in, di, uo, di, uo) is det,
in, di, uo, di, uo) is det.
- % list__foldl3(Pred, List, Start1, End1, Start2, End2, Start3, End3)
- % calls Pred with each element of List (working left-to-right),
- % 3 accumulators (with the initial values of Start1, Start2 and Start3),
- % and returns the final values in End1, End2 and End3.
+ % list__foldl3(Pred, List, !Acc1, !Acc2, !Acc3)
+ % Does the same job as list__foldl, but with two accumulators.
% (Although no more expressive than list__foldl, this is often
% a more convenient format, and a little more efficient).
:- pred list__foldl3(pred(L, A1, A1, A2, A2, A3, A3), list(L),
@@ -565,6 +561,21 @@
:- mode list__foldl3(pred(in, in, out, in, out, di, uo) is det,
in, in, out, in, out, di, uo) is det.
+ % list__foldl4(Pred, List, !Acc1, !Acc2, !Acc3, !Acc4)
+ % Does the same job as list__foldl, but with two accumulators.
+ % (Although no more expressive than list__foldl, this is often
+ % a more convenient format, and a little more efficient).
+:- pred list__foldl4(pred(L, A1, A1, A2, A2, A3, A3, A4, A4), list(L),
+ A1, A1, A2, A2, A3, A3, A4, A4).
+:- mode list__foldl4(pred(in, in, out, in, out, in, out, in, out) is det,
+ in, in, out, in, out, in, out, in, out) is det.
+:- mode list__foldl4(pred(in, in, out, in, out, in, out, in, out) is semidet,
+ in, in, out, in, out, in, out, in, out) is semidet.
+:- mode list__foldl4(pred(in, in, out, in, out, in, out, in, out) is nondet,
+ in, in, out, in, out, in, out, in, out) is nondet.
+:- mode list__foldl4(pred(in, in, out, in, out, in, out, di, uo) is det,
+ in, in, out, in, out, in, out, di, uo) is det.
+
% list__map_foldl(Pred, InList, OutList, Start, End) calls Pred
% with an accumulator (with the initial value of Start) on
% each element of InList (working left-to-right) to transform
@@ -1335,35 +1346,35 @@
mismatched list arguments")
).
-list__foldl(_, [], Acc, Acc).
-list__foldl(P, [H | T], Acc0, Acc) :-
- call(P, H, Acc0, Acc1),
- list__foldl(P, T, Acc1, Acc).
-
-list__foldl2(_, [], FirstAcc, FirstAcc, SecAcc, SecAcc).
-list__foldl2(P, [H | T], FirstAcc0, FirstAcc, SecAcc0, SecAcc) :-
- call(P, H, FirstAcc0, FirstAcc1, SecAcc0, SecAcc1),
- list__foldl2(P, T, FirstAcc1, FirstAcc, SecAcc1, SecAcc).
-
-list__foldl3(_, [], FirstAcc, FirstAcc, SecAcc, SecAcc, ThirdAcc, ThirdAcc).
-list__foldl3(P, [H | T], FirstAcc0, FirstAcc, SecAcc0, SecAcc,
- ThirdAcc0, ThirdAcc) :-
- call(P, H, FirstAcc0, FirstAcc1, SecAcc0, SecAcc1,
- ThirdAcc0, ThirdAcc1),
- list__foldl3(P, T, FirstAcc1, FirstAcc, SecAcc1, SecAcc,
- ThirdAcc1, ThirdAcc).
-
-list__map_foldl(_, [], []) -->
- [].
-list__map_foldl(P, [H0 | T0], [H | T]) -->
- call(P, H0, H),
- list__map_foldl(P, T0, T).
-
-list__map2_foldl(_, [], [], []) -->
- [].
-list__map2_foldl(P, [H0 | T0], [H1 | T1], [H2 | T2]) -->
- call(P, H0, H1, H2),
- list__map2_foldl(P, T0, T1, T2).
+list__foldl(_, [], !A).
+list__foldl(P, [H | T], !A) :-
+ call(P, H, !A),
+ list__foldl(P, T, !A).
+
+list__foldl2(_, [], !A, !B).
+list__foldl2(P, [H | T], !A, !B) :-
+ call(P, H, !A, !B),
+ list__foldl2(P, T, !A, !B).
+
+list__foldl3(_, [], !A, !B, !C).
+list__foldl3(P, [H | T], !A, !B, !C) :-
+ call(P, H, !A, !B, !C),
+ list__foldl3(P, T, !A, !B, !C).
+
+list__foldl4(_, [], !A, !B, !C, !D).
+list__foldl4(P, [H | T], !A, !B, !C, !D) :-
+ call(P, H, !A, !B, !C, !D),
+ list__foldl4(P, T, !A, !B, !C, !D).
+
+list__map_foldl(_, [], [], !A).
+list__map_foldl(P, [H0 | T0], [H | T], !A) :-
+ call(P, H0, H, !A),
+ list__map_foldl(P, T0, T, !A).
+
+list__map2_foldl(_, [], [], [], !A).
+list__map2_foldl(P, [H0 | T0], [H1 | T1], [H2 | T2], !A) :-
+ call(P, H0, H1, H2, !A),
+ list__map2_foldl(P, T0, T1, T2, !A).
list__map_foldl2(_, [], [], !A, !B).
list__map_foldl2(P, [H0 | T0], [H | T], !A, !B) :-
@@ -1375,10 +1386,10 @@
call(P, H0, H, !A, !B, !C),
list__map_foldl3(P, T0, T, !A, !B, !C).
-list__foldr(_, [], Acc, Acc).
-list__foldr(P, [H | T], Acc0, Acc) :-
- list__foldr(P, T, Acc0, Acc1),
- call(P, H, Acc1, Acc).
+list__foldr(_, [], !A).
+list__foldr(P, [H | T], !A) :-
+ list__foldr(P, T, !A),
+ call(P, H, !A).
list__filter(P, Xs, Ys) :-
list__filter(P, Xs, Ys, _).
Index: library/map.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/map.m,v
retrieving revision 1.83
diff -u -b -r1.83 map.m
--- library/map.m 30 Oct 2003 05:31:27 -0000 1.83
+++ library/map.m 31 Oct 2003 00:00:52 -0000
@@ -302,6 +302,23 @@
:- mode map__foldl2(pred(in, in, di, uo, di, uo) is det,
in, di, uo, di, uo) is det.
+ % Perform an inorder traversal of the map, applying
+ % an accumulator predicate with three accumulators for
+ % each key-value pair.
+ % (Although no more expressive than map__foldl, this is often
+ % a more convenient format, and a little more efficient).
+:- pred map__foldl3(pred(K, V, T, T, U, U, W, W), map(K, V), T, T, U, U, W, W).
+:- mode map__foldl3(pred(in, in, in, out, in, out, in, out) is det,
+ in, in, out, in, out, in, out) is det.
+:- mode map__foldl3(pred(in, in, in, out, in, out, in, out) is semidet,
+ in, in, out, in, out, in, out) is semidet.
+:- mode map__foldl3(pred(in, in, in, out, in, out, di, uo) is det,
+ in, in, out, in, out, di, uo) is det.
+:- mode map__foldl3(pred(in, in, in, out, di, uo, di, uo) is det,
+ in, in, out, di, uo, di, uo) is det.
+:- mode map__foldl3(pred(in, in, di, uo, di, uo, di, uo) is det,
+ in, di, uo, di, uo, di, uo) is det.
+
% Apply a transformation predicate to all the values
% in a map.
:- pred map__map_values(pred(K, V, W), map(K, V), map(K, W)).
@@ -674,13 +691,14 @@
%-----------------------------------------------------------------------------%
-map__foldl(Pred, Map, Acc0, Acc) :-
- tree234__foldl(Pred, Map, Acc0, Acc).
+map__foldl(Pred, Map, !A) :-
+ tree234__foldl(Pred, Map, !A).
-%-----------------------------------------------------------------------------%
+map__foldl2(Pred, Map, !A, !B) :-
+ tree234__foldl2(Pred, Map, !A, !B).
-map__foldl2(Pred, Map, Acc0, Acc) -->
- tree234__foldl2(Pred, Map, Acc0, Acc).
+map__foldl3(Pred, Map, !A, !B, !C) :-
+ tree234__foldl3(Pred, Map, !A, !B, !C).
%-----------------------------------------------------------------------------%
Index: library/tree234.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/tree234.m,v
retrieving revision 1.38
diff -u -b -r1.38 tree234.m
--- library/tree234.m 17 Aug 2003 13:30:13 -0000 1.38
+++ library/tree234.m 29 Oct 2003 19:08:34 -0000
@@ -148,6 +148,18 @@
:- mode tree234__foldl2(pred(in, in, di, uo, di, uo) is det,
in, di, uo, di, uo) is det.
+:- pred tree234__foldl3(pred(K, V, T, T, U, U, W, W), tree234(K, V),
+ T, T, U, U, W, W).
+:- mode tree234__foldl3(pred(in, in, in, out, in, out, in, out) is det,
+ in, in, out, in, out, in, out) is det.
+:- mode tree234__foldl3(pred(in, in, in, out, in, out, in, out) is semidet,
+ in, in, out, in, out, in, out) is semidet.
+:- mode tree234__foldl3(pred(in, in, in, out, in, out, di, uo) is det,
+ in, in, out, in, out, di, uo) is det.
+:- mode tree234__foldl3(pred(in, in, in, out, di, uo, di, uo) is det,
+ in, in, out, di, uo, di, uo) is det.
+:- mode tree234__foldl3(pred(in, in, di, uo, di, uo, di, uo) is det,
+ in, di, uo, di, uo, di, uo) is det.
:- pred tree234__map_values(pred(K, V, W), tree234(K, V), tree234(K, W)).
:- mode tree234__map_values(pred(in, in, out) is det, in, out) is det.
@@ -2394,45 +2406,66 @@
%------------------------------------------------------------------------------%
-tree234__foldl(_Pred, empty, Acc, Acc).
-tree234__foldl(Pred, two(K, V, T0, T1), Acc0, Acc) :-
- tree234__foldl(Pred, T0, Acc0, Acc1),
- call(Pred, K, V, Acc1, Acc2),
- tree234__foldl(Pred, T1, Acc2, Acc).
-tree234__foldl(Pred, three(K0, V0, K1, V1, T0, T1, T2), Acc0, Acc) :-
- tree234__foldl(Pred, T0, Acc0, Acc1),
- call(Pred, K0, V0, Acc1, Acc2),
- tree234__foldl(Pred, T1, Acc2, Acc3),
- call(Pred, K1, V1, Acc3, Acc4),
- tree234__foldl(Pred, T2, Acc4, Acc).
-tree234__foldl(Pred, four(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3), Acc0, Acc) :-
- tree234__foldl(Pred, T0, Acc0, Acc1),
- call(Pred, K0, V0, Acc1, Acc2),
- tree234__foldl(Pred, T1, Acc2, Acc3),
- call(Pred, K1, V1, Acc3, Acc4),
- tree234__foldl(Pred, T2, Acc4, Acc5),
- call(Pred, K2, V2, Acc5, Acc6),
- tree234__foldl(Pred, T3, Acc6, Acc).
-
-tree234__foldl2(_Pred, empty, A, A) --> [].
-tree234__foldl2(Pred, two(K, V, T0, T1), A0, A) -->
- tree234__foldl2(Pred, T0, A0, A1),
- call(Pred, K, V, A1, A2),
- tree234__foldl2(Pred, T1, A2, A).
-tree234__foldl2(Pred, three(K0, V0, K1, V1, T0, T1, T2), A0, A) -->
- tree234__foldl2(Pred, T0, A0, A1),
- call(Pred, K0, V0, A1, A2),
- tree234__foldl2(Pred, T1, A2, A3),
- call(Pred, K1, V1, A3, A4),
- tree234__foldl2(Pred, T2, A4, A).
-tree234__foldl2(Pred, four(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3), A0, A) -->
- tree234__foldl2(Pred, T0, A0, A1),
- call(Pred, K0, V0, A1, A2),
- tree234__foldl2(Pred, T1, A2, A3),
- call(Pred, K1, V1, A3, A4),
- tree234__foldl2(Pred, T2, A4, A5),
- call(Pred, K2, V2, A5, A6),
- tree234__foldl2(Pred, T3, A6, A).
+tree234__foldl(_Pred, empty, !A).
+tree234__foldl(Pred, two(K, V, T0, T1), !A) :-
+ tree234__foldl(Pred, T0, !A),
+ call(Pred, K, V, !A),
+ tree234__foldl(Pred, T1, !A).
+tree234__foldl(Pred, three(K0, V0, K1, V1, T0, T1, T2), !A) :-
+ tree234__foldl(Pred, T0, !A),
+ call(Pred, K0, V0, !A),
+ tree234__foldl(Pred, T1, !A),
+ call(Pred, K1, V1, !A),
+ tree234__foldl(Pred, T2, !A).
+tree234__foldl(Pred, four(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3), !A) :-
+ tree234__foldl(Pred, T0, !A),
+ call(Pred, K0, V0, !A),
+ tree234__foldl(Pred, T1, !A),
+ call(Pred, K1, V1, !A),
+ tree234__foldl(Pred, T2, !A),
+ call(Pred, K2, V2, !A),
+ tree234__foldl(Pred, T3, !A).
+
+tree234__foldl2(_Pred, empty, !A, !B).
+tree234__foldl2(Pred, two(K, V, T0, T1), !A, !B) :-
+ tree234__foldl2(Pred, T0, !A, !B),
+ call(Pred, K, V, !A, !B),
+ tree234__foldl2(Pred, T1, !A, !B).
+tree234__foldl2(Pred, three(K0, V0, K1, V1, T0, T1, T2), !A, !B) :-
+ tree234__foldl2(Pred, T0, !A, !B),
+ call(Pred, K0, V0, !A, !B),
+ tree234__foldl2(Pred, T1, !A, !B),
+ call(Pred, K1, V1, !A, !B),
+ tree234__foldl2(Pred, T2, !A, !B).
+tree234__foldl2(Pred, four(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3), !A, !B) :-
+ tree234__foldl2(Pred, T0, !A, !B),
+ call(Pred, K0, V0, !A, !B),
+ tree234__foldl2(Pred, T1, !A, !B),
+ call(Pred, K1, V1, !A, !B),
+ tree234__foldl2(Pred, T2, !A, !B),
+ call(Pred, K2, V2, !A, !B),
+ tree234__foldl2(Pred, T3, !A, !B).
+
+tree234__foldl3(_Pred, empty, !A, !B, !C).
+tree234__foldl3(Pred, two(K, V, T0, T1), !A, !B, !C) :-
+ tree234__foldl3(Pred, T0, !A, !B, !C),
+ call(Pred, K, V, !A, !B, !C),
+ tree234__foldl3(Pred, T1, !A, !B, !C).
+tree234__foldl3(Pred, three(K0, V0, K1, V1, T0, T1, T2), !A, !B, !C) :-
+ tree234__foldl3(Pred, T0, !A, !B, !C),
+ call(Pred, K0, V0, !A, !B, !C),
+ tree234__foldl3(Pred, T1, !A, !B, !C),
+ call(Pred, K1, V1, !A, !B, !C),
+ tree234__foldl3(Pred, T2, !A, !B, !C).
+tree234__foldl3(Pred, four(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3),
+ !A, !B, !C) :-
+ tree234__foldl3(Pred, T0, !A, !B, !C),
+ call(Pred, K0, V0, !A, !B, !C),
+ tree234__foldl3(Pred, T1, !A, !B, !C),
+ call(Pred, K1, V1, !A, !B, !C),
+ tree234__foldl3(Pred, T2, !A, !B, !C),
+ call(Pred, K2, V2, !A, !B, !C),
+ tree234__foldl3(Pred, T3, !A, !B, !C).
%------------------------------------------------------------------------------%
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list