[m-rev.] diff: tabling via extra args (part 1 of 4)
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Jun 7 19:03:43 AEST 2004
Reduce the overhead of all forms of tabling by eliminating in many cases
the overhead of transferring data across the C/Mercury boundary. These
involve lots of control transfers as well as assignments to and from
Mercury abstract machine registers, which are not real machine registers
on x86 machines. Benchmarking in Uppsala revealed this overhead to be
a real problem.
The way we do that is by changing the tabling transformation so that instead
of generating sequences of calls to predicates from library/table_builtin.m,
we generate sequences of calls to C macros from runtime/mercury_tabling_pred.h,
and emit the resulting code string as the body of a foreign_proc goal.
(The old transformation is still available via a new option,
--no-tabling-via-extra-args.)
Since the number of inputs and outputs of the resulting C code sequences
are not always fixed (they can depend on the number of input or output
arguments of predicate being transformed), implementing this required
adding to foreign_procs a new field that allows the specification of extra
arguments to be passed to and from the given foreign code fragment. For now,
this mechanism is implemented only by the C backends, since it is needed
only by the C backends. (We don't support yet tabling on other backends.)
To simplify the new implementation of the field on foreign_procs, consolidate
three existing fields into one. Each of these fields was a list with one
element per argument, so turning them into a single list with a combined record
per argument should also improve reliability, since it reduces the likelyhood
of updates leaving the data structure inconsistent.
The goal paths of components of a tabled predicate depend on whether
-no-tabling-via-extra-args was specified. To enable the expected outputs
of the debugger test cases testing tabling, we add a new mdb command,
goal_paths, that controls whether goal paths are printed by the debugger
at events, and turn off the printing of events in the relevant test cases.
Also, prepare for a future change to optimize the trie structure for
user-defined types by handling type_infos (and once we support them,
typeclass_infos) specially.
compiler/table_gen.m:
Change the tabling transformation along the lines described above.
To allow us to factor out as much of the new code as possible,
we change the meaning of the call_table_tip variable for minimal
model subgoals: instead of the trie node at the end of the answer
table, it is not now the subgoal reachable from it. This change
has no effect as yet, because we use call_table_tip variables
only to perform resets across retries in the debugger, and we
don't do retries across calls to minimal model tabled predicates.
Put predicates into logical groups.
library/table_builtin.m:
runtime/mercury_tabling_preds.h:
When the new transformations in table_gen.m generate foreign_procs
with variable numbers of arguments, the interfaces of those
foreign_procs often do not match the interfaces of the existing
library predicates at their core: they frequently have one more
or one fewer argument. To prevent any possible confusion, in such
cases we add a new variant of the predicate. These predicates
have the suffix _shortcut in their name. Their implementations
are dummy macros that do nothing; they serve merely as placeholders
before or after which the macros that actually do the work are
inserted.
Move the definitions of the lookup, save and restore predicates
into mercury_tabling_preds.h. Make the naming scheme of their
arguments more regular.
runtime/mercury_minimal_model.c:
runtime/mercury_tabling_preds.h:
Move the definition of a predicate from mercury_minimal_model.c
to mercury_tabling_preds.h, since the compiler now needs to be
able to generate an inlined version of it.
compiler/hlds_goal.m:
Replace the three existing fields describing the arguments of
foreign_procs with one, and add a new field describing the extra
arguments that may be inserted by table_gen.m.
Add utility predicates for processing the arguments of foreign_procs.
Change the order of some existing groups of declarations make it
more logical.
compiler/hlds_pred.m:
runtime/mercury_stack_layout.h:
Extend the data structures recording the structure of tabling tries
to allow the representation of trie steps for type_infos and
typeclass_infos.
runtime/mercury_tabling_macros.c:
Fix a bug regarding the tabling of typeclass_infos, which is now
required for a clean compile.
compiler/pragma_c_gen.m:
compiler/ml_code_gen.m:
Modify the generation of code for foreign_procs to handle extra
arguments, and to conform to the new data structures for foreign_proc
arguments.
compiler/llds.m:
The tabling transformations can now generate significantly sized
foreign_procs bodies, which the LLDS code generator translates to
pragma_c instructions. Duplicating these by jump optimization
may lose more by worsening locality than it gains in avoiding jumps,
so we add an extra field to pragma_c instructions that tells jumpopt
not to duplicate code sequences containing such pragma_cs.
compiler/jumpopt.m:
Respect the new flag on pragma_cs.
compiler/goal_util.m:
Add a predicate to create foreign_procs with specified contents,
modelled on the existing predicate to create calls.
Change the order of the arguments of that existing predicate
to make it more logical.
compiler/polymorphism.m:
Conform to the new definition of foreign_procs. Try to simplify
the mechanism for generating the type_info and typeclass_info
arguments of foreign_proc goals, but it is not clear that this
code is even ever executed.
compiler/aditi_builtin_ops.m:
compiler/assertion.m:
compiler/bytecode_gen.m:
compiler/clause_to_proc.m:
compiler/code_gen.m:
compiler/code_info.m:
compiler/code_util.m:
compiler/constraint.m:
compiler/deep_profiling.m:
compiler/deforest.m:
compiler/delay_construct.m:
compiler/dependency_graph.m:
compiler/det_analysis.m:
compiler/det_report.m:
compiler/dnf.m:
compiler/dupelim.m:
compiler/equiv_type_hlds.m:
compiler/exprn_aux.m:
compiler/follow_code.m:
compiler/follow_vars.m:
compiler/frameopt.m:
compiler/goal_form.m:
compiler/goal_path.m:
compiler/higher_order.m:
compiler/higher_order.m:
compiler/hlds_module.m:
compiler/hlds_out.m:
compiler/inlining.m:
compiler/ite_gen.m:
compiler/layout_out.m:
compiler/livemap.m:
compiler/liveness.m:
compiler/llds_out.m:
compiler/loop_inv.m:
compiler/magic.m:
compiler/make_hlds.m:
compiler/mark_static_terms.m:
compiler/middle_rec.m:
compiler/modes.m:
compiler/modules.m:
compiler/opt_debug.m:
compiler/pd_cost.m:
compiler/prog_rep.m:
compiler/purity.m:
compiler/quantification.m:
compiler/reassign.m:
compiler/rl_exprn.m:
compiler/saved_vars.m:
compiler/simplify.m:
compiler/size_prof.m:
compiler/store_alloc.m:
compiler/stratify.m:
compiler/switch_detection.m:
compiler/term_pass1.m:
compiler/term_traversal.m:
compiler/termination.m:
compiler/trace.m:
compiler/typecheck.m:
compiler/unify_proc.m:
compiler/unique_modes.m:
compiler/unneeed_code.m:
compiler/unused_args.m:
compiler/use_local_vars.m:
Conform to the new definition of foreign_procs, pragma_cs and/or
table trie steps, or to changed argument orders.
compiler/add_heap_ops.m:
compiler/add_trail_ops.m:
compiler/cse_detection.m:
compiler/dead_proc_elim.m:
compiler/equiv_type.m:
compiler/intermod.m:
compiler/lambda.m:
compiler/lco.m:
compiler/module_util.m:
compiler/opt_util.m:
compiler/stack_opt.m:
compiler/trans_opt.m:
Conform to the new definition of foreign_procs.
Bring these modules up to date with our current code style guidelines,
using predmode declarations, state variable syntax and unification
expressions as appropriate.
compiler/mercury_compile.m:
Conform to the changed argument order of a predicate in trans_opt.m.
compiler/options.m:
Add the --no-tabling-via-extra-args option, but leave the
documentation commented out since the option is for developers only.
doc/user_guide.texi:
Document --no-tabling-via-extra-args option, though leave the
documentation commented out since the option is for developers only.
doc/user_guide.texi:
doc/mdb_categories:
Document the new goal_paths mdb command.
trace/mercury_trace_internals.c:
Implement the new goal_paths mdb command.
tests/debugger/completion.exp:
Conform to the presence of the goal_paths mdb command.
tests/debugger/mdb_command_test.inp:
Test the existence of documentation for the goal_paths mdb command.
tests/debugger/print_table.{inp,exp*}:
tests/debugger/retry.{inp,exp*}:
Use the goal_paths command to avoid having the expected output
depend on the presence or absence of --tabling-via-extra-args.
tests/tabling/table_foreign_output.{m,exp}:
Add a new test case to test the save/restore of arguments of foreign
types.
tests/tabling/Mmakefile:
Enable the new test case.
tests/tabling/test_tabling:
Make this script more robust.
Add an option for testing only the standard model forms of tabling.
Zoltan.
cvs server: Diffing .
cvs server: Diffing analysis
cvs server: Diffing bindist
cvs server: Diffing boehm_gc
cvs server: Diffing boehm_gc/Mac_files
cvs server: Diffing boehm_gc/cord
cvs server: Diffing boehm_gc/cord/private
cvs server: Diffing boehm_gc/doc
cvs server: Diffing boehm_gc/include
cvs server: Diffing boehm_gc/include/private
cvs server: Diffing boehm_gc/tests
cvs server: Diffing browser
cvs server: Diffing bytecode
cvs server: Diffing compiler
Index: compiler/add_heap_ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_heap_ops.m,v
retrieving revision 1.11
diff -u -b -r1.11 add_heap_ops.m
--- compiler/add_heap_ops.m 23 Mar 2004 10:52:00 -0000 1.11
+++ compiler/add_heap_ops.m 7 Jun 2004 08:49:55 -0000
@@ -67,8 +67,8 @@
% We do not update the module_info as we're traversing the goal.
%
-:- type heap_ops_info --->
- heap_ops_info(
+:- type heap_ops_info
+ ---> heap_ops_info(
varset :: prog_varset,
var_types :: vartypes,
module_info :: module_info
@@ -93,26 +93,24 @@
:- pred goal_add_heap_ops(hlds_goal::in, hlds_goal::out,
heap_ops_info::in, heap_ops_info::out) is det.
-goal_add_heap_ops(GoalExpr0 - GoalInfo, Goal) -->
- goal_expr_add_heap_ops(GoalExpr0, GoalInfo, Goal).
+goal_add_heap_ops(GoalExpr0 - GoalInfo, Goal, !Info) :-
+ goal_expr_add_heap_ops(GoalExpr0, GoalInfo, Goal, !Info).
:- pred goal_expr_add_heap_ops(hlds_goal_expr::in, hlds_goal_info::in,
- hlds_goal::out,
- heap_ops_info::in, heap_ops_info::out) is det.
-
-goal_expr_add_heap_ops(conj(Goals0), GI, conj(Goals) - GI) -->
- conj_add_heap_ops(Goals0, Goals).
+ hlds_goal::out, heap_ops_info::in, heap_ops_info::out) is det.
-goal_expr_add_heap_ops(par_conj(Goals0), GI, par_conj(Goals) - GI) -->
- conj_add_heap_ops(Goals0, Goals).
+goal_expr_add_heap_ops(conj(Goals0), GI, conj(Goals) - GI, !Info) :-
+ conj_add_heap_ops(Goals0, Goals, !Info).
-goal_expr_add_heap_ops(disj([]), GI, disj([]) - GI) --> [].
+goal_expr_add_heap_ops(par_conj(Goals0), GI, par_conj(Goals) - GI, !Info) :-
+ conj_add_heap_ops(Goals0, Goals, !Info).
-goal_expr_add_heap_ops(disj(Goals0), GoalInfo, Goal - GoalInfo) -->
- { Goals0 = [FirstDisjunct | _] },
+goal_expr_add_heap_ops(disj([]), GI, disj([]) - GI, !Info).
+goal_expr_add_heap_ops(disj(Goals0), GoalInfo, Goal - GoalInfo, !Info) :-
+ Goals0 = [FirstDisjunct | _],
- { goal_info_get_context(GoalInfo, Context) },
- { goal_info_get_code_model(GoalInfo, CodeModel) },
+ goal_info_get_context(GoalInfo, Context),
+ goal_info_get_code_model(GoalInfo, CodeModel),
%
% If necessary, save the heap pointer so that we can
@@ -123,93 +121,92 @@
% the first disjunct that might allocate heap.
%
(
- { CodeModel = model_non
+ ( CodeModel = model_non
; goal_may_allocate_heap(FirstDisjunct)
- }
+ )
->
- new_saved_hp_var(SavedHeapPointerVar),
- gen_mark_hp(SavedHeapPointerVar, Context, MarkHeapPointerGoal),
+ new_saved_hp_var(SavedHeapPointerVar, !Info),
+ gen_mark_hp(SavedHeapPointerVar, Context, MarkHeapPointerGoal,
+ !Info),
disj_add_heap_ops(Goals0, yes, yes(SavedHeapPointerVar),
- GoalInfo, Goals),
- { Goal = conj([MarkHeapPointerGoal, disj(Goals) - GoalInfo]) }
+ GoalInfo, Goals, !Info),
+ Goal = conj([MarkHeapPointerGoal, disj(Goals) - GoalInfo])
;
- disj_add_heap_ops(Goals0, yes, no, GoalInfo, Goals),
- { Goal = disj(Goals) }
+ disj_add_heap_ops(Goals0, yes, no, GoalInfo, Goals, !Info),
+ Goal = disj(Goals)
).
-goal_expr_add_heap_ops(switch(A, B, Cases0), GI, switch(A, B, Cases) - GI) -->
- cases_add_heap_ops(Cases0, Cases).
+goal_expr_add_heap_ops(switch(Var, CanFail, Cases0), GI,
+ switch(Var, CanFail, Cases) - GI, !Info) :-
+ cases_add_heap_ops(Cases0, Cases, !Info).
-goal_expr_add_heap_ops(not(InnerGoal), OuterGoalInfo, Goal) -->
+goal_expr_add_heap_ops(not(InnerGoal), OuterGoalInfo, Goal, !Info) :-
%
% We handle negations by converting them into if-then-elses:
% not(G) ===> (if G then fail else true)
%
- { goal_info_get_context(OuterGoalInfo, Context) },
- { InnerGoal = _ - InnerGoalInfo },
- { goal_info_get_determinism(InnerGoalInfo, Determinism) },
- { determinism_components(Determinism, _CanFail, NumSolns) },
- { true_goal(Context, True) },
- { fail_goal(Context, Fail) },
- ModuleInfo =^ module_info,
- { NumSolns = at_most_zero ->
+ goal_info_get_context(OuterGoalInfo, Context),
+ InnerGoal = _ - InnerGoalInfo,
+ goal_info_get_determinism(InnerGoalInfo, Determinism),
+ determinism_components(Determinism, _CanFail, NumSolns),
+ true_goal(Context, True),
+ fail_goal(Context, Fail),
+ ModuleInfo = !.Info ^ module_info,
+ ( NumSolns = at_most_zero ->
% The "then" part of the if-then-else will be unreachable,
% but to preserve the invariants that the MLDS back-end
% relies on, we need to make sure that it can't fail.
% So we use a call to `private_builtin__unused' (which
% will call error/1) rather than `fail' for the "then" part.
- generate_call("unused", [], det, no, [], ModuleInfo, Context,
+ generate_call("unused", det, [], no, [], ModuleInfo, Context,
ThenGoal)
;
ThenGoal = Fail
- },
- { NewOuterGoal = if_then_else([], InnerGoal, ThenGoal, True) },
- goal_expr_add_heap_ops(NewOuterGoal, OuterGoalInfo, Goal).
+ ),
+ NewOuterGoal = if_then_else([], InnerGoal, ThenGoal, True),
+ goal_expr_add_heap_ops(NewOuterGoal, OuterGoalInfo, Goal, !Info).
goal_expr_add_heap_ops(some(A, B, Goal0), GoalInfo,
- some(A, B, Goal) - GoalInfo) -->
- goal_add_heap_ops(Goal0, Goal).
+ some(A, B, Goal) - GoalInfo, !Info) :-
+ goal_add_heap_ops(Goal0, Goal, !Info).
goal_expr_add_heap_ops(if_then_else(A, Cond0, Then0, Else0), GoalInfo,
- Goal - GoalInfo) -->
- goal_add_heap_ops(Cond0, Cond),
- goal_add_heap_ops(Then0, Then),
- goal_add_heap_ops(Else0, Else1),
+ Goal - GoalInfo, !Info) :-
+ goal_add_heap_ops(Cond0, Cond, !Info),
+ goal_add_heap_ops(Then0, Then, !Info),
+ goal_add_heap_ops(Else0, Else1, !Info),
%
% If the condition can allocate heap space,
% save the heap pointer so that we can
% restore it if the condition fails.
%
- ( { goal_may_allocate_heap(Cond0) } ->
- new_saved_hp_var(SavedHeapPointerVar),
- { goal_info_get_context(GoalInfo, Context) },
- gen_mark_hp(SavedHeapPointerVar, Context, MarkHeapPointerGoal),
+ ( goal_may_allocate_heap(Cond0) ->
+ new_saved_hp_var(SavedHeapPointerVar, !Info),
+ goal_info_get_context(GoalInfo, Context),
+ gen_mark_hp(SavedHeapPointerVar, Context, MarkHeapPointerGoal,
+ !Info),
%
% Generate code to restore the heap pointer,
% and insert that code at the start of the Else branch.
%
gen_restore_hp(SavedHeapPointerVar, Context,
- RestoreHeapPointerGoal),
- { Else1 = _ - Else1GoalInfo },
- { Else = conj([RestoreHeapPointerGoal, Else1]) -
- Else1GoalInfo },
- { IfThenElse = if_then_else(A, Cond, Then, Else) - GoalInfo },
- { Goal = conj([MarkHeapPointerGoal, IfThenElse]) }
+ RestoreHeapPointerGoal, !Info),
+ Else1 = _ - Else1GoalInfo,
+ Else = conj([RestoreHeapPointerGoal, Else1]) -
+ Else1GoalInfo,
+ IfThenElse = if_then_else(A, Cond, Then, Else) - GoalInfo,
+ Goal = conj([MarkHeapPointerGoal, IfThenElse])
;
- { Goal = if_then_else(A, Cond, Then, Else1) }
+ Goal = if_then_else(A, Cond, Then, Else1)
).
-
-goal_expr_add_heap_ops(call(A,B,C,D,E,F), GI, call(A,B,C,D,E,F) - GI) --> [].
-
-goal_expr_add_heap_ops(generic_call(A,B,C,D), GI, generic_call(A,B,C,D) - GI)
- --> [].
-
-goal_expr_add_heap_ops(unify(A,B,C,D,E), GI, unify(A,B,C,D,E) - GI) --> [].
-
-goal_expr_add_heap_ops(PragmaForeign, GoalInfo, Goal) -->
- { PragmaForeign = foreign_proc(_,_,_,_,_,_,Impl) },
- ( { Impl = nondet(_,_,_,_,_,_,_,_,_) } ->
+goal_expr_add_heap_ops(Goal @ call(_, _, _, _, _, _), GI, Goal - GI, !Info).
+goal_expr_add_heap_ops(Goal @ generic_call(_, _, _, _), GI, Goal - GI, !Info).
+goal_expr_add_heap_ops(Goal @ unify(_, _, _, _, _), GI, Goal - GI, !Info).
+
+goal_expr_add_heap_ops(PragmaForeign, GoalInfo, Goal, !Info) :-
+ PragmaForeign = foreign_proc(_, _, _, _, _, Impl),
+ ( Impl = nondet(_,_,_,_,_,_,_,_,_) ->
% XXX Implementing heap reclamation for nondet pragma
% foreign_code via transformation is difficult,
% because there's nowhere in the HLDS pragma_foreign_code
@@ -218,49 +215,50 @@
% Instead, we just generate a call to a procedure which
% will at runtime call error/1 with an appropriate
% "Sorry, not implemented" error message.
- ModuleInfo =^ module_info,
- { goal_info_get_context(GoalInfo, Context) },
- { generate_call("reclaim_heap_nondet_pragma_foreign_code",
- [], erroneous, no, [], ModuleInfo, Context,
- SorryNotImplementedCode) },
- { Goal = SorryNotImplementedCode }
+ ModuleInfo = !.Info ^ module_info,
+ goal_info_get_context(GoalInfo, Context),
+ generate_call("reclaim_heap_nondet_pragma_foreign_code",
+ erroneous, [], no, [], ModuleInfo, Context,
+ SorryNotImplementedCode),
+ Goal = SorryNotImplementedCode
;
- { Goal = PragmaForeign - GoalInfo }
+ Goal = PragmaForeign - GoalInfo
).
-goal_expr_add_heap_ops(shorthand(_), _, _) -->
+goal_expr_add_heap_ops(shorthand(_), _, _, !Info) :-
% these should have been expanded out by now
- { error("goal_expr_add_heap_ops: unexpected shorthand") }.
+ error("goal_expr_add_heap_ops: unexpected shorthand").
:- pred conj_add_heap_ops(hlds_goals::in, hlds_goals::out,
heap_ops_info::in, heap_ops_info::out) is det.
-conj_add_heap_ops(Goals0, Goals) -->
- list__map_foldl(goal_add_heap_ops, Goals0, Goals).
+
+conj_add_heap_ops(Goals0, Goals, !Info) :-
+ list__map_foldl(goal_add_heap_ops, Goals0, Goals, !Info).
:- pred disj_add_heap_ops(hlds_goals::in, bool::in, maybe(prog_var)::in,
hlds_goal_info::in, hlds_goals::out,
heap_ops_info::in, heap_ops_info::out) is det.
-disj_add_heap_ops([], _, _, _, []) --> [].
+disj_add_heap_ops([], _, _, _, [], !Info).
disj_add_heap_ops([Goal0 | Goals0], IsFirstBranch, MaybeSavedHeapPointerVar,
- DisjGoalInfo, DisjGoals) -->
- goal_add_heap_ops(Goal0, Goal1),
- { Goal1 = _ - GoalInfo },
- { goal_info_get_context(GoalInfo, Context) },
+ DisjGoalInfo, DisjGoals, !Info) :-
+ goal_add_heap_ops(Goal0, Goal1, !Info),
+ Goal1 = _ - GoalInfo,
+ goal_info_get_context(GoalInfo, Context),
%
% If needed, reset the heap pointer before executing the goal,
% to reclaim heap space allocated in earlier branches.
%
(
- { IsFirstBranch = no },
- { MaybeSavedHeapPointerVar = yes(SavedHeapPointerVar0) }
+ IsFirstBranch = no,
+ MaybeSavedHeapPointerVar = yes(SavedHeapPointerVar0)
->
gen_restore_hp(SavedHeapPointerVar0, Context,
- RestoreHeapPointerGoal),
- { conj_list_to_goal([RestoreHeapPointerGoal, Goal1], GoalInfo,
- Goal) }
+ RestoreHeapPointerGoal, !Info),
+ conj_list_to_goal([RestoreHeapPointerGoal, Goal1], GoalInfo,
+ Goal)
;
- { Goal = Goal1 }
+ Goal = Goal1
),
%
@@ -268,59 +266,58 @@
% and if this disjunct might allocate heap space.
%
(
- { MaybeSavedHeapPointerVar = no },
- { goal_may_allocate_heap(Goal) }
+ MaybeSavedHeapPointerVar = no,
+ goal_may_allocate_heap(Goal)
->
% Generate code to save the heap pointer
- new_saved_hp_var(SavedHeapPointerVar),
- gen_mark_hp(SavedHeapPointerVar, Context, MarkHeapPointerGoal),
+ new_saved_hp_var(SavedHeapPointerVar, !Info),
+ gen_mark_hp(SavedHeapPointerVar, Context, MarkHeapPointerGoal,
+ !Info),
% Recursively handle the remaining disjuncts
disj_add_heap_ops(Goals0, no, yes(SavedHeapPointerVar),
- DisjGoalInfo, Goals1),
+ DisjGoalInfo, Goals1, !Info),
% Put this disjunct and the remaining disjuncts in a
% nested disjunction, so that the heap pointer variable
% can scope over these disjuncts
- { Disj = disj([Goal | Goals1]) - DisjGoalInfo },
- { DisjGoals = [conj([MarkHeapPointerGoal, Disj]) -
- DisjGoalInfo] }
+ Disj = disj([Goal | Goals1]) - DisjGoalInfo,
+ DisjGoals = [conj([MarkHeapPointerGoal, Disj]) -
+ DisjGoalInfo]
;
% Just recursively handle the remaining disjuncts
disj_add_heap_ops(Goals0, no, MaybeSavedHeapPointerVar,
- DisjGoalInfo, Goals),
- { DisjGoals = [Goal | Goals] }
+ DisjGoalInfo, Goals, !Info),
+ DisjGoals = [Goal | Goals]
).
:- pred cases_add_heap_ops(list(case)::in, list(case)::out,
heap_ops_info::in, heap_ops_info::out) is det.
-cases_add_heap_ops([], []) --> [].
-cases_add_heap_ops([Case0 | Cases0], [Case | Cases]) -->
- { Case0 = case(ConsId, Goal0) },
- { Case = case(ConsId, Goal) },
- goal_add_heap_ops(Goal0, Goal),
- cases_add_heap_ops(Cases0, Cases).
+
+cases_add_heap_ops([], [], !Info).
+cases_add_heap_ops([Case0 | Cases0], [Case | Cases], !Info) :-
+ Case0 = case(ConsId, Goal0),
+ Case = case(ConsId, Goal),
+ goal_add_heap_ops(Goal0, Goal, !Info),
+ cases_add_heap_ops(Cases0, Cases, !Info).
%-----------------------------------------------------------------------------%
:- pred gen_mark_hp(prog_var::in, prog_context::in, hlds_goal::out,
heap_ops_info::in, heap_ops_info::out) is det.
-gen_mark_hp(SavedHeapPointerVar, Context, MarkHeapPointerGoal) -->
- ModuleInfo =^ module_info,
- { generate_call("mark_hp", [SavedHeapPointerVar],
- det, yes(impure),
- [SavedHeapPointerVar - ground_inst],
- ModuleInfo, Context, MarkHeapPointerGoal) }.
+gen_mark_hp(SavedHeapPointerVar, Context, MarkHeapPointerGoal, !Info) :-
+ generate_call("mark_hp", det, [SavedHeapPointerVar],
+ yes(impure), [SavedHeapPointerVar - ground_inst],
+ !.Info ^ module_info, Context, MarkHeapPointerGoal).
:- pred gen_restore_hp(prog_var::in, prog_context::in, hlds_goal::out,
heap_ops_info::in, heap_ops_info::out) is det.
-gen_restore_hp(SavedHeapPointerVar, Context, RestoreHeapPointerGoal) -->
- ModuleInfo =^ module_info,
- { generate_call("restore_hp", [SavedHeapPointerVar],
- det, yes(impure), [],
- ModuleInfo, Context, RestoreHeapPointerGoal) }.
+gen_restore_hp(SavedHeapPointerVar, Context, RestoreHeapPointerGoal, !Info) :-
+ generate_call("restore_hp", det, [SavedHeapPointerVar], yes(impure),
+ [], !.Info ^ module_info, Context, RestoreHeapPointerGoal).
:- func ground_inst = (inst).
+
ground_inst = ground(unique, none).
%-----------------------------------------------------------------------------%
@@ -328,31 +325,30 @@
:- pred new_saved_hp_var(prog_var::out,
heap_ops_info::in, heap_ops_info::out) is det.
-new_saved_hp_var(Var) -->
- new_var("HeapPointer", heap_pointer_type, Var).
+new_saved_hp_var(Var, !Info) :-
+ new_var("HeapPointer", heap_pointer_type, Var, !Info).
:- pred new_var(string::in, (type)::in, prog_var::out,
heap_ops_info::in, heap_ops_info::out) is det.
-new_var(Name, Type, Var, TOI0, TOI) :-
- VarSet0 = TOI0 ^ varset,
- VarTypes0 = TOI0 ^ var_types,
+new_var(Name, Type, Var, !Info) :-
+ VarSet0 = !.Info ^ varset,
+ VarTypes0 = !.Info ^ var_types,
varset__new_named_var(VarSet0, Name, Var, VarSet),
map__det_insert(VarTypes0, Var, Type, VarTypes),
- TOI = ((TOI0 ^ varset := VarSet)
- ^ var_types := VarTypes).
+ !:Info = ((!.Info ^ varset := VarSet) ^ var_types := VarTypes).
%-----------------------------------------------------------------------------%
-:- pred generate_call(string::in, list(prog_var)::in, determinism::in,
+:- pred generate_call(string::in, determinism::in, list(prog_var)::in,
maybe(goal_feature)::in, assoc_list(prog_var, inst)::in,
module_info::in, term__context::in, hlds_goal::out) is det.
-generate_call(PredName, Args, Detism, MaybeFeature, InstMap, Module, Context,
- CallGoal) :-
+generate_call(PredName, Detism, Args, MaybeFeature, InstMap, ModuleInfo,
+ Context, CallGoal) :-
mercury_private_builtin_module(BuiltinModule),
goal_util__generate_simple_call(BuiltinModule, PredName, predicate,
- Args, only_mode, Detism, MaybeFeature, InstMap, Module,
+ only_mode, Detism, Args, MaybeFeature, InstMap, ModuleInfo,
Context, CallGoal).
%-----------------------------------------------------------------------------%
Index: compiler/add_trail_ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_trail_ops.m,v
retrieving revision 1.13
diff -u -b -r1.13 add_trail_ops.m
--- compiler/add_trail_ops.m 23 Mar 2004 10:52:00 -0000 1.13
+++ compiler/add_trail_ops.m 7 Jun 2004 08:49:55 -0000
@@ -93,52 +93,52 @@
:- pred goal_add_trail_ops(hlds_goal::in, hlds_goal::out,
trail_ops_info::in, trail_ops_info::out) is det.
-goal_add_trail_ops(GoalExpr0 - GoalInfo, Goal) -->
- goal_expr_add_trail_ops(GoalExpr0, GoalInfo, Goal).
+goal_add_trail_ops(GoalExpr0 - GoalInfo, Goal, !Info) :-
+ goal_expr_add_trail_ops(GoalExpr0, GoalInfo, Goal, !Info).
:- pred goal_expr_add_trail_ops(hlds_goal_expr::in, hlds_goal_info::in,
- hlds_goal::out,
- trail_ops_info::in, trail_ops_info::out) is det.
+ hlds_goal::out, trail_ops_info::in, trail_ops_info::out) is det.
-goal_expr_add_trail_ops(conj(Goals0), GI, conj(Goals) - GI) -->
- conj_add_trail_ops(Goals0, Goals).
+goal_expr_add_trail_ops(conj(Goals0), GI, conj(Goals) - GI, !Info) :-
+ conj_add_trail_ops(Goals0, Goals, !Info).
-goal_expr_add_trail_ops(par_conj(Goals0), GI, par_conj(Goals) - GI) -->
- conj_add_trail_ops(Goals0, Goals).
+goal_expr_add_trail_ops(par_conj(Goals0), GI, par_conj(Goals) - GI, !Info) :-
+ conj_add_trail_ops(Goals0, Goals, !Info).
-goal_expr_add_trail_ops(disj([]), GI, disj([]) - GI) --> [].
+goal_expr_add_trail_ops(disj([]), GI, disj([]) - GI, !Info).
-goal_expr_add_trail_ops(disj(Goals0), GoalInfo, Goal - GoalInfo) -->
- { Goals0 = [_|_] },
+goal_expr_add_trail_ops(disj(Goals0), GoalInfo, Goal - GoalInfo, !Info) :-
+ Goals0 = [_ | _],
- { goal_info_get_context(GoalInfo, Context) },
- { goal_info_get_code_model(GoalInfo, CodeModel) },
+ goal_info_get_context(GoalInfo, Context),
+ goal_info_get_code_model(GoalInfo, CodeModel),
%
% Allocate a new trail ticket so that we can
% restore things on back-tracking
%
- new_ticket_var(TicketVar),
- gen_store_ticket(TicketVar, Context, StoreTicketGoal),
- disj_add_trail_ops(Goals0, yes, CodeModel, TicketVar, Goals),
- { Goal = conj([StoreTicketGoal, disj(Goals) - GoalInfo]) }.
-
-goal_expr_add_trail_ops(switch(A, B, Cases0), GI, switch(A, B, Cases) - GI) -->
- cases_add_trail_ops(Cases0, Cases).
+ new_ticket_var(TicketVar, !Info),
+ gen_store_ticket(TicketVar, Context, StoreTicketGoal, !.Info),
+ disj_add_trail_ops(Goals0, yes, CodeModel, TicketVar, Goals, !Info),
+ Goal = conj([StoreTicketGoal, disj(Goals) - GoalInfo]).
+
+goal_expr_add_trail_ops(switch(A, B, Cases0), GI, switch(A, B, Cases) - GI,
+ !Info) :-
+ cases_add_trail_ops(Cases0, Cases, !Info).
-goal_expr_add_trail_ops(not(InnerGoal), OuterGoalInfo, Goal) -->
+goal_expr_add_trail_ops(not(InnerGoal), OuterGoalInfo, Goal, !Info) :-
%
% We handle negations by converting them into if-then-elses:
% not(G) ===> (if G then fail else true)
%
- { goal_info_get_context(OuterGoalInfo, Context) },
- { InnerGoal = _ - InnerGoalInfo },
- { goal_info_get_determinism(InnerGoalInfo, Determinism) },
- { determinism_components(Determinism, _CanFail, NumSolns) },
- { true_goal(Context, True) },
- { fail_goal(Context, Fail) },
- ModuleInfo =^ module_info,
- { NumSolns = at_most_zero ->
+ goal_info_get_context(OuterGoalInfo, Context),
+ InnerGoal = _ - InnerGoalInfo,
+ goal_info_get_determinism(InnerGoalInfo, Determinism),
+ determinism_components(Determinism, _CanFail, NumSolns),
+ true_goal(Context, True),
+ fail_goal(Context, Fail),
+ ModuleInfo = !.Info ^ module_info,
+ ( NumSolns = at_most_zero ->
% The "then" part of the if-then-else will be unreachable,
% but to preserve the invariants that the MLDS back-end
% relies on, we need to make sure that it can't fail.
@@ -146,22 +146,22 @@
% will call error/1) rather than `fail' for the "then" part.
mercury_private_builtin_module(PrivateBuiltin),
generate_simple_call(PrivateBuiltin, "unused", predicate,
- [], only_mode, det,
- no, [], ModuleInfo, Context, ThenGoal)
+ only_mode, det, [], no, [], ModuleInfo,
+ Context, ThenGoal)
;
ThenGoal = Fail
- },
- { NewOuterGoal = if_then_else([], InnerGoal, ThenGoal, True) },
- goal_expr_add_trail_ops(NewOuterGoal, OuterGoalInfo, Goal).
+ ),
+ NewOuterGoal = if_then_else([], InnerGoal, ThenGoal, True),
+ goal_expr_add_trail_ops(NewOuterGoal, OuterGoalInfo, Goal, !Info).
goal_expr_add_trail_ops(some(A, B, Goal0), OuterGoalInfo,
- Goal - OuterGoalInfo) -->
- { Goal0 = _ - InnerGoalInfo },
- { goal_info_get_code_model(InnerGoalInfo, InnerCodeModel) },
- { goal_info_get_code_model(OuterGoalInfo, OuterCodeModel) },
+ Goal - OuterGoalInfo, !Info) :-
+ Goal0 = _ - InnerGoalInfo,
+ goal_info_get_code_model(InnerGoalInfo, InnerCodeModel),
+ goal_info_get_code_model(OuterGoalInfo, OuterCodeModel),
(
- { InnerCodeModel = model_non },
- { OuterCodeModel \= model_non }
+ InnerCodeModel = model_non,
+ OuterCodeModel \= model_non
->
% handle commits
@@ -169,16 +169,16 @@
% before executing the goal, we save the ticket counter,
% and allocate a new trail ticket
%
- { goal_info_get_context(OuterGoalInfo, Context) },
- new_ticket_counter_var(SavedTicketCounterVar),
- new_ticket_var(TicketVar),
+ goal_info_get_context(OuterGoalInfo, Context),
+ new_ticket_counter_var(SavedTicketCounterVar, !Info),
+ new_ticket_var(TicketVar, !Info),
gen_mark_ticket_stack(SavedTicketCounterVar, Context,
- MarkTicketStackGoal),
- gen_store_ticket(TicketVar, Context, StoreTicketGoal),
+ MarkTicketStackGoal, !.Info),
+ gen_store_ticket(TicketVar, Context, StoreTicketGoal, !.Info),
%
% next we execute the goal that we're committing across
%
- goal_add_trail_ops(Goal0, Goal1),
+ goal_add_trail_ops(Goal0, Goal1, !Info),
%
% if the goal succeeds, then we have committed to that
% goal, so we need to commit the trail entries
@@ -186,87 +186,85 @@
% since we saved the ticket counter
%
gen_reset_ticket_commit(TicketVar, Context,
- ResetTicketCommitGoal),
+ ResetTicketCommitGoal, !.Info),
gen_prune_tickets_to(SavedTicketCounterVar, Context,
- PruneTicketsToGoal),
+ PruneTicketsToGoal, !.Info),
%
% if the goal fails, then we should undo the trail
% entries and discard this trail ticket before
% backtracking over it
%
gen_reset_ticket_undo(TicketVar, Context,
- ResetTicketUndoGoal),
- gen_discard_ticket(Context, DiscardTicketGoal),
- { fail_goal(Context, FailGoal) },
+ ResetTicketUndoGoal, !.Info),
+ gen_discard_ticket(Context, DiscardTicketGoal, !.Info),
+ fail_goal(Context, FailGoal),
% put it all together
- { Goal2 = some(A, B, Goal1) - OuterGoalInfo },
- { SuccCode = conj([Goal2, ResetTicketCommitGoal,
- PruneTicketsToGoal]) - OuterGoalInfo },
- ( { OuterCodeModel = model_semi } ->
- { FailGoal = _ - FailGoalInfo },
- { FailCode = conj([ResetTicketUndoGoal,
- DiscardTicketGoal, FailGoal]) - FailGoalInfo },
- { Goal3 = disj([SuccCode, FailCode]) - OuterGoalInfo }
+ Goal2 = some(A, B, Goal1) - OuterGoalInfo,
+ SuccCode = conj([Goal2, ResetTicketCommitGoal,
+ PruneTicketsToGoal]) - OuterGoalInfo,
+ ( OuterCodeModel = model_semi ->
+ FailGoal = _ - FailGoalInfo,
+ FailCode = conj([ResetTicketUndoGoal,
+ DiscardTicketGoal, FailGoal]) - FailGoalInfo,
+ Goal3 = disj([SuccCode, FailCode]) - OuterGoalInfo
;
- { Goal3 = SuccCode }
+ Goal3 = SuccCode
),
- { Goal = conj([MarkTicketStackGoal, StoreTicketGoal, Goal3]) }
+ Goal = conj([MarkTicketStackGoal, StoreTicketGoal, Goal3])
;
- goal_add_trail_ops(Goal0, Goal1),
- { Goal = some(A, B, Goal1) }
+ goal_add_trail_ops(Goal0, Goal1, !Info),
+ Goal = some(A, B, Goal1)
).
goal_expr_add_trail_ops(if_then_else(A, Cond0, Then0, Else0), GoalInfo,
- Goal - GoalInfo) -->
- goal_add_trail_ops(Cond0, Cond),
- goal_add_trail_ops(Then0, Then1),
- goal_add_trail_ops(Else0, Else1),
+ Goal - GoalInfo, !Info) :-
+ goal_add_trail_ops(Cond0, Cond, !Info),
+ goal_add_trail_ops(Then0, Then1, !Info),
+ goal_add_trail_ops(Else0, Else1, !Info),
%
% Allocate a new trail ticket so that we can
% restore things if the condition fails.
%
- new_ticket_var(TicketVar),
- { goal_info_get_context(GoalInfo, Context) },
- gen_store_ticket(TicketVar, Context, StoreTicketGoal),
+ new_ticket_var(TicketVar, !Info),
+ goal_info_get_context(GoalInfo, Context),
+ gen_store_ticket(TicketVar, Context, StoreTicketGoal, !.Info),
%
% Commit the trail ticket entries if the condition
% succeeds.
%
- { Then1 = _ - Then1GoalInfo },
- { Cond = _ - CondGoalInfo },
- { goal_info_get_code_model(CondGoalInfo, CondCodeModel) },
- ( { CondCodeModel = model_non } ->
+ Then1 = _ - Then1GoalInfo,
+ Cond = _ - CondGoalInfo,
+ goal_info_get_code_model(CondGoalInfo, CondCodeModel),
+ ( CondCodeModel = model_non ->
gen_reset_ticket_solve(TicketVar, Context,
- ResetTicketSolveGoal),
- { Then = conj([ResetTicketSolveGoal, Then1]) - Then1GoalInfo }
+ ResetTicketSolveGoal, !.Info),
+ Then = conj([ResetTicketSolveGoal, Then1]) - Then1GoalInfo
;
gen_reset_ticket_commit(TicketVar, Context,
- ResetTicketCommitGoal),
- gen_prune_ticket(Context, PruneTicketGoal),
- { Then = conj([ResetTicketCommitGoal, PruneTicketGoal, Then1])
- - Then1GoalInfo }
+ ResetTicketCommitGoal, !.Info),
+ gen_prune_ticket(Context, PruneTicketGoal, !.Info),
+ Then = conj([ResetTicketCommitGoal, PruneTicketGoal, Then1])
+ - Then1GoalInfo
),
- gen_reset_ticket_undo(TicketVar, Context, ResetTicketUndoGoal),
- gen_discard_ticket(Context, DiscardTicketGoal),
- { Else1 = _ - Else1GoalInfo },
- { Else = conj([ResetTicketUndoGoal, DiscardTicketGoal, Else1])
- - Else1GoalInfo },
- { IfThenElse = if_then_else(A, Cond, Then, Else) - GoalInfo },
- { Goal = conj([StoreTicketGoal, IfThenElse]) }.
-
-
-goal_expr_add_trail_ops(call(A,B,C,D,E,F), GI, call(A,B,C,D,E,F) - GI) --> [].
-
-goal_expr_add_trail_ops(generic_call(A,B,C,D), GI, generic_call(A,B,C,D) - GI)
- --> [].
-
-goal_expr_add_trail_ops(unify(A,B,C,D,E), GI, unify(A,B,C,D,E) - GI) --> [].
-
-goal_expr_add_trail_ops(PragmaForeign, GoalInfo, Goal) -->
- { PragmaForeign = foreign_proc(_,_,_,_,_,_,Impl) },
- ( { Impl = nondet(_,_,_,_,_,_,_,_,_) } ->
+ gen_reset_ticket_undo(TicketVar, Context, ResetTicketUndoGoal, !.Info),
+ gen_discard_ticket(Context, DiscardTicketGoal, !.Info),
+ Else1 = _ - Else1GoalInfo,
+ Else = conj([ResetTicketUndoGoal, DiscardTicketGoal, Else1])
+ - Else1GoalInfo,
+ IfThenElse = if_then_else(A, Cond, Then, Else) - GoalInfo,
+ Goal = conj([StoreTicketGoal, IfThenElse]).
+
+goal_expr_add_trail_ops(Goal @ call(_, _, _, _, _, _), GI, Goal - GI, !Info).
+
+goal_expr_add_trail_ops(Goal @ generic_call(_, _, _, _), GI, Goal - GI, !Info).
+
+goal_expr_add_trail_ops(Goal @ unify(_, _, _, _, _), GI, Goal - GI, !Info).
+
+goal_expr_add_trail_ops(PragmaForeign, GoalInfo, Goal, !Info) :-
+ PragmaForeign = foreign_proc(_, _, _, _, _, Impl),
+ ( Impl = nondet(_,_,_,_,_,_,_,_,_) ->
% XXX Implementing trailing for nondet pragma foreign_code
% via transformation is difficult, because there's nowhere
% in the HLDS pragma_foreign_code goal where we can insert
@@ -274,163 +272,157 @@
% Instead, we just generate a call to a procedure which
% will at runtime call error/1 with an appropriate
% "Sorry, not implemented" error message.
- ModuleInfo =^ module_info,
- { goal_info_get_context(GoalInfo, Context) },
- { generate_call("trailed_nondet_pragma_foreign_code",
- [], erroneous, no, [], ModuleInfo, Context,
- SorryNotImplementedCode) },
- { Goal = SorryNotImplementedCode }
+ ModuleInfo = !.Info^ module_info,
+ goal_info_get_context(GoalInfo, Context),
+ generate_call("trailed_nondet_pragma_foreign_code",
+ erroneous, [], no, [], ModuleInfo, Context,
+ SorryNotImplementedCode),
+ Goal = SorryNotImplementedCode
;
- { Goal = PragmaForeign - GoalInfo }
+ Goal = PragmaForeign - GoalInfo
).
-goal_expr_add_trail_ops(shorthand(_), _, _) -->
+goal_expr_add_trail_ops(shorthand(_), _, _, !Info) :-
% these should have been expanded out by now
- { error("goal_expr_add_trail_ops: unexpected shorthand") }.
+ error("goal_expr_add_trail_ops: unexpected shorthand").
:- pred conj_add_trail_ops(hlds_goals::in, hlds_goals::out,
trail_ops_info::in, trail_ops_info::out) is det.
-conj_add_trail_ops(Goals0, Goals) -->
- list__map_foldl(goal_add_trail_ops, Goals0, Goals).
+
+conj_add_trail_ops(Goals0, Goals, !Info) :-
+ list__map_foldl(goal_add_trail_ops, Goals0, Goals, !Info).
:- pred disj_add_trail_ops(hlds_goals::in, bool::in, code_model::in,
prog_var::in, hlds_goals::out,
trail_ops_info::in, trail_ops_info::out) is det.
-disj_add_trail_ops([], _, _, _, []) --> [].
+disj_add_trail_ops([], _, _, _, [], !Info).
disj_add_trail_ops([Goal0 | Goals0], IsFirstBranch, CodeModel, TicketVar,
- [Goal | Goals]) -->
- { Goal0 = _ - GoalInfo0 },
- { goal_info_get_context(GoalInfo0, Context) },
+ [Goal | Goals], !Info) :-
+ Goal0 = _ - GoalInfo0,
+ goal_info_get_context(GoalInfo0, Context),
%
% First undo the effects of any earlier branches
%
- ( { IsFirstBranch = yes } ->
- { UndoList = [] }
+ ( IsFirstBranch = yes ->
+ UndoList = []
;
- gen_reset_ticket_undo(TicketVar, Context, ResetTicketUndoGoal),
- ( { Goals0 = [] } ->
+ gen_reset_ticket_undo(TicketVar, Context, ResetTicketUndoGoal,
+ !.Info),
+ ( Goals0 = [] ->
%
% Once we've reached the last disjunct,
% we can discard the trail ticket
%
- gen_discard_ticket(Context, DiscardTicketGoal),
- { UndoList = [ResetTicketUndoGoal, DiscardTicketGoal] }
+ gen_discard_ticket(Context, DiscardTicketGoal, !.Info),
+ UndoList = [ResetTicketUndoGoal, DiscardTicketGoal]
;
- { UndoList = [ResetTicketUndoGoal] }
+ UndoList = [ResetTicketUndoGoal]
)
),
%
% Then execute the disjunct goal
%
- goal_add_trail_ops(Goal0, Goal1),
+ goal_add_trail_ops(Goal0, Goal1, !Info),
%
% For model_semi and model_det disjunctions,
% once we reach the end of the disjunct goal,
% we're committing to this disjunct, so we need
% to prune the trail ticket.
%
- ( { CodeModel = model_non } ->
- { PruneList = [] }
+ ( CodeModel = model_non ->
+ PruneList = []
;
gen_reset_ticket_commit(TicketVar, Context,
- ResetTicketCommitGoal),
- gen_prune_ticket(Context, PruneTicketGoal),
- { PruneList = [ResetTicketCommitGoal, PruneTicketGoal] }
+ ResetTicketCommitGoal, !.Info),
+ gen_prune_ticket(Context, PruneTicketGoal, !.Info),
+ PruneList = [ResetTicketCommitGoal, PruneTicketGoal]
),
%
% Package up the stuff we built earlier.
%
- { Goal1 = _ - GoalInfo1 },
- { conj_list_to_goal(UndoList ++ [Goal1] ++ PruneList, GoalInfo1,
- Goal) },
+ Goal1 = _ - GoalInfo1,
+ conj_list_to_goal(UndoList ++ [Goal1] ++ PruneList, GoalInfo1,
+ Goal),
% Recursively handle the remaining disjuncts
- disj_add_trail_ops(Goals0, no, CodeModel, TicketVar, Goals).
+ disj_add_trail_ops(Goals0, no, CodeModel, TicketVar, Goals, !Info).
:- pred cases_add_trail_ops(list(case)::in, list(case)::out,
trail_ops_info::in, trail_ops_info::out) is det.
-cases_add_trail_ops([], []) --> [].
-cases_add_trail_ops([Case0 | Cases0], [Case | Cases]) -->
- { Case0 = case(ConsId, Goal0) },
- { Case = case(ConsId, Goal) },
- goal_add_trail_ops(Goal0, Goal),
- cases_add_trail_ops(Cases0, Cases).
+
+cases_add_trail_ops([], [], !Info).
+cases_add_trail_ops([Case0 | Cases0], [Case | Cases], !Info) :-
+ Case0 = case(ConsId, Goal0),
+ Case = case(ConsId, Goal),
+ goal_add_trail_ops(Goal0, Goal, !Info),
+ cases_add_trail_ops(Cases0, Cases, !Info).
%-----------------------------------------------------------------------------%
:- pred gen_store_ticket(prog_var::in, prog_context::in, hlds_goal::out,
- trail_ops_info::in, trail_ops_info::out) is det.
+ trail_ops_info::in) is det.
-gen_store_ticket(TicketVar, Context, SaveTicketGoal) -->
- ModuleInfo =^ module_info,
- { generate_call("store_ticket", [TicketVar],
- det, yes(impure),
+gen_store_ticket(TicketVar, Context, SaveTicketGoal, Info) :-
+ generate_call("store_ticket", det, [TicketVar], yes(impure),
[TicketVar - ground_inst],
- ModuleInfo, Context, SaveTicketGoal) }.
+ Info ^ module_info, Context, SaveTicketGoal).
:- pred gen_reset_ticket_undo(prog_var::in, prog_context::in, hlds_goal::out,
- trail_ops_info::in, trail_ops_info::out) is det.
+ trail_ops_info::in) is det.
-gen_reset_ticket_undo(TicketVar, Context, ResetTicketGoal) -->
- ModuleInfo =^ module_info,
- { generate_call("reset_ticket_undo", [TicketVar],
- det, yes(impure), [],
- ModuleInfo, Context, ResetTicketGoal) }.
+gen_reset_ticket_undo(TicketVar, Context, ResetTicketGoal, Info) :-
+ generate_call("reset_ticket_undo", det, [TicketVar], yes(impure),
+ [], Info ^ module_info, Context, ResetTicketGoal).
:- pred gen_reset_ticket_solve(prog_var::in, prog_context::in, hlds_goal::out,
- trail_ops_info::in, trail_ops_info::out) is det.
+ trail_ops_info::in) is det.
-gen_reset_ticket_solve(TicketVar, Context, ResetTicketGoal) -->
- ModuleInfo =^ module_info,
- { generate_call("reset_ticket_solve", [TicketVar],
- det, yes(impure), [],
- ModuleInfo, Context, ResetTicketGoal) }.
+gen_reset_ticket_solve(TicketVar, Context, ResetTicketGoal, Info) :-
+ generate_call("reset_ticket_solve", det, [TicketVar], yes(impure),
+ [], Info ^ module_info, Context, ResetTicketGoal).
:- pred gen_reset_ticket_commit(prog_var::in, prog_context::in, hlds_goal::out,
- trail_ops_info::in, trail_ops_info::out) is det.
+ trail_ops_info::in) is det.
-gen_reset_ticket_commit(TicketVar, Context, ResetTicketGoal) -->
- ModuleInfo =^ module_info,
- { generate_call("reset_ticket_commit", [TicketVar],
- det, yes(impure), [],
- ModuleInfo, Context, ResetTicketGoal) }.
+gen_reset_ticket_commit(TicketVar, Context, ResetTicketGoal, Info) :-
+ generate_call("reset_ticket_commit", det, [TicketVar], yes(impure),
+ [], Info ^ module_info, Context, ResetTicketGoal).
:- pred gen_prune_ticket(prog_context::in, hlds_goal::out,
- trail_ops_info::in, trail_ops_info::out) is det.
+ trail_ops_info::in) is det.
-gen_prune_ticket(Context, PruneTicketGoal) -->
- ModuleInfo =^ module_info,
- { generate_call("prune_ticket", [], det, yes(impure), [],
- ModuleInfo, Context, PruneTicketGoal) }.
+gen_prune_ticket(Context, PruneTicketGoal, Info) :-
+ generate_call("prune_ticket", det, [], yes(impure),
+ [], Info ^ module_info, Context, PruneTicketGoal).
:- pred gen_discard_ticket(prog_context::in, hlds_goal::out,
- trail_ops_info::in, trail_ops_info::out) is det.
+ trail_ops_info::in) is det.
-gen_discard_ticket(Context, DiscardTicketGoal) -->
- ModuleInfo =^ module_info,
- { generate_call("discard_ticket", [], det, yes(impure), [],
- ModuleInfo, Context, DiscardTicketGoal) }.
+gen_discard_ticket(Context, DiscardTicketGoal, Info) :-
+ generate_call("discard_ticket", det, [], yes(impure), [],
+ Info ^ module_info, Context, DiscardTicketGoal).
:- pred gen_mark_ticket_stack(prog_var::in, prog_context::in, hlds_goal::out,
- trail_ops_info::in, trail_ops_info::out) is det.
+ trail_ops_info::in) is det.
-gen_mark_ticket_stack(SavedTicketCounterVar, Context, MarkTicketStackGoal) -->
- ModuleInfo =^ module_info,
- { generate_call("mark_ticket_stack", [SavedTicketCounterVar],
- det, yes(impure), [],
- ModuleInfo, Context, MarkTicketStackGoal) }.
+gen_mark_ticket_stack(SavedTicketCounterVar, Context, MarkTicketStackGoal,
+ Info) :-
+ generate_call("mark_ticket_stack", det, [SavedTicketCounterVar],
+ yes(impure), [], Info ^ module_info, Context,
+ MarkTicketStackGoal).
:- pred gen_prune_tickets_to(prog_var::in, prog_context::in, hlds_goal::out,
- trail_ops_info::in, trail_ops_info::out) is det.
+ trail_ops_info::in) is det.
-gen_prune_tickets_to(SavedTicketCounterVar, Context, PruneTicketsToGoal) -->
- ModuleInfo =^ module_info,
- { generate_call("prune_tickets_to", [SavedTicketCounterVar],
- det, yes(impure), [],
- ModuleInfo, Context, PruneTicketsToGoal) }.
+gen_prune_tickets_to(SavedTicketCounterVar, Context, PruneTicketsToGoal,
+ Info) :-
+ generate_call("prune_tickets_to", det, [SavedTicketCounterVar],
+ yes(impure), [], Info ^ module_info, Context,
+ PruneTicketsToGoal).
:- func ground_inst = (inst).
+
ground_inst = ground(unique, none).
%-----------------------------------------------------------------------------%
@@ -438,25 +430,24 @@
:- pred new_ticket_var(prog_var::out,
trail_ops_info::in, trail_ops_info::out) is det.
-new_ticket_var(Var) -->
- new_var("TrailTicket", ticket_type, Var).
+new_ticket_var(Var, !Info) :-
+ new_var("TrailTicket", ticket_type, Var, !Info).
:- pred new_ticket_counter_var(prog_var::out,
trail_ops_info::in, trail_ops_info::out) is det.
-new_ticket_counter_var(Var) -->
- new_var("SavedTicketCounter", ticket_counter_type, Var).
+new_ticket_counter_var(Var, !Info) :-
+ new_var("SavedTicketCounter", ticket_counter_type, Var, !Info).
:- pred new_var(string::in, (type)::in, prog_var::out,
trail_ops_info::in, trail_ops_info::out) is det.
-new_var(Name, Type, Var, TOI0, TOI) :-
- VarSet0 = TOI0 ^ varset,
- VarTypes0 = TOI0 ^ var_types,
+new_var(Name, Type, Var, !Info) :-
+ VarSet0 = !.Info ^ varset,
+ VarTypes0 = !.Info ^ var_types,
varset__new_named_var(VarSet0, Name, Var, VarSet),
map__det_insert(VarTypes0, Var, Type, VarTypes),
- TOI = ((TOI0 ^ varset := VarSet)
- ^ var_types := VarTypes).
+ !:Info = ((!.Info ^ varset := VarSet) ^ var_types := VarTypes).
%-----------------------------------------------------------------------------%
@@ -468,15 +459,15 @@
%-----------------------------------------------------------------------------%
-:- pred generate_call(string::in, list(prog_var)::in, determinism::in,
+:- pred generate_call(string::in, determinism::in, list(prog_var)::in,
maybe(goal_feature)::in, assoc_list(prog_var, inst)::in,
module_info::in, term__context::in, hlds_goal::out) is det.
-generate_call(PredName, Args, Detism, MaybeFeature, InstMap, Module, Context,
- CallGoal) :-
+generate_call(PredName, Detism, Args, MaybeFeature, InstMap, ModuleInfo,
+ Context, CallGoal) :-
mercury_private_builtin_module(BuiltinModule),
goal_util__generate_simple_call(BuiltinModule, PredName, predicate,
- Args, only_mode, Detism, MaybeFeature, InstMap, Module,
+ only_mode, Detism, Args, MaybeFeature, InstMap, ModuleInfo,
Context, CallGoal).
%-----------------------------------------------------------------------------%
Index: compiler/aditi_builtin_ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/aditi_builtin_ops.m,v
retrieving revision 1.7
diff -u -b -r1.7 aditi_builtin_ops.m
--- compiler/aditi_builtin_ops.m 31 Oct 2003 03:27:20 -0000 1.7
+++ compiler/aditi_builtin_ops.m 7 Jun 2004 08:49:55 -0000
@@ -150,7 +150,7 @@
some(A, B, Goal)) -->
transform_aditi_builtins_in_goal(Goal0, Goal).
transform_aditi_builtins_in_goal_expr(Goal, _, Goal) -->
- { Goal = foreign_proc(_, _, _, _, _, _, _) }.
+ { Goal = foreign_proc(_, _, _, _, _, _) }.
transform_aditi_builtins_in_goal_expr(Goal, _, Goal) -->
{ Goal = call(_, _, _, _, _, _) }.
transform_aditi_builtins_in_goal_expr(shorthand(_), _, _) -->
Index: compiler/assertion.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/assertion.m,v
retrieving revision 1.28
diff -u -b -r1.28 assertion.m
--- compiler/assertion.m 5 Apr 2004 05:06:45 -0000 1.28
+++ compiler/assertion.m 7 Jun 2004 08:49:55 -0000
@@ -551,8 +551,15 @@
equal_goals(IfA, IfB, !Subst),
equal_goals(ThenA, ThenB, !Subst),
equal_goals(ElseA, ElseB, !Subst).
-equal_goals(foreign_proc(Attribs, PredId, _, VarsA, _,_,_) - _,
- foreign_proc(Attribs, PredId, _, VarsB, _,_,_) - _, !Subst) :-
+equal_goals(foreign_proc(Attribs, PredId, _, ArgsA, ExtraA, _) - _,
+ foreign_proc(Attribs, PredId, _, ArgsB, ExtraB, _) - _,
+ !Subst) :-
+ % foreign_procs with extra args are compiler generated,
+ % and as such will not participate in assertions.
+ ExtraA = [],
+ ExtraB = [],
+ VarsA = list__map(foreign_arg_var, ArgsA),
+ VarsB = list__map(foreign_arg_var, ArgsB),
equal_vars(VarsA, VarsB, !Subst).
equal_goals(par_conj(GoalAs) - _, par_conj(GoalBs) - _, !Subst) :-
equal_goals_list(GoalAs, GoalBs, !Subst).
@@ -649,11 +656,11 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-assertion__normalise_goal(call(A,B,C,D,E,F) - GI, call(A,B,C,D,E,F) - GI).
-assertion__normalise_goal(generic_call(A,B,C,D) - GI, generic_call(A,B,C,D)-GI).
-assertion__normalise_goal(unify(A,B,C,D,E) - GI, unify(A,B,C,D,E) - GI).
-assertion__normalise_goal(foreign_proc(A,B,C,D,E,F,G) - GI,
- foreign_proc(A,B,C,D,E,F,G) - GI).
+assertion__normalise_goal(Goal @ call(_, _, _, _, _, _) - GI, Goal - GI).
+assertion__normalise_goal(Goal @ generic_call(_, _, _, _) - GI, Goal - GI).
+assertion__normalise_goal(Goal @ unify(_, _, _, _, _) - GI, Goal - GI).
+assertion__normalise_goal(Goal @ foreign_proc(_, _, _, _, _, _) - GI,
+ Goal - GI).
assertion__normalise_goal(conj(Goals0) - GI, conj(Goals) - GI) :-
assertion__normalise_conj(Goals0, Goals).
assertion__normalise_goal(switch(A,B,Case0s) - GI, switch(A,B,Cases)-GI) :-
@@ -739,7 +746,7 @@
goal_info_get_context(GoalInfo, Context),
assertion__in_interface_check_unify_rhs(RHS, Var, Context,
PredInfo, !Module, !IO).
-assertion__in_interface_check(foreign_proc(_, PredId, _, _, _, _, _) -
+assertion__in_interface_check(foreign_proc(_, PredId, _, _, _, _) -
GoalInfo, _PredInfo, !Module, !IO) :-
module_info_pred_info(!.Module, PredId, PragmaPredInfo),
pred_info_import_status(PragmaPredInfo, ImportStatus),
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.81
diff -u -b -r1.81 bytecode_gen.m
--- compiler/bytecode_gen.m 19 May 2004 03:59:04 -0000 1.81
+++ compiler/bytecode_gen.m 7 Jun 2004 08:49:55 -0000
@@ -288,7 +288,7 @@
tree(ElseCode,
EndofIfCode))))))
;
- GoalExpr = foreign_proc(_, _, _, _, _, _, _),
+ GoalExpr = foreign_proc(_, _, _, _, _, _),
Code = node([not_supported]),
ByteInfo = ByteInfo0
;
Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.40
diff -u -b -r1.40 clause_to_proc.m
--- compiler/clause_to_proc.m 5 Apr 2004 05:06:45 -0000 1.40
+++ compiler/clause_to_proc.m 7 Jun 2004 08:49:55 -0000
@@ -57,7 +57,7 @@
:- import_module libs__globals.
:- import_module parse_tree__prog_data.
-:- import_module assoc_list, bool, int, set, map, varset.
+:- import_module assoc_list, bool, int, set, map, varset, require.
maybe_add_default_func_modes([], Preds, Preds).
maybe_add_default_func_modes([PredId | PredIds], Preds0, Preds) :-
@@ -155,16 +155,15 @@
get_clause_goals(MatchingClauses, GoalList),
( GoalList = [SingleGoal] ->
SingleGoal = SingleExpr - _,
- ( SingleExpr = foreign_proc(_, _, _, Args, ArgNames, _, _) ->
+ ( SingleExpr = foreign_proc(_, _, _, Args, ExtraArgs, _) ->
%
% Use the original variable names for the headvars
% of foreign_proc clauses, not the introduced
% `HeadVar__n' names.
%
- ArgsAndNames = assoc_list__from_corresponding_lists(
- Args, ArgNames),
- VarSet = list__foldl(set_arg_names, ArgsAndNames,
- VarSet0)
+ VarSet = list__foldl(set_arg_names, Args, VarSet0),
+ require(unify(ExtraArgs, []),
+ "copy_clauses_to_proc: extra_args")
;
VarSet = VarSet0
),
@@ -218,15 +217,14 @@
proc_info_set_body(Proc0, VarSet, VarTypes, HeadVars, Goal,
TI_VarMap, TCI_VarMap, Proc).
-:- func set_arg_names(pair(prog_var, maybe(pair(string, mode))), prog_varset)
- = prog_varset.
+:- func set_arg_names(foreign_arg, prog_varset) = prog_varset.
-set_arg_names(Arg - MaybeArgName, Vars0) = Vars :-
+set_arg_names(foreign_arg(Arg, MaybeNameMode, _), Vars0) = Vars :-
(
- MaybeArgName = yes(ArgName - _),
- varset__name_var(Vars0, Arg, ArgName, Vars)
+ MaybeNameMode = yes(Name - _),
+ varset__name_var(Vars0, Arg, Name, Vars)
;
- MaybeArgName = no,
+ MaybeNameMode = no,
Vars = Vars0
).
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.126
diff -u -b -r1.126 code_gen.m
--- compiler/code_gen.m 23 May 2004 23:14:21 -0000 1.126
+++ compiler/code_gen.m 7 Jun 2004 08:49:55 -0000
@@ -832,8 +832,7 @@
code_info__resume_point_stack_addr(OutsideResumePoint,
OutsideResumeAddress),
(
- Goal = foreign_proc(_, _, _, _, _, _,
- PragmaCode) - _,
+ Goal = foreign_proc(_, _, _, _, _, PragmaCode) - _,
PragmaCode = nondet(Fields, FieldsContext,
_,_,_,_,_,_,_)
->
@@ -853,7 +852,7 @@
- "Allocate stack frame",
pragma_c([], DefineComponents,
will_not_call_mercury, no, no, no, no,
- no)
+ no, no)
- ""
]),
NondetPragma = yes
@@ -939,7 +938,7 @@
live_lvals_info(set__init))],
UndefCode = node([
pragma_c([], UndefComponents,
- will_not_call_mercury, no, no, no, no, no)
+ will_not_call_mercury, no, no, no, no, no, no)
- ""
]),
RestoreDeallocCode = empty, % always empty for nondet code
@@ -1292,12 +1291,12 @@
Code, !CI)
).
code_gen__generate_goal_2(foreign_proc(Attributes, PredId, ProcId,
- Args, ArgNames, OrigArgTypes, PragmaCode),
+ Args, ExtraArgs, PragmaCode),
GoalInfo, CodeModel, Code, !CI) :-
( c = foreign_language(Attributes) ->
pragma_c_gen__generate_pragma_c_code(CodeModel, Attributes,
- PredId, ProcId, Args, ArgNames, OrigArgTypes,
- GoalInfo, PragmaCode, Code, !CI)
+ PredId, ProcId, Args, ExtraArgs, GoalInfo, PragmaCode,
+ Code, !CI)
;
error("code_gen__generate_goal_2: " ++
"foreign code other than C unexpected")
@@ -1435,7 +1434,7 @@
BytecodeInstructions = [
label(Entry) - "Procedure entry point",
pragma_c([], BytecodeInstructionsComponents,
- may_call_mercury, no, no, no, no, no)
+ may_call_mercury, no, no, no, no, no, no)
- "Entry stub"
].
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.289
diff -u -b -r1.289 code_info.m
--- compiler/code_info.m 23 May 2004 23:14:22 -0000 1.289
+++ compiler/code_info.m 7 Jun 2004 08:49:55 -0000
@@ -1824,7 +1824,7 @@
],
MarkCode = node([
pragma_c([], Components, will_not_call_mercury,
- no, no, no, no, no) - ""
+ no, no, no, no, no, yes) - ""
])
;
UseMinimalModel = no,
@@ -1903,7 +1903,7 @@
],
CutCode = node([
pragma_c([], Components, will_not_call_mercury,
- no, no, no, no, no)
+ no, no, no, no, no, yes)
- "commit for temp frame hijack"
])
;
Index: compiler/code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_util.m,v
retrieving revision 1.151
diff -u -b -r1.151 code_util.m
--- compiler/code_util.m 23 May 2004 23:14:24 -0000 1.151
+++ compiler/code_util.m 7 Jun 2004 08:49:55 -0000
@@ -244,8 +244,7 @@
% temporary nondet frames without knowing all the #defined macros
% that expand to mktempframe and variants thereof. The performance
% impact of being too conservative is probably not too bad.
-code_util__goal_may_alloc_temp_frame_2(foreign_proc(_,_,_,_,_,_,_),
- yes).
+code_util__goal_may_alloc_temp_frame_2(foreign_proc(_, _, _, _, _, _), yes).
code_util__goal_may_alloc_temp_frame_2(some(_Vars, _, Goal), May) :-
Goal = _ - GoalInfo,
goal_info_get_code_model(GoalInfo, CodeModel),
Index: compiler/constraint.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/constraint.m,v
retrieving revision 1.54
diff -u -b -r1.54 constraint.m
--- compiler/constraint.m 5 Apr 2004 05:06:46 -0000 1.54
+++ compiler/constraint.m 7 Jun 2004 08:49:55 -0000
@@ -179,7 +179,7 @@
propagate_conj_sub_goal_2(Goal, Constraints0,
[Goal | Constraints], !Info) :-
- Goal = foreign_proc(_, _, _, _, _, _, _) - _,
+ Goal = foreign_proc(_, _, _, _, _, _) - _,
flatten_constraints(Constraints0, Constraints).
propagate_conj_sub_goal_2(Goal, _, _, !Info) :-
@@ -812,7 +812,7 @@
strip_constraint_markers_expr(par_conj(Goals)) =
par_conj(list__map(strip_constraint_markers, Goals)).
strip_constraint_markers_expr(Goal) = Goal :-
- Goal = foreign_proc(_, _, _, _, _, _, _).
+ Goal = foreign_proc(_, _, _, _, _, _).
strip_constraint_markers_expr(Goal) = Goal :-
Goal = generic_call(_, _, _, _).
strip_constraint_markers_expr(Goal) = Goal :-
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/cse_detection.m,v
retrieving revision 1.77
diff -u -b -r1.77 cse_detection.m
--- compiler/cse_detection.m 31 Oct 2003 03:27:21 -0000 1.77
+++ compiler/cse_detection.m 7 Jun 2004 08:49:55 -0000
@@ -23,12 +23,10 @@
:- import_module io.
-:- pred detect_cse(module_info::in, module_info::out,
- io__state::di, io__state::uo) is det.
+:- pred detect_cse(module_info::in, module_info::out, io::di, io::uo) is det.
:- pred detect_cse_in_proc(proc_id::in, pred_id::in,
- module_info::in, module_info::out, io__state::di, io__state::uo)
- is det.
+ module_info::in, module_info::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -53,7 +51,7 @@
:- import_module parse_tree__prog_data.
:- import_module term, varset.
-:- import_module int, bool, list, assoc_list, map, multi_map.
+:- import_module int, string, bool, list, assoc_list, map, multi_map.
:- import_module set, std_util, require.
%-----------------------------------------------------------------------------%
@@ -61,77 +59,73 @@
% Traverse the module structure, calling `detect_cse_in_goal'
% for each procedure body.
-detect_cse(ModuleInfo0, ModuleInfo) -->
- { module_info_predids(ModuleInfo0, PredIds) },
- detect_cse_in_preds(PredIds, ModuleInfo0, ModuleInfo).
+detect_cse(!ModuleInfo, !IO) :-
+ module_info_predids(!.ModuleInfo, PredIds),
+ detect_cse_in_preds(PredIds, !ModuleInfo, !IO).
:- pred detect_cse_in_preds(list(pred_id)::in,
- module_info::in, module_info::out, io__state::di, io__state::uo)
- is det.
+ module_info::in, module_info::out, io::di, io::uo) is det.
-detect_cse_in_preds([], ModuleInfo, ModuleInfo) --> [].
-detect_cse_in_preds([PredId | PredIds], ModuleInfo0, ModuleInfo) -->
- { module_info_preds(ModuleInfo0, PredTable) },
- { map__lookup(PredTable, PredId, PredInfo) },
- detect_cse_in_pred(PredId, PredInfo, ModuleInfo0, ModuleInfo1),
- detect_cse_in_preds(PredIds, ModuleInfo1, ModuleInfo).
+detect_cse_in_preds([], !ModuleInfo, !IO).
+detect_cse_in_preds([PredId | PredIds], !ModuleInfo, !IO) :-
+ module_info_preds(!.ModuleInfo, PredTable),
+ map__lookup(PredTable, PredId, PredInfo),
+ detect_cse_in_pred(PredId, PredInfo, !ModuleInfo, !IO),
+ detect_cse_in_preds(PredIds, !ModuleInfo, !IO).
:- pred detect_cse_in_pred(pred_id::in, pred_info::in,
- module_info::in, module_info::out, io__state::di, io__state::uo)
- is det.
+ module_info::in, module_info::out, io::di, io::uo) is det.
detect_cse_in_pred(PredId, PredInfo0, !ModuleInfo, !IO) :-
ProcIds = pred_info_non_imported_procids(PredInfo0),
detect_cse_in_procs(ProcIds, PredId, !ModuleInfo, !IO).
:- pred detect_cse_in_procs(list(proc_id)::in, pred_id::in,
- module_info::in, module_info::out, io__state::di, io__state::uo)
- is det.
+ module_info::in, module_info::out, io::di, io::uo) is det.
-detect_cse_in_procs([], _PredId, ModuleInfo, ModuleInfo) --> [].
-detect_cse_in_procs([ProcId | ProcIds], PredId, ModuleInfo0, ModuleInfo) -->
- detect_cse_in_proc(ProcId, PredId, ModuleInfo0, ModuleInfo1),
- detect_cse_in_procs(ProcIds, PredId, ModuleInfo1, ModuleInfo).
-
-detect_cse_in_proc(ProcId, PredId, ModuleInfo0, ModuleInfo) -->
- { detect_cse_in_proc_2(ProcId, PredId, Redo, ModuleInfo0,
- ModuleInfo1) },
- ( { Redo = no } ->
- { ModuleInfo = ModuleInfo1 }
- ;
- globals__io_lookup_bool_option(very_verbose, VeryVerbose),
- ( { VeryVerbose = yes } ->
- io__write_string("% Repeating mode check for "),
- hlds_out__write_pred_id(ModuleInfo1, PredId),
- io__write_string("\n")
+detect_cse_in_procs([], _PredId, !ModuleInfo, !IO).
+detect_cse_in_procs([ProcId | ProcIds], PredId, !ModuleInfo, !IO) :-
+ detect_cse_in_proc(ProcId, PredId, !ModuleInfo, !IO),
+ detect_cse_in_procs(ProcIds, PredId, !ModuleInfo, !IO).
+
+detect_cse_in_proc(ProcId, PredId, !ModuleInfo, !IO) :-
+ detect_cse_in_proc_2(ProcId, PredId, Redo, !ModuleInfo),
+ ( Redo = no ->
+ true
;
- []
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ ( VeryVerbose = yes ->
+ io__write_string("% Repeating mode check for ", !IO),
+ hlds_out__write_pred_id(!.ModuleInfo, PredId, !IO),
+ io__write_string("\n", !IO)
+ ;
+ true
),
- modecheck_proc(ProcId, PredId, ModuleInfo1,
- ModuleInfo2, Errs, _Changed),
- { Errs > 0 ->
+ modecheck_proc(ProcId, PredId, !ModuleInfo, Errs, _Changed,
+ !IO),
+ ( Errs > 0 ->
error("mode check fails when repeated")
;
true
- },
- ( { VeryVerbose = yes } ->
- io__write_string("% Repeating switch detection for "),
- hlds_out__write_pred_id(ModuleInfo2, PredId),
- io__write_string("\n")
+ ),
+ ( VeryVerbose = yes ->
+ io__write_string("% Repeating switch detection for ",
+ !IO),
+ hlds_out__write_pred_id(!.ModuleInfo, PredId, !IO),
+ io__write_string("\n", !IO)
;
- []
+ true
),
- { detect_switches_in_proc(ProcId, PredId,
- ModuleInfo2, ModuleInfo3) },
-
- ( { VeryVerbose = yes } ->
- io__write_string("% Repeating common deconstruction detection for "),
- hlds_out__write_pred_id(ModuleInfo3, PredId),
- io__write_string("\n")
+ detect_switches_in_proc(ProcId, PredId, !ModuleInfo),
+ ( VeryVerbose = yes ->
+ io__write_string("% Repeating common " ++
+ "deconstruction detection for ", !IO),
+ hlds_out__write_pred_id(!.ModuleInfo, PredId, !IO),
+ io__write_string("\n", !IO)
;
- []
+ true
),
- detect_cse_in_proc(ProcId, PredId, ModuleInfo3, ModuleInfo)
+ detect_cse_in_proc(ProcId, PredId, !ModuleInfo, !IO)
).
:- type cse_info
@@ -204,9 +198,8 @@
:- pred detect_cse_in_goal(hlds_goal::in, instmap::in, cse_info::in,
cse_info::out, bool::out, hlds_goal::out) is det.
-detect_cse_in_goal(Goal0, InstMap0, CseInfo0, CseInfo, Redo, Goal) :-
- detect_cse_in_goal_1(Goal0, InstMap0, CseInfo0, CseInfo,
- Redo, Goal, _InstMap).
+detect_cse_in_goal(Goal0, InstMap0, !CseInfo, Redo, Goal) :-
+ detect_cse_in_goal_1(Goal0, InstMap0, !CseInfo, Redo, Goal, _InstMap).
% This version is the same as the above except that it returns
% the resulting instmap on exit from the goal, which is
@@ -216,9 +209,9 @@
:- pred detect_cse_in_goal_1(hlds_goal::in, instmap::in, cse_info::in,
cse_info::out, bool::out, hlds_goal::out, instmap::out) is det.
-detect_cse_in_goal_1(Goal0 - GoalInfo, InstMap0, CseInfo0, CseInfo, Redo,
+detect_cse_in_goal_1(Goal0 - GoalInfo, InstMap0, !CseInfo, Redo,
Goal - GoalInfo, InstMap) :-
- detect_cse_in_goal_2(Goal0, GoalInfo, InstMap0, CseInfo0, CseInfo,
+ detect_cse_in_goal_2(Goal0, GoalInfo, InstMap0, !CseInfo,
Redo, Goal),
goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap).
@@ -229,77 +222,61 @@
instmap::in, cse_info::in, cse_info::out, bool::out,
hlds_goal_expr::out) is det.
-detect_cse_in_goal_2(foreign_proc(A,B,C,D,E,F,G), _, _, CseInfo,
- CseInfo, no, foreign_proc(A,B,C,D,E,F,G)).
-
-detect_cse_in_goal_2(generic_call(A,B,C,D), _, _, CseInfo, CseInfo,
- no, generic_call(A,B,C,D)).
-
-detect_cse_in_goal_2(call(A,B,C,D,E,F), _, _, CseInfo, CseInfo, no,
- call(A,B,C,D,E,F)).
-
-detect_cse_in_goal_2(unify(A,B0,C,D,E), _, InstMap0, CseInfo0, CseInfo, Redo,
- unify(A,B,C,D,E)) :-
+detect_cse_in_goal_2(Goal @ foreign_proc(_, _, _, _, _, _), _, _, !CseInfo,
+ no, Goal).
+detect_cse_in_goal_2(Goal @ generic_call(_, _, _, _), _, _, !CseInfo,
+ no, Goal).
+detect_cse_in_goal_2(Goal @ call(_, _, _, _, _, _), _, _, !CseInfo, no, Goal).
+detect_cse_in_goal_2(unify(LHS, RHS0, Mode, Unify, UnifyContext), _, InstMap0,
+ !CseInfo, Redo, unify(LHS, RHS, Mode,Unify, UnifyContext)) :-
(
- B0 = lambda_goal(Purity, PredOrFunc, EvalMethod, FixModes,
+ RHS0 = lambda_goal(Purity, PredOrFunc, EvalMethod, FixModes,
NonLocalVars, Vars, Modes, Det, Goal0)
->
- ModuleInfo = CseInfo0 ^ module_info,
+ ModuleInfo = !.CseInfo ^ module_info,
instmap__pre_lambda_update(ModuleInfo,
Vars, Modes, InstMap0, InstMap),
- detect_cse_in_goal(Goal0, InstMap, CseInfo0, CseInfo, Redo,
- Goal),
- B = lambda_goal(Purity, PredOrFunc, EvalMethod, FixModes,
+ detect_cse_in_goal(Goal0, InstMap, !CseInfo, Redo, Goal),
+ RHS = lambda_goal(Purity, PredOrFunc, EvalMethod, FixModes,
NonLocalVars, Vars, Modes, Det, Goal)
;
- B = B0,
- CseInfo = CseInfo0,
+ RHS = RHS0,
Redo = no
).
-
-detect_cse_in_goal_2(not(Goal0), _GoalInfo, InstMap, CseInfo0, CseInfo,
- Redo, not(Goal)) :-
- detect_cse_in_goal(Goal0, InstMap, CseInfo0, CseInfo, Redo, Goal).
-
+detect_cse_in_goal_2(not(Goal0), _GoalInfo, InstMap, !CseInfo, Redo,
+ not(Goal)) :-
+ detect_cse_in_goal(Goal0, InstMap, !CseInfo, Redo, Goal).
detect_cse_in_goal_2(some(Vars, CanRemove, Goal0), _GoalInfo, InstMap,
- CseInfo0, CseInfo, Redo, some(Vars, CanRemove, Goal)) :-
- detect_cse_in_goal(Goal0, InstMap, CseInfo0, CseInfo, Redo, Goal).
-
-detect_cse_in_goal_2(conj(Goals0), _GoalInfo, InstMap, CseInfo0, CseInfo,
- Redo, conj(Goals)) :-
- detect_cse_in_conj(Goals0, InstMap, CseInfo0, CseInfo, Redo, Goals).
-
-detect_cse_in_goal_2(par_conj(Goals0), _, InstMap, CseInfo0, CseInfo, Redo,
+ !CseInfo, Redo, some(Vars, CanRemove, Goal)) :-
+ detect_cse_in_goal(Goal0, InstMap, !CseInfo, Redo, Goal).
+detect_cse_in_goal_2(conj(Goals0), _GoalInfo, InstMap, !CseInfo, Redo,
+ conj(Goals)) :-
+ detect_cse_in_conj(Goals0, InstMap, !CseInfo, Redo, Goals).
+detect_cse_in_goal_2(par_conj(Goals0), _, InstMap, !CseInfo, Redo,
par_conj(Goals)) :-
- detect_cse_in_par_conj(Goals0, InstMap, CseInfo0, CseInfo,
- Redo, Goals).
-
-detect_cse_in_goal_2(disj(Goals0), GoalInfo, InstMap, CseInfo0, CseInfo,
- Redo, Goal) :-
+ detect_cse_in_par_conj(Goals0, InstMap, !CseInfo, Redo, Goals).
+detect_cse_in_goal_2(disj(Goals0), GoalInfo, InstMap, !CseInfo, Redo, Goal) :-
( Goals0 = [] ->
- CseInfo = CseInfo0,
Redo = no,
Goal = disj([])
;
goal_info_get_nonlocals(GoalInfo, NonLocals),
set__to_sorted_list(NonLocals, NonLocalsList),
detect_cse_in_disj(NonLocalsList, Goals0, GoalInfo,
- InstMap, CseInfo0, CseInfo, Redo, Goal)
+ InstMap, !CseInfo, Redo, Goal)
).
-
detect_cse_in_goal_2(switch(Var, CanFail, Cases0), GoalInfo, InstMap,
- CseInfo0, CseInfo, Redo, Goal) :-
+ !CseInfo, Redo, Goal) :-
goal_info_get_nonlocals(GoalInfo, NonLocals),
set__to_sorted_list(NonLocals, NonLocalsList),
detect_cse_in_cases(NonLocalsList, Var, CanFail, Cases0, GoalInfo,
- InstMap, CseInfo0, CseInfo, Redo, Goal).
-
+ InstMap, !CseInfo, Redo, Goal).
detect_cse_in_goal_2(if_then_else(Vars, Cond0, Then0, Else0), GoalInfo,
- InstMap, CseInfo0, CseInfo, Redo, Goal) :-
+ InstMap, !CseInfo, Redo, Goal) :-
goal_info_get_nonlocals(GoalInfo, NonLocals),
set__to_sorted_list(NonLocals, NonLocalsList),
detect_cse_in_ite(NonLocalsList, Vars, Cond0, Then0, Else0, GoalInfo,
- InstMap, CseInfo0, CseInfo, Redo, Goal).
+ InstMap, !CseInfo, Redo, Goal).
detect_cse_in_goal_2(shorthand(_), _, _, _, _, _, _) :-
% these should have been expanded out by now
@@ -310,12 +287,12 @@
:- pred detect_cse_in_conj(list(hlds_goal)::in, instmap::in, cse_info::in,
cse_info::out, bool::out, list(hlds_goal)::out) is det.
-detect_cse_in_conj([], _InstMap, CseInfo, CseInfo, no, []).
-detect_cse_in_conj([Goal0 | Goals0], InstMap0, CseInfo0, CseInfo,
+detect_cse_in_conj([], _InstMap, !CseInfo, no, []).
+detect_cse_in_conj([Goal0 | Goals0], InstMap0, !CseInfo,
Redo, Goals) :-
- detect_cse_in_goal_1(Goal0, InstMap0, CseInfo0, CseInfo1, Redo1, Goal1,
+ detect_cse_in_goal_1(Goal0, InstMap0, !CseInfo, Redo1, Goal1,
InstMap1),
- detect_cse_in_conj(Goals0, InstMap1, CseInfo1, CseInfo, Redo2, Goals1),
+ detect_cse_in_conj(Goals0, InstMap1, !CseInfo, Redo2, Goals1),
( Goal1 = conj(ConjGoals) - _ ->
list__append(ConjGoals, Goals1, Goals)
;
@@ -328,12 +305,11 @@
:- pred detect_cse_in_par_conj(list(hlds_goal)::in, instmap::in, cse_info::in,
cse_info::out, bool::out, list(hlds_goal)::out) is det.
-detect_cse_in_par_conj([], _InstMap, CseInfo, CseInfo, no, []).
-detect_cse_in_par_conj([Goal0 | Goals0], InstMap0, CseInfo0, CseInfo,
- Redo, [Goal | Goals]) :-
- detect_cse_in_goal(Goal0, InstMap0, CseInfo0, CseInfo1, Redo1, Goal),
- detect_cse_in_par_conj(Goals0, InstMap0, CseInfo1, CseInfo,
- Redo2, Goals),
+detect_cse_in_par_conj([], _InstMap, !CseInfo, no, []).
+detect_cse_in_par_conj([Goal0 | Goals0], InstMap0, !CseInfo, Redo,
+ [Goal | Goals]) :-
+ detect_cse_in_goal(Goal0, InstMap0, !CseInfo, Redo1, Goal),
+ detect_cse_in_par_conj(Goals0, InstMap0, !CseInfo, Redo2, Goals),
bool__or(Redo1, Redo2, Redo).
%-----------------------------------------------------------------------------%
@@ -347,39 +323,37 @@
hlds_goal_info::in, instmap::in, cse_info::in,
cse_info::out, bool::out, hlds_goal_expr::out) is det.
-detect_cse_in_disj([], Goals0, _, InstMap, CseInfo0, CseInfo,
- Redo, disj(Goals)) :-
- detect_cse_in_disj_2(Goals0, InstMap, CseInfo0, CseInfo, Redo, Goals).
+detect_cse_in_disj([], Goals0, _, InstMap, !CseInfo, Redo, disj(Goals)) :-
+ detect_cse_in_disj_2(Goals0, InstMap, !CseInfo, Redo, Goals).
detect_cse_in_disj([Var | Vars], Goals0, GoalInfo0, InstMap,
- CseInfo0, CseInfo, Redo, Goal) :-
+ !CseInfo, Redo, Goal) :-
(
instmap__lookup_var(InstMap, Var, VarInst0),
- ModuleInfo = CseInfo0 ^ module_info,
+ ModuleInfo = !.CseInfo ^ module_info,
% XXX we only need inst_is_bound, but leave this as it is
% until mode analysis can handle aliasing between free
% variables.
inst_is_ground_or_any(ModuleInfo, VarInst0),
- common_deconstruct(Goals0, Var, CseInfo0, CseInfo1,
- Unify, FirstOldNew, LaterOldNew, Goals)
+ common_deconstruct(Goals0, Var, !CseInfo, Unify,
+ FirstOldNew, LaterOldNew, Goals)
->
maybe_update_existential_data_structures(Unify,
- FirstOldNew, LaterOldNew, CseInfo1, CseInfo),
+ FirstOldNew, LaterOldNew, !CseInfo),
Goal = conj([Unify, disj(Goals) - GoalInfo0]),
Redo = yes
;
detect_cse_in_disj(Vars, Goals0, GoalInfo0, InstMap,
- CseInfo0, CseInfo, Redo, Goal)
+ !CseInfo, Redo, Goal)
).
:- pred detect_cse_in_disj_2(list(hlds_goal)::in, instmap::in, cse_info::in,
cse_info::out, bool::out, list(hlds_goal)::out) is det.
-detect_cse_in_disj_2([], _InstMap, CseInfo, CseInfo, no, []).
-detect_cse_in_disj_2([Goal0 | Goals0], InstMap0, CseInfo0, CseInfo, Redo,
+detect_cse_in_disj_2([], _InstMap, !CseInfo, no, []).
+detect_cse_in_disj_2([Goal0 | Goals0], InstMap0, !CseInfo, Redo,
[Goal | Goals]) :-
- detect_cse_in_goal(Goal0, InstMap0, CseInfo0, CseInfo1, Redo1, Goal),
- detect_cse_in_disj_2(Goals0, InstMap0, CseInfo1, CseInfo,
- Redo2, Goals),
+ detect_cse_in_goal(Goal0, InstMap0, !CseInfo, Redo1, Goal),
+ detect_cse_in_disj_2(Goals0, InstMap0, !CseInfo, Redo2, Goals),
bool__or(Redo1, Redo2, Redo).
:- pred detect_cse_in_cases(list(prog_var)::in, prog_var::in, can_fail::in,
@@ -387,43 +361,41 @@
cse_info::in, cse_info::out, bool::out, hlds_goal_expr::out) is det.
detect_cse_in_cases([], SwitchVar, CanFail, Cases0, _GoalInfo, InstMap,
- CseInfo0, CseInfo, Redo,
- switch(SwitchVar, CanFail, Cases)) :-
- detect_cse_in_cases_2(Cases0, InstMap, CseInfo0, CseInfo, Redo, Cases).
+ !CseInfo, Redo, switch(SwitchVar, CanFail, Cases)) :-
+ detect_cse_in_cases_2(Cases0, InstMap, !CseInfo, Redo, Cases).
detect_cse_in_cases([Var | Vars], SwitchVar, CanFail, Cases0, GoalInfo,
- InstMap, CseInfo0, CseInfo, Redo, Goal) :-
+ InstMap, !CseInfo, Redo, Goal) :-
(
Var \= SwitchVar,
instmap__lookup_var(InstMap, Var, VarInst0),
- ModuleInfo = CseInfo0 ^ module_info,
+ ModuleInfo = !.CseInfo ^ module_info,
% XXX we only need inst_is_bound, but leave this as it is
% until mode analysis can handle aliasing between free
% variables.
inst_is_ground_or_any(ModuleInfo, VarInst0),
- common_deconstruct_cases(Cases0, Var, CseInfo0, CseInfo1,
+ common_deconstruct_cases(Cases0, Var, !CseInfo,
Unify, FirstOldNew, LaterOldNew, Cases)
->
maybe_update_existential_data_structures(Unify,
- FirstOldNew, LaterOldNew, CseInfo1, CseInfo),
+ FirstOldNew, LaterOldNew, !CseInfo),
Goal = conj([Unify, switch(SwitchVar, CanFail, Cases)
- GoalInfo]),
Redo = yes
;
detect_cse_in_cases(Vars, SwitchVar, CanFail, Cases0, GoalInfo,
- InstMap, CseInfo0, CseInfo, Redo, Goal)
+ InstMap, !CseInfo, Redo, Goal)
).
:- pred detect_cse_in_cases_2(list(case)::in, instmap::in, cse_info::in,
cse_info::out, bool::out, list(case)::out) is det.
-detect_cse_in_cases_2([], _, CseInfo, CseInfo, no, []).
-detect_cse_in_cases_2([Case0 | Cases0], InstMap, CseInfo0, CseInfo, Redo,
+detect_cse_in_cases_2([], _, !CseInfo, no, []).
+detect_cse_in_cases_2([Case0 | Cases0], InstMap, !CseInfo, Redo,
[Case | Cases]) :-
Case0 = case(Functor, Goal0),
- detect_cse_in_goal(Goal0, InstMap, CseInfo0, CseInfo1, Redo1, Goal),
+ detect_cse_in_goal(Goal0, InstMap, !CseInfo, Redo1, Goal),
Case = case(Functor, Goal),
- detect_cse_in_cases_2(Cases0, InstMap, CseInfo1, CseInfo,
- Redo2, Cases),
+ detect_cse_in_cases_2(Cases0, InstMap, !CseInfo, Redo2, Cases),
bool__or(Redo1, Redo2, Redo).
:- pred detect_cse_in_ite(list(prog_var)::in, list(prog_var)::in,
@@ -431,56 +403,55 @@
instmap::in, cse_info::in, cse_info::out, bool::out,
hlds_goal_expr::out) is det.
-detect_cse_in_ite([], IfVars, Cond0, Then0, Else0, _, InstMap, CseInfo0,
- CseInfo, Redo, if_then_else(IfVars, Cond, Then, Else)) :-
- detect_cse_in_ite_2(Cond0, Then0, Else0,
- InstMap, CseInfo0, CseInfo, Redo, Cond, Then, Else).
+detect_cse_in_ite([], IfVars, Cond0, Then0, Else0, _, InstMap, !CseInfo,
+ Redo, if_then_else(IfVars, Cond, Then, Else)) :-
+ detect_cse_in_ite_2(Cond0, Then0, Else0, InstMap, !CseInfo, Redo,
+ Cond, Then, Else).
detect_cse_in_ite([Var | Vars], IfVars, Cond0, Then0, Else0, GoalInfo,
- InstMap, CseInfo0, CseInfo, Redo, Goal) :-
+ InstMap, !CseInfo, Redo, Goal) :-
(
- ModuleInfo = CseInfo0 ^ module_info,
+ ModuleInfo = !.CseInfo ^ module_info,
instmap__lookup_var(InstMap, Var, VarInst0),
% XXX we only need inst_is_bound, but leave this as it is
% until mode analysis can handle aliasing between free
% variables.
inst_is_ground_or_any(ModuleInfo, VarInst0),
- common_deconstruct([Then0, Else0], Var, CseInfo0, CseInfo1,
+ common_deconstruct([Then0, Else0], Var, !CseInfo,
Unify, FirstOldNew, LaterOldNew, Goals),
Goals = [Then, Else]
->
maybe_update_existential_data_structures(Unify,
- FirstOldNew, LaterOldNew, CseInfo1, CseInfo),
+ FirstOldNew, LaterOldNew, !CseInfo),
Goal = conj([Unify, if_then_else(IfVars, Cond0, Then, Else)
- GoalInfo]),
Redo = yes
;
detect_cse_in_ite(Vars, IfVars, Cond0, Then0, Else0, GoalInfo,
- InstMap, CseInfo0, CseInfo, Redo, Goal)
+ InstMap, !CseInfo, Redo, Goal)
).
:- pred detect_cse_in_ite_2(hlds_goal::in, hlds_goal::in, hlds_goal::in,
instmap::in, cse_info::in, cse_info::out, bool::out,
hlds_goal::out, hlds_goal::out, hlds_goal::out) is det.
-detect_cse_in_ite_2(Cond0, Then0, Else0, InstMap0, CseInfo0, CseInfo, Redo,
+detect_cse_in_ite_2(Cond0, Then0, Else0, InstMap0, !CseInfo, Redo,
Cond, Then, Else) :-
- detect_cse_in_goal_1(Cond0, InstMap0, CseInfo0, CseInfo1, Redo1, Cond,
- InstMap1),
- detect_cse_in_goal(Then0, InstMap1, CseInfo1, CseInfo2, Redo2, Then),
- detect_cse_in_goal(Else0, InstMap0, CseInfo2, CseInfo, Redo3, Else),
+ detect_cse_in_goal_1(Cond0, InstMap0, !CseInfo, Redo1, Cond, InstMap1),
+ detect_cse_in_goal(Then0, InstMap1, !CseInfo, Redo2, Then),
+ detect_cse_in_goal(Else0, InstMap0, !CseInfo, Redo3, Else),
bool__or(Redo1, Redo2, Redo12),
bool__or(Redo12, Redo3, Redo).
%-----------------------------------------------------------------------------%
-% common_deconstruct(Goals0, Var, CseInfo0, CseInfo, Unify, Goals):
+% common_deconstruct(Goals0, Var, !CseInfo, Unify, Goals):
% input vars:
% Goals0 is a list of parallel goals in a branched structure
% (disjunction, if-then-else, or switch).
% Var is the variable we are looking for a common deconstruction on.
-% CseInfo0 contains the original varset and type map.
+% !.CseInfo contains the original varset and type map.
% output vars:
-% CseInfo has a varset and a type map reflecting the new variables
+% !:CseInfo has a varset and a type map reflecting the new variables
% we have introduced.
% Goals is the modified version of Goals0 after the common deconstruction
% has been hoisted out, with the new variables as the functor arguments.
@@ -490,25 +461,24 @@
cse_info::out, hlds_goal::out, assoc_list(prog_var)::out,
list(assoc_list(prog_var))::out, list(hlds_goal)::out) is semidet.
-common_deconstruct(Goals0, Var, CseInfo0, CseInfo, Unify,
- FirstOldNew, LaterOldNew, Goals) :-
+common_deconstruct(Goals0, Var, !CseInfo, Unify, FirstOldNew, LaterOldNew,
+ Goals) :-
common_deconstruct_2(Goals0, Var, before_candidate,
have_candidate(Unify, FirstOldNew, LaterOldNew),
- CseInfo0, CseInfo, Goals),
+ !CseInfo, Goals),
LaterOldNew = [_ | _].
:- pred common_deconstruct_2(list(hlds_goal)::in, prog_var::in,
cse_state::in, cse_state::out, cse_info::in, cse_info::out,
list(hlds_goal)::out) is semidet.
-common_deconstruct_2([], _Var, CseState, CseState, CseInfo, CseInfo, []).
-common_deconstruct_2([Goal0 | Goals0], Var, CseState0, CseState,
- CseInfo0, CseInfo, [Goal | Goals]) :-
+common_deconstruct_2([], _Var, !CseState, !CseInfo, []).
+common_deconstruct_2([Goal0 | Goals0], Var, !CseState, !CseInfo,
+ [Goal | Goals]) :-
find_bind_var(Var, find_bind_var_for_cse_in_deconstruct, Goal0, Goal,
- CseState0, CseState1, CseInfo0, CseInfo1, yes),
- CseState1 = have_candidate(_, _, _),
- common_deconstruct_2(Goals0, Var, CseState1, CseState,
- CseInfo1, CseInfo, Goals).
+ !CseState, !CseInfo, yes),
+ !.CseState = have_candidate(_, _, _),
+ common_deconstruct_2(Goals0, Var, !CseState, !CseInfo, Goals).
%-----------------------------------------------------------------------------%
@@ -516,26 +486,25 @@
cse_info::in, cse_info::out, hlds_goal::out, assoc_list(prog_var)::out,
list(assoc_list(prog_var))::out, list(case)::out) is semidet.
-common_deconstruct_cases(Cases0, Var, CseInfo0, CseInfo,
- Unify, FirstOldNew, LaterOldNew, Cases) :-
+common_deconstruct_cases(Cases0, Var, !CseInfo, Unify,
+ FirstOldNew, LaterOldNew, Cases) :-
common_deconstruct_cases_2(Cases0, Var, before_candidate,
have_candidate(Unify, FirstOldNew, LaterOldNew),
- CseInfo0, CseInfo, Cases),
+ !CseInfo, Cases),
LaterOldNew = [_ | _].
:- pred common_deconstruct_cases_2(list(case)::in, prog_var::in,
cse_state::in, cse_state::out, cse_info::in, cse_info::out,
list(case)::out) is semidet.
-common_deconstruct_cases_2([], _Var, CseState, CseState, CseInfo, CseInfo, []).
+common_deconstruct_cases_2([], _Var, !CseState, !CseInfo, []).
common_deconstruct_cases_2([case(ConsId, Goal0) | Cases0], Var,
- CseState0, CseState, CseInfo0, CseInfo,
- [case(ConsId, Goal) | Cases]) :-
+ !CseState, !CseInfo, [case(ConsId, Goal) | Cases]) :-
find_bind_var(Var, find_bind_var_for_cse_in_deconstruct, Goal0, Goal,
- CseState0, CseState1, CseInfo0, CseInfo1, yes),
- CseState1 = have_candidate(_, _, _),
- common_deconstruct_cases_2(Cases0, Var, CseState1, CseState,
- CseInfo1, CseInfo, Cases).
+ !CseState, !CseInfo, yes),
+ !.CseState = have_candidate(_, _, _),
+ common_deconstruct_cases_2(Cases0, Var, !CseState,
+ !CseInfo, Cases).
%-----------------------------------------------------------------------------%
@@ -571,16 +540,15 @@
cse_info::in, cse_info::out) is det.
find_bind_var_for_cse_in_deconstruct(Var, Goal0, Goals,
- CseState0, CseState, CseInfo0, CseInfo) :-
+ !CseState, !CseInfo) :-
(
- CseState0 = before_candidate,
- construct_common_unify(Var, Goal0, CseInfo0, CseInfo,
+ !.CseState = before_candidate,
+ construct_common_unify(Var, Goal0, !CseInfo,
OldNewVars, HoistedGoal, Goals),
- CseState = have_candidate(HoistedGoal, OldNewVars, [])
+ !:CseState = have_candidate(HoistedGoal, OldNewVars, [])
;
- CseState0 = have_candidate(HoistedGoal,
+ !.CseState = have_candidate(HoistedGoal,
FirstOldNewVars, LaterOldNewVars0),
- CseInfo = CseInfo0,
Goal0 = _ - GoalInfo,
goal_info_get_context(GoalInfo, Context),
(
@@ -589,25 +557,24 @@
->
Goals = Goals0,
LaterOldNewVars = [OldNewVars | LaterOldNewVars0],
- CseState = have_candidate(HoistedGoal,
+ !:CseState = have_candidate(HoistedGoal,
FirstOldNewVars, LaterOldNewVars)
;
Goals = [Goal0],
- CseState = multiple_candidates
+ !:CseState = multiple_candidates
)
;
- CseState0 = multiple_candidates,
+ !.CseState = multiple_candidates,
Goals = [Goal0],
- CseState = multiple_candidates,
- CseInfo = CseInfo0
+ !:CseState = multiple_candidates
).
:- pred construct_common_unify(prog_var::in, hlds_goal::in,
cse_info::in, cse_info::out, assoc_list(prog_var)::out,
hlds_goal::out, list(hlds_goal)::out) is det.
-construct_common_unify(Var, GoalExpr0 - GoalInfo, CseInfo0, CseInfo,
- OldNewVars, HoistedGoal, Replacements) :-
+construct_common_unify(Var, GoalExpr0 - GoalInfo, !CseInfo, OldNewVars,
+ HoistedGoal, Replacements) :-
(
GoalExpr0 = unify(_, Term, Umode, Unif0, Ucontext),
Unif0 = deconstruct(_, Consid, Args, Submodes, CanFail, CanCGC)
@@ -621,7 +588,7 @@
),
goal_info_get_context(GoalInfo, Context),
create_parallel_subterms(Args, Context, Ucontext,
- CseInfo0, CseInfo, OldNewVars, Replacements),
+ !CseInfo, OldNewVars, Replacements),
map__from_assoc_list(OldNewVars, Sub),
goal_util__rename_vars_in_goal(GoalExpr1 - GoalInfo, Sub,
HoistedGoal)
@@ -633,13 +600,13 @@
unify_context::in, cse_info::in, cse_info::out,
assoc_list(prog_var)::out, list(hlds_goal)::out) is det.
-create_parallel_subterms([], _, _, CseInfo, CseInfo, [], []).
-create_parallel_subterms([OFV | OFV0], Context, UnifyContext,
- CseInfo0, CseInfo, OldNewVars, Replacements) :-
- create_parallel_subterms(OFV0, Context, UnifyContext,
- CseInfo0, CseInfo1, OldNewVars1, Replacements1),
- create_parallel_subterm(OFV, Context, UnifyContext,
- CseInfo1, CseInfo, OldNewVars1, OldNewVars, Goal),
+create_parallel_subterms([], _, _, !CseInfo, [], []).
+create_parallel_subterms([OFV | OFV0], Context, UnifyContext, !CseInfo,
+ OldNewVars, Replacements) :-
+ create_parallel_subterms(OFV0, Context, UnifyContext, !CseInfo,
+ OldNewVars1, Replacements1),
+ create_parallel_subterm(OFV, Context, UnifyContext, !CseInfo,
+ OldNewVars1, OldNewVars, Goal),
Replacements = [Goal | Replacements1].
:- pred create_parallel_subterm(prog_var::in, prog_context::in,
@@ -647,18 +614,18 @@
assoc_list(prog_var)::in, assoc_list(prog_var)::out,
hlds_goal::out) is det.
-create_parallel_subterm(OFV, Context, UnifyContext,
- CseInfo0, CseInfo, OldNewVar0, OldNewVar, Goal) :-
- VarSet0 = CseInfo0 ^ varset,
- VarTypes0 = CseInfo0 ^ vartypes,
+create_parallel_subterm(OFV, Context, UnifyContext, !CseInfo, !OldNewVar,
+ Goal) :-
+ VarSet0 = !.CseInfo ^ varset,
+ VarTypes0 = !.CseInfo ^ vartypes,
varset__new_var(VarSet0, NFV, VarSet),
map__lookup(VarTypes0, OFV, Type),
map__det_insert(VarTypes0, NFV, Type, VarTypes),
- OldNewVar = [OFV - NFV | OldNewVar0],
+ !:OldNewVar = [OFV - NFV | !.OldNewVar],
UnifyContext = unify_context(MainCtxt, SubCtxt),
create_atomic_unification(OFV, var(NFV),
Context, MainCtxt, SubCtxt, Goal),
- CseInfo = (CseInfo0 ^ varset := VarSet) ^ vartypes := VarTypes.
+ !:CseInfo = (!.CseInfo ^ varset := VarSet) ^ vartypes := VarTypes.
%-----------------------------------------------------------------------------%
@@ -771,35 +738,34 @@
cse_info::in, cse_info::out) is det.
maybe_update_existential_data_structures(Unify, FirstOldNew, LaterOldNew,
- CseInfo0, CseInfo) :-
+ !CseInfo) :-
(
Unify = unify(_, _, _, UnifyInfo, _) - _,
UnifyInfo = deconstruct(Var, ConsId, _, _, _, _),
- ModuleInfo = CseInfo0 ^ module_info,
- VarTypes = CseInfo0 ^ vartypes,
+ ModuleInfo = !.CseInfo ^ module_info,
+ VarTypes = !.CseInfo ^ vartypes,
map__lookup(VarTypes, Var, Type),
type_util__is_existq_cons(ModuleInfo, Type, ConsId)
->
update_existential_data_structures(FirstOldNew, LaterOldNew,
- CseInfo0, CseInfo)
+ !CseInfo)
;
- CseInfo = CseInfo0
+ true
).
:- pred update_existential_data_structures(
assoc_list(prog_var)::in, list(assoc_list(prog_var))::in,
cse_info::in, cse_info::out) is det.
-update_existential_data_structures(FirstOldNew, LaterOldNews,
- CseInfo0, CseInfo) :-
+update_existential_data_structures(FirstOldNew, LaterOldNews, !CseInfo) :-
list__condense(LaterOldNews, LaterOldNew),
list__append(FirstOldNew, LaterOldNew, OldNew),
map__from_assoc_list(OldNew, OldNewMap),
map__from_assoc_list(FirstOldNew, FirstOldNewMap),
- TypeInfoVarMap0 = CseInfo0 ^ type_info_varmap,
- TypeClassInfoVarMap0 = CseInfo0 ^ typeclass_info_varmap,
- VarTypes0 = CseInfo0 ^ vartypes,
+ TypeInfoVarMap0 = !.CseInfo ^ type_info_varmap,
+ TypeClassInfoVarMap0 = !.CseInfo ^ typeclass_info_varmap,
+ VarTypes0 = !.CseInfo ^ vartypes,
map__to_assoc_list(TypeInfoVarMap0, TypeInfoVarList0),
list__foldl(find_type_info_locn_tvar_map(FirstOldNewMap),
@@ -817,9 +783,9 @@
map__map_values(apply_tvar_rename(TvarSub), VarTypes0, VarTypes),
- CseInfo1 = CseInfo0 ^ type_info_varmap := TypeInfoVarMap,
- CseInfo2 = CseInfo1 ^ typeclass_info_varmap := TypeClassInfoVarMap,
- CseInfo = CseInfo2 ^ vartypes := VarTypes.
+ !:CseInfo = !.CseInfo ^ type_info_varmap := TypeInfoVarMap,
+ !:CseInfo = !.CseInfo ^ typeclass_info_varmap := TypeClassInfoVarMap,
+ !:CseInfo = !.CseInfo ^ vartypes := VarTypes.
:- pred apply_tvar_rename(map(tvar, tvar)::in, prog_var::in,
(type)::in, (type)::out) is det.
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.90
diff -u -b -r1.90 dead_proc_elim.m
--- compiler/dead_proc_elim.m 14 May 2004 08:40:20 -0000 1.90
+++ compiler/dead_proc_elim.m 7 Jun 2004 08:49:55 -0000
@@ -450,7 +450,7 @@
NewNotation = yes(1),
map__set(!.Needed, proc(PredId, ProcId), NewNotation, !:Needed)
).
-dead_proc_elim__examine_expr(foreign_proc(_, PredId, ProcId, _, _, _, _),
+dead_proc_elim__examine_expr(foreign_proc(_, PredId, ProcId, _, _, _),
_CurrProc, !Queue, !Needed) :-
queue__put(!.Queue, proc(PredId, ProcId), !:Queue),
map__set(!.Needed, proc(PredId, ProcId), no, !:Needed).
@@ -835,8 +835,7 @@
),
DeadInfo = dead_pred_info(ModuleInfo, Q, Ex, Needed, NeededNames).
-:- pred dead_pred_elim_analyze(dead_pred_info::in,
- dead_pred_info::out) is det.
+:- pred dead_pred_elim_analyze(dead_pred_info::in, dead_pred_info::out) is det.
dead_pred_elim_analyze(DeadInfo0, DeadInfo) :-
DeadInfo0 = dead_pred_info(ModuleInfo, Q0, Ex0, Needed0, NeededNames),
@@ -860,59 +859,59 @@
DeadInfo = DeadInfo0
).
-:- pred dead_pred_elim_process_clause(clause::in, dead_pred_info::in,
- dead_pred_info::out) is det.
+:- pred dead_pred_elim_process_clause(clause::in,
+ dead_pred_info::in, dead_pred_info::out) is det.
-dead_pred_elim_process_clause(clause(_, Goal, _, _)) -->
- pre_modecheck_examine_goal(Goal).
+dead_pred_elim_process_clause(clause(_, Goal, _, _), !DeadInfo) :-
+ pre_modecheck_examine_goal(Goal, !DeadInfo).
:- pred pre_modecheck_examine_goal(hlds_goal::in,
dead_pred_info::in, dead_pred_info::out) is det.
-pre_modecheck_examine_goal(conj(Goals) - _) -->
- list__foldl(pre_modecheck_examine_goal, Goals).
-pre_modecheck_examine_goal(par_conj(Goals) - _) -->
- list__foldl(pre_modecheck_examine_goal, Goals).
-pre_modecheck_examine_goal(disj(Goals) - _) -->
- list__foldl(pre_modecheck_examine_goal, Goals).
-pre_modecheck_examine_goal(if_then_else(_, If, Then, Else) - _) -->
- list__foldl(pre_modecheck_examine_goal, [If, Then, Else]).
-pre_modecheck_examine_goal(switch(_, _, Cases) - _) -->
- { ExamineCase = (pred(Case::in, Info0::in, Info::out) is det :-
+pre_modecheck_examine_goal(conj(Goals) - _, !DeadInfo) :-
+ list__foldl(pre_modecheck_examine_goal, Goals, !DeadInfo).
+pre_modecheck_examine_goal(par_conj(Goals) - _, !DeadInfo) :-
+ list__foldl(pre_modecheck_examine_goal, Goals, !DeadInfo).
+pre_modecheck_examine_goal(disj(Goals) - _, !DeadInfo) :-
+ list__foldl(pre_modecheck_examine_goal, Goals, !DeadInfo).
+pre_modecheck_examine_goal(if_then_else(_, If, Then, Else) - _, !DeadInfo) :-
+ list__foldl(pre_modecheck_examine_goal, [If, Then, Else], !DeadInfo).
+pre_modecheck_examine_goal(switch(_, _, Cases) - _, !DeadInfo) :-
+ ExamineCase = (pred(Case::in, Info0::in, Info::out) is det :-
Case = case(_, Goal),
pre_modecheck_examine_goal(Goal, Info0, Info)
- ) },
- list__foldl(ExamineCase, Cases).
-pre_modecheck_examine_goal(generic_call(_,_,_,_) - _) --> [].
-pre_modecheck_examine_goal(not(Goal) - _) -->
- pre_modecheck_examine_goal(Goal).
-pre_modecheck_examine_goal(some(_, _, Goal) - _) -->
- pre_modecheck_examine_goal(Goal).
-pre_modecheck_examine_goal(call(_, _, _, _, _, PredName) - _) -->
- dead_pred_info_add_pred_name(PredName).
-pre_modecheck_examine_goal(foreign_proc(_, _, _, _, _, _, _) - _) -->
- [].
-pre_modecheck_examine_goal(unify(_, Rhs, _, _, _) - _) -->
- pre_modecheck_examine_unify_rhs(Rhs).
-pre_modecheck_examine_goal(shorthand(_) - _) -->
+ ),
+ list__foldl(ExamineCase, Cases, !DeadInfo).
+pre_modecheck_examine_goal(generic_call(_,_,_,_) - _, !DeadInfo).
+pre_modecheck_examine_goal(not(Goal) - _, !DeadInfo) :-
+ pre_modecheck_examine_goal(Goal, !DeadInfo).
+pre_modecheck_examine_goal(some(_, _, Goal) - _, !DeadInfo) :-
+ pre_modecheck_examine_goal(Goal, !DeadInfo).
+pre_modecheck_examine_goal(call(_, _, _, _, _, PredName) - _, !DeadInfo) :-
+ dead_pred_info_add_pred_name(PredName, !DeadInfo).
+pre_modecheck_examine_goal(foreign_proc(_, _, _, _, _, _) - _, !DeadInfo).
+pre_modecheck_examine_goal(unify(_, Rhs, _, _, _) - _, !DeadInfo) :-
+ pre_modecheck_examine_unify_rhs(Rhs, !DeadInfo).
+pre_modecheck_examine_goal(shorthand(_) - _, !DeadInfo) :-
% these should have been expanded out by now
- { error("pre_modecheck_examine_goal: unexpected shorthand") }.
+ error("pre_modecheck_examine_goal: unexpected shorthand").
:- pred pre_modecheck_examine_unify_rhs(unify_rhs::in,
dead_pred_info::in, dead_pred_info::out) is det.
-pre_modecheck_examine_unify_rhs(var(_)) --> [].
-pre_modecheck_examine_unify_rhs(functor(Functor, _, _)) -->
- ( { Functor = cons(Name, _) } ->
- dead_pred_info_add_pred_name(Name)
+pre_modecheck_examine_unify_rhs(var(_), !DeadInfo).
+pre_modecheck_examine_unify_rhs(functor(Functor, _, _), !DeadInfo) :-
+ ( Functor = cons(Name, _) ->
+ dead_pred_info_add_pred_name(Name, !DeadInfo)
;
- []
+ true
).
-pre_modecheck_examine_unify_rhs(lambda_goal(_, _, _, _, _, _, _, _, Goal)) -->
- pre_modecheck_examine_goal(Goal).
+pre_modecheck_examine_unify_rhs(lambda_goal(_, _, _, _, _, _, _, _, Goal),
+ !DeadInfo) :-
+ pre_modecheck_examine_goal(Goal, !DeadInfo).
-:- pred dead_pred_info_add_pred_name(sym_name::in, dead_pred_info::in,
- dead_pred_info::out) is det.
+:- pred dead_pred_info_add_pred_name(sym_name::in,
+ dead_pred_info::in, dead_pred_info::out) is det.
dead_pred_info_add_pred_name(Name, DeadInfo0, DeadInfo) :-
DeadInfo0 = dead_pred_info(ModuleInfo, Q0, Ex, Needed, NeededNames0),
Index: compiler/deep_profiling.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/deep_profiling.m,v
retrieving revision 1.24
diff -u -b -r1.24 deep_profiling.m
--- compiler/deep_profiling.m 19 May 2004 03:59:08 -0000 1.24
+++ compiler/deep_profiling.m 7 Jun 2004 08:49:55 -0000
@@ -185,7 +185,7 @@
FoundTailCall0, FoundTailCall, Continue) :-
Goal0 = GoalExpr0 - GoalInfo0,
(
- GoalExpr0 = foreign_proc(_, _, _, _, _, _, _),
+ GoalExpr0 = foreign_proc(_, _, _, _, _, _),
Goal = Goal0,
FoundTailCall = FoundTailCall0,
Continue = no
@@ -356,7 +356,7 @@
figure_out_rec_call_numbers(Goal, N0, N, TailCallSites0, TailCallSites) :-
Goal = GoalExpr - GoalInfo,
(
- GoalExpr = foreign_proc(Attrs, _, _, _, _, _, _),
+ GoalExpr = foreign_proc(Attrs, _, _, _, _, _),
( may_call_mercury(Attrs) = may_call_mercury ->
N = N0 + 1
;
@@ -471,7 +471,7 @@
predicate_module(ModuleInfo, PredId, PredModuleName),
(
% XXX We need to eliminate nondet C code...
- Goal0 = foreign_proc(_,_,_,_,_,_, Impl) - _,
+ Goal0 = foreign_proc(_, _, _, _, _, Impl) - _,
Impl = nondet(_, _, _, _, _, _, _, _, _)
->
error("deep profiling is incompatible with nondet foreign code")
@@ -1031,7 +1031,7 @@
transform_goal(Path, Goal0 - GoalInfo0, GoalAndInfo, AddedImpurity,
!DeepInfo) :-
- Goal0 = foreign_proc(Attrs, _, _, _, _, _, _),
+ Goal0 = foreign_proc(Attrs, _, _, _, _, _),
( may_call_mercury(Attrs) = may_call_mercury ->
wrap_foreign_code(Path, Goal0 - GoalInfo0, GoalAndInfo,
!DeepInfo),
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.36
diff -u -b -r1.36 deforest.m
--- compiler/deforest.m 21 Dec 2003 05:04:32 -0000 1.36
+++ compiler/deforest.m 7 Jun 2004 08:49:55 -0000
@@ -315,7 +315,7 @@
deforest__cases(Var, Cases0, Cases).
deforest__goal(Goal, Goal) -->
- { Goal = foreign_proc(_, _, _, _, _, _, _) - _ }.
+ { Goal = foreign_proc(_, _, _, _, _, _) - _ }.
deforest__goal(Goal, Goal) -->
{ Goal = generic_call(_, _, _, _) - _ }.
Index: compiler/delay_construct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/delay_construct.m,v
retrieving revision 1.6
diff -u -b -r1.6 delay_construct.m
--- compiler/delay_construct.m 5 Apr 2004 05:06:46 -0000 1.6
+++ compiler/delay_construct.m 7 Jun 2004 08:49:55 -0000
@@ -159,7 +159,7 @@
GoalExpr0 = unify(_, _, _, _, _),
Goal = GoalExpr0 - GoalInfo0
;
- GoalExpr0 = foreign_proc(_, _, _, _, _, _, _),
+ GoalExpr0 = foreign_proc(_, _, _, _, _, _),
Goal = GoalExpr0 - GoalInfo0
;
GoalExpr0 = shorthand(_),
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.70
diff -u -b -r1.70 dependency_graph.m
--- compiler/dependency_graph.m 19 May 2004 03:59:08 -0000 1.70
+++ compiler/dependency_graph.m 7 Jun 2004 08:49:55 -0000
@@ -433,7 +433,7 @@
% There can be no dependencies within a foreign_proc
dependency_graph__add_arcs_in_goal_2(
- foreign_proc(_, _, _, _, _, _, _), _, !DepGraph).
+ foreign_proc(_, _, _, _, _, _), _, !DepGraph).
dependency_graph__add_arcs_in_goal_2(shorthand(ShorthandGoal), Caller,
!DepGraph) :-
@@ -822,7 +822,7 @@
true
).
process_aditi_goal(_IsNeg, generic_call(_, _, _, _) - _, !Map, !Info).
-process_aditi_goal(_IsNeg, foreign_proc(_, _, _, _, _, _, _) - _, !Map, !Info).
+process_aditi_goal(_IsNeg, foreign_proc(_, _, _, _, _, _) - _, !Map, !Info).
process_aditi_goal(_, shorthand(_) - _, _, _, _, _) :-
% these should have been expanded out by now
error("process_aditi_goal: unexpected shorthand").
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_analysis.m,v
retrieving revision 1.167
diff -u -b -r1.167 det_analysis.m
--- compiler/det_analysis.m 14 May 2004 08:40:21 -0000 1.167
+++ compiler/det_analysis.m 7 Jun 2004 08:49:55 -0000
@@ -722,11 +722,11 @@
Goal, Det, Msgs).
% pragma foregin_codes are handled in the same way as predicate calls
-det_infer_goal_2(foreign_proc(Attributes, PredId, ProcId,
- Args, ArgNameMap, OrigArgTypes, PragmaCode),
+det_infer_goal_2(foreign_proc(Attributes, PredId, ProcId, Args, ExtraArgs,
+ PragmaCode),
GoalInfo, _, SolnContext, DetInfo, _, _,
- foreign_proc(Attributes, PredId, ProcId, Args,
- ArgNameMap, OrigArgTypes, PragmaCode),
+ foreign_proc(Attributes, PredId, ProcId, Args, ExtraArgs,
+ PragmaCode),
Detism, Msgs) :-
det_info_get_module_info(DetInfo, ModuleInfo),
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.88
diff -u -b -r1.88 det_report.m
--- compiler/det_report.m 31 May 2004 04:12:52 -0000 1.88
+++ compiler/det_report.m 7 Jun 2004 08:49:55 -0000
@@ -661,8 +661,8 @@
det_diagnose_goal(Goal, InternalDesired, SwitchContext, DetInfo,
Diagnosed, !IO).
-det_diagnose_goal_2(foreign_proc(_, _, _, _, _, _, _), GoalInfo,
- Desired, _, _, _, yes, !IO) :-
+det_diagnose_goal_2(foreign_proc(_, _, _, _, _, _), GoalInfo, Desired,
+ _, _, _, yes, !IO) :-
goal_info_get_context(GoalInfo, Context),
DesiredStr = determinism_to_string(Desired),
Pieces = [words("Determinism declaration not satisfied."),
Index: compiler/dnf.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dnf.m,v
retrieving revision 1.53
diff -u -b -r1.53 dnf.m
--- compiler/dnf.m 30 Jan 2004 06:00:44 -0000 1.53
+++ compiler/dnf.m 7 Jun 2004 08:49:55 -0000
@@ -249,7 +249,7 @@
NewPredIds = NewPredIds0,
Goal = Goal0
;
- GoalExpr0 = foreign_proc(_, _, _, _, _, _, _),
+ GoalExpr0 = foreign_proc(_, _, _, _, _, _),
ModuleInfo = ModuleInfo0,
NewPredIds = NewPredIds0,
Goal = Goal0
@@ -485,7 +485,7 @@
IsAtomic = no
).
dnf__is_atomic_expr(_, _, _, if_then_else(_, _, _, _), no).
-dnf__is_atomic_expr(_, _, _, foreign_proc(_, _, _, _, _, _, _), yes).
+dnf__is_atomic_expr(_, _, _, foreign_proc(_, _, _, _, _, _), yes).
dnf__is_atomic_expr(MaybeNonAtomic, InNeg, InSome, shorthand(ShorthandGoal),
IsAtomic) :-
dnf__is_atomic_expr_shorthand(MaybeNonAtomic, InNeg, InSome,
@@ -534,7 +534,7 @@
dnf__free_of_nonatomic(Cond, NonAtomic),
dnf__free_of_nonatomic(Then, NonAtomic),
dnf__free_of_nonatomic(Else, NonAtomic).
-dnf__free_of_nonatomic(foreign_proc(_, _, _, _, _, _, _) - _,
+dnf__free_of_nonatomic(foreign_proc(_, _, _, _, _, _) - _,
_NonAtomic).
:- pred dnf__goals_free_of_nonatomic(list(hlds_goal)::in,
Index: compiler/dupelim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dupelim.m,v
retrieving revision 1.60
diff -u -b -r1.60 dupelim.m
--- compiler/dupelim.m 23 May 2004 23:14:25 -0000 1.60
+++ compiler/dupelim.m 7 Jun 2004 08:49:55 -0000
@@ -124,7 +124,7 @@
(
Instr = pragma_c(_, _, _,
MaybeFixedLabel, MaybeLayoutLabel,
- MaybeOnlyLayoutLabel, _, _) - _
+ MaybeOnlyLayoutLabel, _, _, _) - _
->
( MaybeFixedLabel = yes(FixedLabel) ->
set__insert(FoldFixed0, FixedLabel, FoldFixed1)
@@ -397,7 +397,7 @@
standardize_lval(Lval1, Lval),
Instr = join_and_continue(Lval, N)
;
- Instr1 = pragma_c(_, _, _, _, _, _, _, _),
+ Instr1 = pragma_c(_, _, _, _, _, _, _, _, _),
Instr = Instr1
).
@@ -701,7 +701,7 @@
Instr2 = Instr1,
Instr = Instr1
;
- Instr1 = pragma_c(_, _, _, _, _, _, _, _),
+ Instr1 = pragma_c(_, _, _, _, _, _, _, _, _),
Instr2 = Instr1,
Instr = Instr1
).
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.36
diff -u -b -r1.36 equiv_type.m
--- compiler/equiv_type.m 19 Mar 2004 10:19:19 -0000 1.36
+++ compiler/equiv_type.m 7 Jun 2004 08:49:55 -0000
@@ -37,40 +37,36 @@
% For items not defined in the current module, the items expanded
% while processing each item are recorded in the recompilation_info,
% for use by smart recompilation.
-:- pred equiv_type__expand_eqv_types(module_name, list(item_and_context),
- list(item_and_context), bool, eqv_map,
- maybe(recompilation_info), maybe(recompilation_info),
- io__state, io__state).
-:- mode equiv_type__expand_eqv_types(in, in, out, out, out,
- in, out, di, uo) is det.
+:- pred equiv_type__expand_eqv_types(module_name::in,
+ list(item_and_context)::in, list(item_and_context)::out,
+ bool::out, eqv_map::out,
+ maybe(recompilation_info)::in, maybe(recompilation_info)::out,
+ io::di, io::uo) is det.
% Replace equivalence types in a given type.
% The bool output is `yes' if anything changed.
-:- pred equiv_type__replace_in_type(eqv_map, type, type, bool,
- tvarset, tvarset, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_type(in, in, out, out, in, out, in, out) is det.
-
-:- pred equiv_type__replace_in_type_list(eqv_map, list(type), list(type),
- bool, tvarset, tvarset, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_type_list(in, in, out, out, in, out,
- in, out) is det.
-
-:- pred equiv_type__replace_in_class_constraints(eqv_map, class_constraints,
- class_constraints, tvarset, tvarset,
- equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_class_constraints(in, in, out,
- in, out, in, out) is det.
-
-:- pred equiv_type__replace_in_class_constraint(eqv_map,
- class_constraint, class_constraint, tvarset, tvarset,
- equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_class_constraint(in, in, out,
- in, out, in, out) is det.
-
-:- pred equiv_type__replace_in_ctors(eqv_map,
- list(constructor), list(constructor), tvarset, tvarset,
- equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_ctors(in, in, out, in, out, in, out) is det.
+:- pred equiv_type__replace_in_type(eqv_map::in, (type)::in, (type)::out,
+ bool::out, tvarset::in, tvarset::out,
+ equiv_type_info::in, equiv_type_info::out) is det.
+
+:- pred equiv_type__replace_in_type_list(eqv_map::in,
+ list(type)::in, list(type)::out, bool::out, tvarset::in, tvarset::out,
+ equiv_type_info::in, equiv_type_info::out) is det.
+
+:- pred equiv_type__replace_in_class_constraints(eqv_map::in,
+ class_constraints::in, class_constraints::out,
+ tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out)
+ is det.
+
+:- pred equiv_type__replace_in_class_constraint(eqv_map::in,
+ class_constraint::in, class_constraint::out,
+ tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out)
+ is det.
+
+:- pred equiv_type__replace_in_ctors(eqv_map::in,
+ list(constructor)::in, list(constructor)::out,
+ tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out)
+ is det.
:- type eqv_type_body ---> eqv_type_body(tvarset, list(type_param), type).
:- type eqv_map == map(type_ctor, eqv_type_body).
@@ -81,14 +77,13 @@
% For smart recompilation we need to record which items were
% expanded in each declaration. Any items which depend on
% that declaration also depend on the expanded items.
-:- pred equiv_type__maybe_record_expanded_items(module_name, sym_name,
- maybe(recompilation_info), equiv_type_info).
-:- mode equiv_type__maybe_record_expanded_items(in, in, in, out) is det.
+:- pred equiv_type__maybe_record_expanded_items(module_name::in, sym_name::in,
+ maybe(recompilation_info)::in, equiv_type_info::out) is det.
% Record all the expanded items in the recompilation_info.
-:- pred equiv_type__finish_recording_expanded_items(item_id,
- equiv_type_info, maybe(recompilation_info), maybe(recompilation_info)).
-:- mode equiv_type__finish_recording_expanded_items(in, in, in, out) is det.
+:- pred equiv_type__finish_recording_expanded_items(item_id::in,
+ equiv_type_info::in, maybe(recompilation_info)::in,
+ maybe(recompilation_info)::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -115,23 +110,23 @@
% them.
equiv_type__expand_eqv_types(ModuleName, Items0, Items, Error, EqvMap,
- Info0, Info) -->
- { map__init(EqvMap0) },
- { map__init(EqvInstMap0) },
- { equiv_type__build_eqv_map(Items0, EqvMap0, EqvMap,
- EqvInstMap0, EqvInstMap) },
- { equiv_type__replace_in_item_list(ModuleName, Items0, EqvMap,
- EqvInstMap, [], RevItems, [], ErrorList, Info0, Info) },
- { list__reverse(RevItems, Items) },
+ !Info, !IO) :-
+ map__init(EqvMap0),
+ map__init(EqvInstMap0),
+ equiv_type__build_eqv_map(Items0, EqvMap0, EqvMap,
+ EqvInstMap0, EqvInstMap),
+ equiv_type__replace_in_item_list(ModuleName, Items0, EqvMap,
+ EqvInstMap, [], RevItems, [], ErrorList, !Info),
+ list__reverse(RevItems, Items),
(
- { ErrorList = [] }
+ ErrorList = []
->
- { Error = no }
+ Error = no
;
list__foldl(equiv_type__report_error,
- list__reverse(ErrorList)),
- { Error = yes },
- io__set_exit_status(1)
+ list__reverse(ErrorList), !IO),
+ Error = yes,
+ io__set_exit_status(1, !IO)
).
% We need to expand equivalence insts in
@@ -141,8 +136,7 @@
:- type pred_or_func_decl_type
---> type_decl
- ; mode_decl
- .
+ ; mode_decl.
:- type eqv_error == pair(eqv_error_type, prog_context).
@@ -151,50 +145,32 @@
; invalid_with_type(sym_name, pred_or_func)
; invalid_with_inst(pred_or_func_decl_type,
sym_name, maybe(pred_or_func))
- ; non_matching_with_type_with_inst(sym_name, pred_or_func)
- .
+ ; non_matching_with_type_with_inst(sym_name, pred_or_func).
-:- pred equiv_type__build_eqv_map(list(item_and_context), eqv_map, eqv_map,
- eqv_inst_map, eqv_inst_map).
-:- mode equiv_type__build_eqv_map(in, in, out, in, out) is det.
+:- pred equiv_type__build_eqv_map(list(item_and_context)::in,
+ eqv_map::in, eqv_map::out, eqv_inst_map::in, eqv_inst_map::out) is det.
-equiv_type__build_eqv_map([], EqvMap, EqvMap, EqvInstMap, EqvInstMap).
-equiv_type__build_eqv_map([Item - _Context | Items0], EqvMap0, EqvMap,
- EqvInstMap0, EqvInstMap) :-
- (
- Item = module_defn(_, abstract_imported)
- ->
- skip_abstract_imported_items(Items0, Items),
- EqvMap1 = EqvMap0,
- EqvInstMap1 = EqvInstMap0
- ;
- Item = type_defn(VarSet, Name, Args,
- eqv_type(Body), _Cond)
- ->
+equiv_type__build_eqv_map([], !EqvMap, !EqvInstMap).
+equiv_type__build_eqv_map([Item - _Context | Items0], !EqvMap, !EqvInstMap) :-
+ ( Item = module_defn(_, abstract_imported) ->
+ skip_abstract_imported_items(Items0, Items)
+ ; Item = type_defn(VarSet, Name, Args, eqv_type(Body), _Cond) ->
Items = Items0,
list__length(Args, Arity),
- map__set(EqvMap0, Name - Arity,
- eqv_type_body(VarSet, Args, Body), EqvMap1),
- EqvInstMap1 = EqvInstMap0
- ;
- Item = inst_defn(VarSet, Name, Args, eqv_inst(Body), _)
- ->
+ map__set(!.EqvMap, Name - Arity,
+ eqv_type_body(VarSet, Args, Body), !:EqvMap)
+ ; Item = inst_defn(VarSet, Name, Args, eqv_inst(Body), _) ->
Items = Items0,
list__length(Args, Arity),
- map__set(EqvInstMap0, Name - Arity,
- eqv_inst_body(VarSet, Args, Body), EqvInstMap1),
- EqvMap1 = EqvMap0
+ map__set(!.EqvInstMap, Name - Arity,
+ eqv_inst_body(VarSet, Args, Body), !:EqvInstMap)
;
- Items = Items0,
- EqvMap1 = EqvMap0,
- EqvInstMap1 = EqvInstMap0
+ Items = Items0
),
- equiv_type__build_eqv_map(Items, EqvMap1, EqvMap,
- EqvInstMap1, EqvInstMap).
+ equiv_type__build_eqv_map(Items, !EqvMap, !EqvInstMap).
-:- pred skip_abstract_imported_items(list(item_and_context),
- list(item_and_context)).
-:- mode skip_abstract_imported_items(in, out) is det.
+:- pred skip_abstract_imported_items(list(item_and_context)::in,
+ list(item_and_context)::out) is det.
skip_abstract_imported_items([], []).
skip_abstract_imported_items([Item - _ | Items0], Items) :-
@@ -232,58 +208,50 @@
% of items. Similarly the replace_in_<foo> predicates that
% follow perform substitution of equivalence types on <foo>s.
-:- pred equiv_type__replace_in_item_list(module_name, list(item_and_context),
- eqv_map, eqv_inst_map, list(item_and_context), list(item_and_context),
- list(eqv_error), list(eqv_error),
- maybe(recompilation_info), maybe(recompilation_info)).
-:- mode equiv_type__replace_in_item_list(in, in, in, in, in, out,
- in, out, in, out) is det.
+:- pred equiv_type__replace_in_item_list(module_name::in,
+ list(item_and_context)::in, eqv_map::in, eqv_inst_map::in,
+ list(item_and_context)::in, list(item_and_context)::out,
+ list(eqv_error)::in, list(eqv_error)::out,
+ maybe(recompilation_info)::in, maybe(recompilation_info)::out) is det.
-equiv_type__replace_in_item_list(_, [], _, _, Items, Items,
- Errors, Errors, Info, Info).
+equiv_type__replace_in_item_list(_, [], _, _, !Items, !Errors, !Info).
equiv_type__replace_in_item_list(ModuleName, [ItemAndContext0 | Items0],
- EqvMap, EqvInstMap, ReplItems0, ReplItems,
- Errors0, Errors, Info0, Info) :-
+ EqvMap, EqvInstMap, !ReplItems, !Errors, !Info) :-
ItemAndContext0 = Item0 - Context,
(
equiv_type__replace_in_item(ModuleName, Item0, Context, EqvMap,
- EqvInstMap, Item, Errors1, Info0, Info1)
+ EqvInstMap, Item, NewErrors, !Info)
->
- Info2 = Info1,
ItemAndContext = Item - Context,
% Discard the item if there were any errors.
- ( Errors1 = [] ->
- ReplItems1 = [ItemAndContext | ReplItems0]
+ ( NewErrors = [] ->
+ !:ReplItems = [ItemAndContext | !.ReplItems]
;
- ReplItems1 = ReplItems0
+ true
),
-
- Errors2 = Errors1 ++ Errors0
+ !:Errors = NewErrors ++ !.Errors
;
ItemAndContext = ItemAndContext0,
- Errors2 = Errors0,
- Info2 = Info0,
- ReplItems1 = [ItemAndContext | ReplItems0]
+ !:ReplItems = [ItemAndContext | !.ReplItems]
),
equiv_type__replace_in_item_list(ModuleName, Items0, EqvMap,
- EqvInstMap, ReplItems1, ReplItems, Errors2, Errors,
- Info2, Info).
+ EqvInstMap, !ReplItems, !Errors, !Info).
-:- pred equiv_type__replace_in_item(module_name, item, prog_context,
- eqv_map, eqv_inst_map, item, list(eqv_error), maybe(recompilation_info),
- maybe(recompilation_info)).
-:- mode equiv_type__replace_in_item(in, in, in, in, in, out, out,
- in, out) is semidet.
+:- pred equiv_type__replace_in_item(module_name::in, item::in,
+ prog_context::in, eqv_map::in, eqv_inst_map::in, item::out,
+ list(eqv_error)::out,
+ maybe(recompilation_info)::in, maybe(recompilation_info)::out)
+ is semidet.
equiv_type__replace_in_item(ModuleName,
type_defn(VarSet0, Name, TArgs, TypeDefn0, Cond) @ Item,
Context, EqvMap, _EqvInstMap,
type_defn(VarSet, Name, TArgs, TypeDefn, Cond),
- Error, Info0, Info) :-
+ Error, !Info) :-
list__length(TArgs, Arity),
equiv_type__maybe_record_expanded_items(ModuleName, Name,
- Info0, UsedTypeCtors0),
+ !.Info, UsedTypeCtors0),
equiv_type__replace_in_type_defn(EqvMap, Name - Arity, TypeDefn0,
TypeDefn, ContainsCirc, VarSet0, VarSet,
UsedTypeCtors0, UsedTypeCtors),
@@ -293,7 +261,7 @@
Error = []
),
equiv_type__finish_recording_expanded_items(
- item_id(type_body, Name - Arity), UsedTypeCtors, Info0, Info).
+ item_id(type_body, Name - Arity), UsedTypeCtors, !Info).
equiv_type__replace_in_item(ModuleName,
pred_or_func(TypeVarSet0, InstVarSet, ExistQVars, PredOrFunc,
@@ -303,9 +271,9 @@
pred_or_func(TypeVarSet, InstVarSet, ExistQVars, PredOrFunc,
PredName, TypesAndModes, MaybeWithType,
MaybeWithInst, Det, Cond, Purity, ClassContext),
- Errors, Info0, Info) :-
+ Errors, !Info) :-
equiv_type__maybe_record_expanded_items(ModuleName, PredName,
- Info0, ExpandedItems0),
+ !.Info, ExpandedItems0),
equiv_type__replace_in_pred_type(PredName, PredOrFunc, Context, EqvMap,
EqvInstMap, ClassContext0, ClassContext,
@@ -318,7 +286,7 @@
adjust_func_arity(PredOrFunc, OrigArity, Arity),
equiv_type__finish_recording_expanded_items(
item_id(ItemType, PredName - OrigArity),
- ExpandedItems, Info0, Info).
+ ExpandedItems, !Info).
equiv_type__replace_in_item(ModuleName,
pred_or_func_mode(InstVarSet, MaybePredOrFunc0, PredName,
@@ -326,9 +294,9 @@
Context, _EqvMap, EqvInstMap,
pred_or_func_mode(InstVarSet, MaybePredOrFunc, PredName,
Modes, WithInst, Det, Cond),
- Errors, Info0, Info) :-
+ Errors, !Info) :-
equiv_type__maybe_record_expanded_items(ModuleName, PredName,
- Info0, ExpandedItems0),
+ !.Info, ExpandedItems0),
equiv_type__replace_in_pred_mode(PredName, length(Modes0), Context,
mode_decl, EqvInstMap, MaybePredOrFunc0, MaybePredOrFunc,
@@ -346,9 +314,9 @@
adjust_func_arity(PredOrFunc, OrigArity, Arity),
equiv_type__finish_recording_expanded_items(
item_id(ItemType, PredName - OrigArity),
- ExpandedItems, Info0, Info)
+ ExpandedItems, !Info)
;
- Info = Info0
+ true
).
equiv_type__replace_in_item(ModuleName,
@@ -357,10 +325,10 @@
_Context, EqvMap, EqvInstMap,
typeclass(Constraints, ClassName, Vars,
ClassInterface, VarSet),
- Errors, Info0, Info) :-
+ Errors, !Info) :-
list__length(Vars, Arity),
equiv_type__maybe_record_expanded_items(ModuleName, ClassName,
- Info0, ExpandedItems0),
+ !.Info, ExpandedItems0),
equiv_type__replace_in_class_constraint_list(EqvMap,
Constraints0, Constraints, VarSet0, VarSet,
ExpandedItems0, ExpandedItems1),
@@ -378,7 +346,7 @@
),
equiv_type__finish_recording_expanded_items(
item_id(typeclass, ClassName - Arity),
- ExpandedItems, Info0, Info).
+ ExpandedItems, !Info).
equiv_type__replace_in_item(ModuleName,
instance(Constraints0, ClassName, Ts0,
@@ -386,8 +354,8 @@
_Context, EqvMap, _EqvInstMap,
instance(Constraints, ClassName, Ts,
InstanceBody, VarSet, ModName),
- [], Info0, Info) :-
- ( (Info0 = no ; ModName = ModuleName) ->
+ [], !Info) :-
+ ( ( !.Info = no ; ModName = ModuleName ) ->
UsedTypeCtors0 = no
;
UsedTypeCtors0 = yes(ModuleName - set__init)
@@ -400,7 +368,7 @@
list__length(Ts0, Arity),
equiv_type__finish_recording_expanded_items(
item_id(typeclass, ClassName - Arity),
- UsedTypeCtors, Info0, Info).
+ UsedTypeCtors, !Info).
equiv_type__replace_in_item(ModuleName,
pragma(type_spec(PredName, B, Arity, D, E,
@@ -408,8 +376,8 @@
_Context, EqvMap, _EqvInstMap,
pragma(type_spec(PredName, B, Arity, D, E,
Subst, VarSet, ItemIds)),
- [], Info, Info) :-
- ( (Info = no ; PredName = qualified(ModuleName, _)) ->
+ [], !Info) :-
+ ( ( !.Info = no ; PredName = qualified(ModuleName, _) ) ->
ExpandedItems0 = no
;
ExpandedItems0 = yes(ModuleName - ItemIds0)
@@ -423,11 +391,9 @@
ExpandedItems = yes(_ - ItemIds)
).
-:- pred equiv_type__replace_in_type_defn(eqv_map, type_ctor,
- type_defn, type_defn, bool, tvarset, tvarset,
- equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_type_defn(in, in, in, out, out, in, out,
- in, out) is semidet.
+:- pred equiv_type__replace_in_type_defn(eqv_map::in, type_ctor::in,
+ type_defn::in, type_defn::out, bool::out, tvarset::in, tvarset::out,
+ equiv_type_info::in, equiv_type_info::out) is semidet.
equiv_type__replace_in_type_defn(EqvMap, TypeCtor, eqv_type(TBody0),
eqv_type(TBody), ContainsCirc, !VarSet, !Info) :-
@@ -449,16 +415,14 @@
equiv_type__replace_in_class_constraint_list(EqvMap, ExistCs0, ExistCs,
!VarSet, !Info).
-:- pred equiv_type__replace_in_class_constraint_list(eqv_map,
- list(class_constraint), list(class_constraint),
- tvarset, tvarset, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_class_constraint_list(in, in, out,
- in, out, in, out) is det.
+:- pred equiv_type__replace_in_class_constraint_list(eqv_map::in,
+ list(class_constraint)::in, list(class_constraint)::out,
+ tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out)
+ is det.
-equiv_type__replace_in_class_constraint_list(EqvMap, Cs0, Cs,
- !VarSet, !Info) :-
+equiv_type__replace_in_class_constraint_list(EqvMap, !Cs, !VarSet, !Info) :-
list__map_foldl2(equiv_type__replace_in_class_constraint(EqvMap),
- Cs0, Cs, !VarSet, !Info).
+ !Cs, !VarSet, !Info).
equiv_type__replace_in_class_constraint(EqvMap, Constraint0, Constraint,
!VarSet, !Info) :-
@@ -469,24 +433,21 @@
%-----------------------------------------------------------------------------%
-:- pred equiv_type__replace_in_class_interface(list(class_method),
- eqv_map, eqv_inst_map, list(class_method),
- list(eqv_error), list(eqv_error),
- equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_class_interface(in,
- in, in, out, in, out, in, out) is det.
+:- pred equiv_type__replace_in_class_interface(list(class_method)::in,
+ eqv_map::in, eqv_inst_map::in, list(class_method)::out,
+ list(eqv_error)::in, list(eqv_error)::out,
+ equiv_type_info::in, equiv_type_info::out) is det.
equiv_type__replace_in_class_interface(ClassInterface0, EqvMap, EqvInstMap,
- ClassInterface, Errors0, Errors, Info0, Info) :-
+ ClassInterface, !Errors, !Info) :-
list__map_foldl2(
equiv_type__replace_in_class_method(EqvMap, EqvInstMap),
- ClassInterface0, ClassInterface, Errors0, Errors, Info0, Info).
+ ClassInterface0, ClassInterface, !Errors, !Info).
-:- pred equiv_type__replace_in_class_method(eqv_map, eqv_inst_map,
- class_method, class_method, list(eqv_error), list(eqv_error),
- equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_class_method(in, in, in, out,
- in, out, in, out) is det.
+:- pred equiv_type__replace_in_class_method(eqv_map::in, eqv_inst_map::in,
+ class_method::in, class_method::out,
+ list(eqv_error)::in, list(eqv_error)::out,
+ equiv_type_info::in, equiv_type_info::out) is det.
equiv_type__replace_in_class_method(EqvMap, EqvInstMap,
pred_or_func(TypeVarSet0, InstVarSet, ExistQVars, PredOrFunc,
@@ -495,37 +456,37 @@
pred_or_func(TypeVarSet, InstVarSet, ExistQVars, PredOrFunc,
PredName, TypesAndModes, WithType, WithInst,
Det, Cond, Purity, ClassContext, Context),
- Errors0, Errors, Info0, Info) :-
+ !Errors, !Info) :-
equiv_type__replace_in_pred_type(PredName, PredOrFunc, Context, EqvMap,
EqvInstMap, ClassContext0, ClassContext,
TypesAndModes0, TypesAndModes, TypeVarSet0, TypeVarSet,
WithType0, WithType, WithInst0, WithInst, Det0, Det,
- Info0, Info, Errors1),
- Errors = Errors1 ++ Errors0.
+ !Info, NewErrors),
+ !:Errors = NewErrors ++ !.Errors.
equiv_type__replace_in_class_method(_, EqvInstMap,
pred_or_func_mode(InstVarSet, MaybePredOrFunc0, PredName,
Modes0, WithInst0, Det0, Cond, Context),
pred_or_func_mode(InstVarSet, MaybePredOrFunc, PredName,
Modes, WithInst, Det, Cond, Context),
- Errors0, Errors, Info0, Info) :-
+ !Errors, !Info) :-
equiv_type__replace_in_pred_mode(PredName, length(Modes0), Context,
mode_decl, EqvInstMap, MaybePredOrFunc0, MaybePredOrFunc,
- ExtraModes, WithInst0, WithInst, Det0, Det, Info0, Info,
- Errors1),
+ ExtraModes, WithInst0, WithInst, Det0, Det, !Info,
+ NewErrors),
( ExtraModes = [] ->
Modes = Modes0
;
Modes = Modes0 ++ ExtraModes
),
- Errors = Errors1 ++ Errors0.
+ !:Errors = NewErrors ++ !.Errors.
%-----------------------------------------------------------------------------%
-:- pred equiv_type__replace_in_subst(eqv_map,
- assoc_list(tvar, type), assoc_list(tvar, type),
- tvarset, tvarset, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_subst(in, in, out, in, out, in, out) is det.
+:- pred equiv_type__replace_in_subst(eqv_map::in,
+ assoc_list(tvar, type)::in, assoc_list(tvar, type)::out,
+ tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out)
+ is det.
equiv_type__replace_in_subst(_EqvMap, [], [], !VarSet, !Info).
equiv_type__replace_in_subst(EqvMap, [Var - Type0 | Subst0],
@@ -539,9 +500,9 @@
list__map_foldl2(equiv_type__replace_in_ctor(EqvMap),
!Ctors, !VarSet, !Info).
-:- pred equiv_type__replace_in_ctor(eqv_map, constructor, constructor,
- tvarset, tvarset, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_ctor(in, in, out, in, out, in, out) is det.
+:- pred equiv_type__replace_in_ctor(eqv_map::in,
+ constructor::in, constructor::out, tvarset::in, tvarset::out,
+ equiv_type_info::in, equiv_type_info::out) is det.
equiv_type__replace_in_ctor(EqvMap,
ctor(ExistQVars, Constraints0, TName, Targs0),
@@ -553,26 +514,24 @@
%-----------------------------------------------------------------------------%
-equiv_type__replace_in_type_list(EqvMap, Ts0, Ts, Changed,
- !VarSet, !Info) :-
- equiv_type__replace_in_type_list_2(EqvMap, [], Ts0, Ts,
- Changed, no, _, !VarSet, !Info).
+equiv_type__replace_in_type_list(EqvMap, !Ts, Changed, !VarSet, !Info) :-
+ equiv_type__replace_in_type_list_2(EqvMap, [], !Ts, Changed, no, _,
+ !VarSet, !Info).
-:- pred equiv_type__replace_in_type_list(eqv_map, list(type), list(type),
- bool, bool, tvarset, tvarset, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_type_list(in, in, out, out, out, in, out,
- in, out) is det.
+:- pred equiv_type__replace_in_type_list(eqv_map::in,
+ list(type)::in, list(type)::out, bool::out, bool::out,
+ tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out)
+ is det.
-equiv_type__replace_in_type_list(EqvMap, Ts0, Ts, Changed, ContainsCirc,
+equiv_type__replace_in_type_list(EqvMap, !Ts, Changed, ContainsCirc,
!VarSet, !Info) :-
- equiv_type__replace_in_type_list_2(EqvMap, [], Ts0, Ts,
+ equiv_type__replace_in_type_list_2(EqvMap, [], !Ts,
Changed, no, ContainsCirc, !VarSet, !Info).
-:- pred equiv_type__replace_in_type_list_2(eqv_map, list(type_ctor),
- list(type), list(type), bool, bool, bool, tvarset, tvarset,
- equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_type_list_2(in, in, in, out, out,
- in, out, in, out, in, out) is det.
+:- pred equiv_type__replace_in_type_list_2(eqv_map::in, list(type_ctor)::in,
+ list(type)::in, list(type)::out, bool::out, bool::in, bool::out,
+ tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out)
+ is det.
equiv_type__replace_in_type_list_2(_EqvMap, _Seen, [], [], no,
!ContainsCirc, !VarSet, !Info).
@@ -593,22 +552,21 @@
%-----------------------------------------------------------------------------%
-:- pred equiv_type__replace_in_ctor_arg_list(eqv_map,
- list(constructor_arg), list(constructor_arg), bool,
- tvarset, tvarset, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_ctor_arg_list(in, in, out, out,
- in, out, in, out) is det.
+:- pred equiv_type__replace_in_ctor_arg_list(eqv_map::in,
+ list(constructor_arg)::in, list(constructor_arg)::out, bool::out,
+ tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out)
+ is det.
-equiv_type__replace_in_ctor_arg_list(EqvMap, As0, As, ContainsCirc,
+equiv_type__replace_in_ctor_arg_list(EqvMap, !As, ContainsCirc,
!VarSet, !Info) :-
- equiv_type__replace_in_ctor_arg_list_2(EqvMap, [], As0, As, no,
+ equiv_type__replace_in_ctor_arg_list_2(EqvMap, [], !As, no,
ContainsCirc, !VarSet, !Info).
-:- pred equiv_type__replace_in_ctor_arg_list_2(eqv_map, list(type_ctor),
- list(constructor_arg), list(constructor_arg), bool, bool,
- tvarset, tvarset, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_ctor_arg_list_2(in, in, in, out,
- in, out, in, out, in, out) is det.
+:- pred equiv_type__replace_in_ctor_arg_list_2(eqv_map::in,
+ list(type_ctor)::in,
+ list(constructor_arg)::in, list(constructor_arg)::out,
+ bool::in, bool::out, tvarset::in, tvarset::out,
+ equiv_type_info::in, equiv_type_info::out) is det.
equiv_type__replace_in_ctor_arg_list_2(_EqvMap, _Seen, [], [], !ContainsCirc,
!VarSet, !Info).
@@ -628,19 +586,17 @@
% Replace all equivalence types in a given type, detecting
% any circularities.
-:- pred equiv_type__replace_in_type_2(eqv_map, list(type_ctor), type, type,
- bool, bool, tvarset, tvarset, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_type_2(in, in, in, out, out, out,
- in, out, in, out) is det.
+:- pred equiv_type__replace_in_type_2(eqv_map::in, list(type_ctor)::in,
+ (type)::in, (type)::out, bool::out, bool::out,
+ tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out)
+ is det.
equiv_type__replace_in_type_2(_EqvMap, _Seen,
term__variable(V), term__variable(V), no, no, !VarSet, !Info).
equiv_type__replace_in_type_2(EqvMap, TypeCtorsAlreadyExpanded, Type0, Type,
Changed, Circ, !VarSet, !Info) :-
Type0 = term__functor(_, _, _),
- (
- type_to_ctor_and_args(Type0, EqvTypeCtor, TArgs0)
- ->
+ ( type_to_ctor_and_args(Type0, EqvTypeCtor, TArgs0) ->
equiv_type__replace_in_type_list_2(EqvMap,
TypeCtorsAlreadyExpanded, TArgs0, TArgs1,
ArgsChanged, no, Circ0, !VarSet, !Info),
@@ -696,20 +652,19 @@
Circ = no
).
-:- pred equiv_type__replace_in_inst(inst, eqv_inst_map, inst,
- equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_inst(in, in, out, in, out) is det.
-
-equiv_type__replace_in_inst(Inst0, EqvInstMap, Inst, Info0, Info) :-
- equiv_type__replace_in_inst(Inst0, EqvInstMap, set__init,
- Inst, Info0, Info).
-
-:- pred equiv_type__replace_in_inst(inst, eqv_inst_map,
- set(inst_id), inst, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_inst(in, in, in, out, in, out) is det.
+:- pred equiv_type__replace_in_inst((inst)::in, eqv_inst_map::in, (inst)::out,
+ equiv_type_info::in, equiv_type_info::out) is det.
+
+equiv_type__replace_in_inst(Inst0, EqvInstMap, Inst, !Info) :-
+ equiv_type__replace_in_inst(Inst0, EqvInstMap, set__init, Inst,
+ !Info).
+
+:- pred equiv_type__replace_in_inst((inst)::in, eqv_inst_map::in,
+ set(inst_id)::in, (inst)::out,
+ equiv_type_info::in, equiv_type_info::out) is det.
equiv_type__replace_in_inst(Inst0, EqvInstMap, ExpandedInstIds,
- Inst, Info0, Info) :-
+ Inst, !Info) :-
(
Inst0 = defined_inst(user_inst(SymName, ArgInsts))
->
@@ -717,7 +672,6 @@
(
set__member(InstId, ExpandedInstIds)
->
- Info = Info0,
Inst = Inst0
;
map__search(EqvInstMap, InstId,
@@ -726,29 +680,28 @@
inst_substitute_arg_list(EqvInst, EqvInstParams,
ArgInsts, Inst1),
equiv_type__record_expanded_item(item_id(inst, InstId),
- Info0, Info1),
+ !Info),
equiv_type__replace_in_inst(Inst1, EqvInstMap,
set__insert(ExpandedInstIds, InstId), Inst,
- Info1, Info)
+ !Info)
;
- Info = Info0,
Inst = Inst0
)
;
- Info = Info0,
Inst = Inst0
).
%-----------------------------------------------------------------------------%
-:- pred equiv_type__replace_in_pred_type(sym_name, pred_or_func, prog_context,
- eqv_map, eqv_inst_map, class_constraints, class_constraints,
- list(type_and_mode), list(type_and_mode), tvarset, tvarset,
- maybe(type), maybe(type), maybe(inst), maybe(inst),
- maybe(determinism), maybe(determinism),
- equiv_type_info, equiv_type_info, list(eqv_error)).
-:- mode equiv_type__replace_in_pred_type(in, in, in, in, in, in, out, in, out,
- in, out, in, out, in, out, in, out, in, out, out) is det.
+:- pred equiv_type__replace_in_pred_type(sym_name::in, pred_or_func::in,
+ prog_context::in, eqv_map::in, eqv_inst_map::in,
+ class_constraints::in, class_constraints::out,
+ list(type_and_mode)::in, list(type_and_mode)::out,
+ tvarset::in, tvarset::out,
+ maybe(type)::in, maybe(type)::out, maybe(inst)::in, maybe(inst)::out,
+ maybe(determinism)::in, maybe(determinism)::out,
+ equiv_type_info::in, equiv_type_info::out, list(eqv_error)::out)
+ is det.
equiv_type__replace_in_pred_type(PredName, PredOrFunc, Context, EqvMap,
EqvInstMap, ClassContext0, ClassContext,
@@ -825,30 +778,30 @@
TypesAndModes = TypesAndModes1 ++ ExtraTypesAndModes
).
-:- pred equiv_type__replace_in_pred_mode(sym_name, arity, prog_context,
- pred_or_func_decl_type, eqv_inst_map, maybe(pred_or_func),
- maybe(pred_or_func), list(mode), maybe(inst),
- maybe(inst), maybe(determinism), maybe(determinism),
- equiv_type_info, equiv_type_info, list(eqv_error)).
-:- mode equiv_type__replace_in_pred_mode(in, in, in, in, in, in, out, out,
- in, out, in, out, in, out, out) is det.
+:- pred equiv_type__replace_in_pred_mode(sym_name::in, arity::in,
+ prog_context::in, pred_or_func_decl_type::in, eqv_inst_map::in,
+ maybe(pred_or_func)::in, maybe(pred_or_func)::out,
+ list(mode)::out, maybe(inst)::in, maybe(inst)::out,
+ maybe(determinism)::in, maybe(determinism)::out,
+ equiv_type_info::in, equiv_type_info::out, list(eqv_error)::out)
+ is det.
equiv_type__replace_in_pred_mode(PredName, OrigArity, Context, DeclType,
EqvInstMap, MaybePredOrFunc0, MaybePredOrFunc, ExtraModes,
MaybeWithInst0, MaybeWithInst, Det0, Det,
- Info0, Info, Errors) :-
+ !Info, Errors) :-
(
MaybeWithInst0 = yes(WithInst0),
equiv_type__replace_in_inst(WithInst0, EqvInstMap, WithInst,
- Info0, Info1),
+ !Info),
(
WithInst = ground(_, higher_order(pred_inst_info(
- PredOrFunc, ExtraModes0, Det1))),
+ PredOrFunc, ExtraModes0, DetPrime))),
( MaybePredOrFunc0 = no
; MaybePredOrFunc0 = yes(PredOrFunc)
)
->
- Det = yes(Det1),
+ Det = yes(DetPrime),
MaybeWithInst = no,
MaybePredOrFunc = yes(PredOrFunc),
Errors = [],
@@ -862,15 +815,13 @@
OrigItemId = item_id(
pred_or_func_to_item_type(RecordedPredOrFunc),
PredName - OrigArity),
- equiv_type__record_expanded_item(OrigItemId,
- Info1, Info)
+ equiv_type__record_expanded_item(OrigItemId, !Info)
;
ExtraModes = [],
MaybePredOrFunc = MaybePredOrFunc0,
% Leave the `with_inst` fields so that make_hlds
% knows to discard this declaration.
MaybeWithInst = MaybeWithInst0,
- Info = Info1,
Det = Det0,
Errors = [invalid_with_inst(DeclType, PredName,
MaybePredOrFunc0) - Context]
@@ -879,24 +830,23 @@
MaybeWithInst0 = no,
MaybeWithInst = MaybeWithInst0,
MaybePredOrFunc = MaybePredOrFunc0,
- Info = Info0,
Errors = [],
Det = Det0,
ExtraModes = []
).
-:- pred equiv_type__replace_in_tms(eqv_map,
- list(type_and_mode), list(type_and_mode), tvarset, tvarset,
- equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_tms(in, in, out, in, out, in, out) is det.
+:- pred equiv_type__replace_in_tms(eqv_map::in,
+ list(type_and_mode)::in, list(type_and_mode)::out,
+ tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out)
+ is det.
equiv_type__replace_in_tms(EqvMap, !TMs, !VarSet, !Info) :-
list__map_foldl2(equiv_type__replace_in_tm(EqvMap),
!TMs, !VarSet, !Info).
-:- pred equiv_type__replace_in_tm(eqv_map, type_and_mode, type_and_mode,
- tvarset, tvarset, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_tm(in, in, out, in, out, in, out) is det.
+:- pred equiv_type__replace_in_tm(eqv_map::in,
+ type_and_mode::in, type_and_mode::out, tvarset::in, tvarset::out,
+ equiv_type_info::in, equiv_type_info::out) is det.
equiv_type__replace_in_tm(EqvMap, type_only(Type0),
type_only(Type), !VarSet, !Info) :-
@@ -919,17 +869,15 @@
MaybeInfo = yes(ModuleName - set__init)
).
-:- pred equiv_type__record_expanded_item(item_id,
- equiv_type_info, equiv_type_info).
-:- mode equiv_type__record_expanded_item(in, in, out) is det.
-
-equiv_type__record_expanded_item(Item, Info0, Info) :-
- map_maybe(equiv_type__record_expanded_item_2(Item), Info0, Info).
-
-:- pred equiv_type__record_expanded_item_2(item_id,
- pair(module_name, set(item_id)),
- pair(module_name, set(item_id))).
-:- mode equiv_type__record_expanded_item_2(in, in, out) is det.
+:- pred equiv_type__record_expanded_item(item_id::in,
+ equiv_type_info::in, equiv_type_info::out) is det.
+
+equiv_type__record_expanded_item(Item, !Info) :-
+ map_maybe(equiv_type__record_expanded_item_2(Item), !Info).
+
+:- pred equiv_type__record_expanded_item_2(item_id::in,
+ pair(module_name, set(item_id))::in,
+ pair(module_name, set(item_id))::out) is det.
equiv_type__record_expanded_item_2(ItemId, ModuleName - Items0,
ModuleName - Items) :-
@@ -952,61 +900,62 @@
%-----------------------------------------------------------------------------%
:- pred equiv_type__report_error(eqv_error::in,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
-equiv_type__report_error(circular_equivalence(Item) - Context) -->
+equiv_type__report_error(circular_equivalence(Item) - Context, !IO) :-
(
- { Item = type_defn(_, SymName, Params, TypeDefn, _) },
- { TypeDefn = eqv_type(_) }
+ Item = type_defn(_, SymName, Params, TypeDefn, _),
+ TypeDefn = eqv_type(_)
->
- { Pieces = append_punctuation([
+ Pieces = append_punctuation([
words("Error: circular equivalence type"),
fixed(error_util__describe_sym_name_and_arity(
SymName / length(Params)))
- ], '.') },
- error_util__write_error_pieces(Context, 0, Pieces)
+ ], '.'),
+ error_util__write_error_pieces(Context, 0, Pieces, !IO)
;
- { error("equiv_type__report_error: invalid item") }
+ error("equiv_type__report_error: invalid item")
).
-equiv_type__report_error(invalid_with_type(SymName, PredOrFunc) - Context) -->
- { FirstLine = append_punctuation([words("In type declaration for"),
+equiv_type__report_error(invalid_with_type(SymName, PredOrFunc) - Context,
+ !IO) :-
+ FirstLine = append_punctuation([words("In type declaration for"),
words(error_util__pred_or_func_to_string(PredOrFunc)),
fixed(error_util__describe_sym_name(SymName))
- ], ':') },
- { Rest = [nl, words("error: expected higher order"),
+ ], ':'),
+ Rest = [nl, words("error: expected higher order"),
words(error_util__pred_or_func_to_string(PredOrFunc)),
- words("type after `with_type`.")] },
- error_util__write_error_pieces(Context, 0, FirstLine ++ Rest).
-equiv_type__report_error(invalid_with_inst(DeclType,
- SymName, MaybePredOrFunc) - Context) -->
- { DeclType = type_decl, DeclStr = "declaration"
+ words("type after `with_type`.")],
+ error_util__write_error_pieces(Context, 0, FirstLine ++ Rest, !IO).
+equiv_type__report_error(invalid_with_inst(DeclType, SymName, MaybePredOrFunc)
+ - Context, !IO) :-
+ ( DeclType = type_decl, DeclStr = "declaration"
; DeclType = mode_decl, DeclStr = "mode declaration"
- },
- {
+ ),
+ (
MaybePredOrFunc = no, PredOrFuncStr = ""
;
MaybePredOrFunc = yes(PredOrFunc),
PredOrFuncStr = error_util__pred_or_func_to_string(PredOrFunc)
- },
- { FirstLine = append_punctuation([words("In"), words(DeclStr),
+ ),
+ FirstLine = append_punctuation([words("In"), words(DeclStr),
words("for"),
words(PredOrFuncStr),
fixed(error_util__describe_sym_name(SymName))
- ], ':') },
- { Rest = [nl, words("error: expected higher order "),
+ ], ':'),
+ Rest = [nl, words("error: expected higher order "),
words(PredOrFuncStr),
- words("inst after `with_inst`.")] },
- error_util__write_error_pieces(Context, 0, FirstLine ++ Rest).
-equiv_type__report_error(non_matching_with_type_with_inst(SymName,
- PredOrFunc) - Context) -->
- { FirstLine = append_punctuation([words("In type declaration for"),
+ words("inst after `with_inst`.")],
+ error_util__write_error_pieces(Context, 0, FirstLine ++ Rest, !IO).
+equiv_type__report_error(non_matching_with_type_with_inst(SymName, PredOrFunc)
+ - Context, !IO) :-
+ FirstLine = append_punctuation([words("In type declaration for"),
words(error_util__pred_or_func_to_string(PredOrFunc)),
fixed(error_util__describe_sym_name(SymName))
- ], ':') },
- { Rest = [nl,
+ ], ':'),
+ Rest = [nl,
words("error: the `with_type` and `with_inst`"),
- words("annotations are incompatible.")] },
- error_util__write_error_pieces(Context, 0, FirstLine ++ Rest).
+ words("annotations are incompatible.")],
+ error_util__write_error_pieces(Context, 0, FirstLine ++ Rest, !IO).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/equiv_type_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/equiv_type_hlds.m,v
retrieving revision 1.4
diff -u -b -r1.4 equiv_type_hlds.m
--- compiler/equiv_type_hlds.m 24 Mar 2004 00:39:27 -0000 1.4
+++ compiler/equiv_type_hlds.m 7 Jun 2004 08:49:55 -0000
@@ -701,15 +701,20 @@
; Changed = no, Goal = Goal0
).
replace_in_goal_expr(_, Goal @ call(_, _, _, _, _, _), Goal, no, !Info).
-replace_in_goal_expr(EqvMap, Goal0 @ foreign_proc(_, _, _, _, _, _, _), Goal,
+replace_in_goal_expr(EqvMap, Goal0 @ foreign_proc(_, _, _, _, _, _), Goal,
Changed, !Info) :-
TVarSet0 = !.Info ^ tvarset,
- replace_in_type_list(EqvMap, Goal0 ^ foreign_types, Types,
- Changed, TVarSet0, TVarSet, no, _),
- ( Changed = yes,
+ replace_in_foreign_arg_list(EqvMap, Goal0 ^ foreign_args,
+ Args, ChangedArgs, TVarSet0, TVarSet1, no, _),
+ replace_in_foreign_arg_list(EqvMap, Goal0 ^ foreign_extra_args,
+ ExtraArgs, ChangedExtraArgs, TVarSet1, TVarSet, no, _),
+ ( ( ChangedArgs = yes ; ChangedExtraArgs = yes ) ->
+ Changed = yes,
!:Info = !.Info ^ tvarset := TVarSet,
- Goal = Goal0 ^ foreign_types := Types
- ; Changed = no,
+ Goal = (Goal0 ^ foreign_args := Args)
+ ^ foreign_extra_args := ExtraArgs
+ ;
+ Changed = no,
Goal = Goal0
).
replace_in_goal_expr(EqvMap, Goal0 @ generic_call(A, B, Modes0, D), Goal,
@@ -878,3 +883,41 @@
( Changed = yes, List = [H | T]
; Changed = no, List = List0
).
+
+%-----------------------------------------------------------------------------%
+
+ % Replace equivalence types in a given type.
+ % The bool output is `yes' if anything changed.
+:- pred replace_in_foreign_arg(eqv_map::in,
+ foreign_arg::in, foreign_arg::out, bool::out,
+ tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out)
+ is det.
+
+replace_in_foreign_arg(EqvMap, Arg0, Arg, Changed, !VarSet, !Info) :-
+ Arg0 = foreign_arg(Var, NameMode, Type0),
+ replace_in_type(EqvMap, Type0, Type, Changed, !VarSet, !Info),
+ ( Changed = yes ->
+ Arg = foreign_arg(Var, NameMode, Type)
+ ;
+ Arg = Arg0
+ ).
+
+:- pred replace_in_foreign_arg_list(eqv_map::in,
+ list(foreign_arg)::in, list(foreign_arg)::out, bool::out,
+ tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out)
+ is det.
+
+replace_in_foreign_arg_list(_EqvMap, [], [], no, !VarSet, !Info).
+replace_in_foreign_arg_list(EqvMap, List0 @ [A0 | As0], List,
+ Changed, !VarSet, !Info) :-
+ replace_in_foreign_arg(EqvMap, A0, A, Changed0, !VarSet, !Info),
+ replace_in_foreign_arg_list(EqvMap, As0, As, Changed1, !VarSet, !Info),
+ ( ( Changed0 = yes ; Changed1 = yes ) ->
+ Changed = yes,
+ List = [A | As]
+ ;
+ Changed = no,
+ List = List0
+ ).
+
+%-----------------------------------------------------------------------------%
Index: compiler/exprn_aux.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/exprn_aux.m,v
retrieving revision 1.51
diff -u -b -r1.51 exprn_aux.m
--- compiler/exprn_aux.m 23 May 2004 23:14:26 -0000 1.51
+++ compiler/exprn_aux.m 7 Jun 2004 08:49:55 -0000
@@ -456,12 +456,12 @@
;
Uinstr0 = pragma_c(Decls, Components0, MayCallMercury,
MaybeLabel1, MaybeLabel2, MaybeLabel3, MaybeLabel4,
- ReferStackSlot),
+ ReferStackSlot, MayDupl),
list__map_foldl(exprn_aux__substitute_lval_in_component(
OldLval, NewLval), Components0, Components, N0, N),
Uinstr = pragma_c(Decls, Components, MayCallMercury,
MaybeLabel1, MaybeLabel2, MaybeLabel3, MaybeLabel4,
- ReferStackSlot)
+ ReferStackSlot, MayDupl)
;
Uinstr0 = init_sync_term(Lval0, BranchCount),
exprn_aux__substitute_lval_in_lval_count(OldLval, NewLval,
Index: compiler/follow_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/follow_code.m,v
retrieving revision 1.68
diff -u -b -r1.68 follow_code.m
--- compiler/follow_code.m 5 Apr 2004 05:06:47 -0000 1.68
+++ compiler/follow_code.m 7 Jun 2004 08:49:55 -0000
@@ -94,43 +94,30 @@
move_follow_code_in_goal_2(conj(Goals0), conj(Goals), Flags, !R) :-
move_follow_code_in_conj(Goals0, Goals, Flags, !R).
-
move_follow_code_in_goal_2(par_conj(Goals0), par_conj(Goals), Flags, !R) :-
% move_follow_code_in_disj treats its list of goals as
% independent goals, so we can use it to process the
% independent parallel conjuncts.
move_follow_code_in_disj(Goals0, Goals, Flags, !R).
-
move_follow_code_in_goal_2(disj(Goals0), disj(Goals), Flags, !R) :-
move_follow_code_in_disj(Goals0, Goals, Flags, !R).
-
move_follow_code_in_goal_2(not(Goal0), not(Goal), Flags, !R) :-
move_follow_code_in_goal(Goal0, Goal, Flags, !R).
-
move_follow_code_in_goal_2(switch(Var, Det, Cases0),
switch(Var, Det, Cases), Flags, !R) :-
move_follow_code_in_cases(Cases0, Cases, Flags, !R).
-
move_follow_code_in_goal_2(if_then_else(Vars, Cond0, Then0, Else0),
if_then_else(Vars, Cond, Then, Else), Flags, !R) :-
move_follow_code_in_goal(Cond0, Cond, Flags, !R),
move_follow_code_in_goal(Then0, Then, Flags, !R),
move_follow_code_in_goal(Else0, Else, Flags, !R).
-
move_follow_code_in_goal_2(some(Vars, CanRemove, Goal0),
some(Vars, CanRemove, Goal), Flags, !R) :-
move_follow_code_in_goal(Goal0, Goal, Flags, !R).
-
-move_follow_code_in_goal_2(generic_call(A,B,C,D),
- generic_call(A,B,C,D), _, R, R).
-
-move_follow_code_in_goal_2(call(A,B,C,D,E,F), call(A,B,C,D,E,F), _, R, R).
-
-move_follow_code_in_goal_2(unify(A,B,C,D,E), unify(A,B,C,D,E), _, R, R).
-
-move_follow_code_in_goal_2(foreign_proc(A,B,C,D,E,F,G),
- foreign_proc(A,B,C,D,E,F,G), _, R, R).
-
+move_follow_code_in_goal_2(Goal @ generic_call(_, _, _, _), Goal, _, !R).
+move_follow_code_in_goal_2(Goal @ call(_, _, _, _, _, _), Goal, _, !R).
+move_follow_code_in_goal_2(Goal @ unify(_, _, _, _, _), Goal, _, !R).
+move_follow_code_in_goal_2(Goal @ foreign_proc(_, _, _, _, _, _), Goal, _, !R).
move_follow_code_in_goal_2(shorthand(_), _, _, _, _) :-
% these should have been expanded out by now
error("move_follow_code_in_goal_2: unexpected shorthand").
@@ -153,7 +140,7 @@
:- pred move_follow_code_in_cases(list(case)::in, list(case)::out,
pair(bool)::in, bool::in, bool::out) is det.
-move_follow_code_in_cases([], [], _, R, R).
+move_follow_code_in_cases([], [], _, !R).
move_follow_code_in_cases([case(Cons, Goal0)|Goals0], [case(Cons, Goal)|Goals],
Flags, !R) :-
move_follow_code_in_goal(Goal0, Goal, Flags, !R),
Index: compiler/follow_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/follow_vars.m,v
retrieving revision 1.68
diff -u -b -r1.68 follow_vars.m
--- compiler/follow_vars.m 10 Apr 2004 10:33:01 -0000 1.68
+++ compiler/follow_vars.m 7 Jun 2004 08:49:55 -0000
@@ -195,11 +195,11 @@
find_follow_vars_in_goal(Goal0, Goal, VarTypes, ModuleInfo,
!FollowVarsMap, !NextNonReserved).
-find_follow_vars_in_goal_expr(unify(A,B,C,D,E), unify(A,B,C,D,E),
+find_follow_vars_in_goal_expr(Goal @ unify(_, _, _, Unify, _), Goal,
GoalInfo, GoalInfo, _VarTypes, _ModuleInfo,
!FollowVarsMap, !NextNonReserved) :-
(
- D = assign(LVar, RVar),
+ Unify = assign(LVar, RVar),
map__search(!.FollowVarsMap, LVar, DesiredLoc)
->
map__set(!.FollowVarsMap, RVar, DesiredLoc, !:FollowVarsMap)
@@ -207,9 +207,8 @@
true
).
-find_follow_vars_in_goal_expr(foreign_proc(A,B,C,D,E,F,G),
- foreign_proc(A,B,C,D,E,F,G), GoalInfo, GoalInfo,
- _, _, !FollowVarsMap, !NextNonReserved).
+find_follow_vars_in_goal_expr(Goal @ foreign_proc(_, _, _, _, _, _), Goal,
+ GoalInfo, GoalInfo, _, _, !FollowVarsMap, !NextNonReserved).
find_follow_vars_in_goal_expr(shorthand(_), _, _, _, _, _, _, _, _, _) :-
% these should have been expanded out by now
Index: compiler/frameopt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/frameopt.m,v
retrieving revision 1.85
diff -u -b -r1.85 frameopt.m
--- compiler/frameopt.m 23 May 2004 23:14:26 -0000 1.85
+++ compiler/frameopt.m 7 Jun 2004 08:49:55 -0000
@@ -662,7 +662,7 @@
;
Uinstr = pragma_c(_, _, MayCallMercury,
_, MaybeLayout, MaybeOnlyLayout, _,
- NeedStack),
+ NeedStack, _),
(
MayCallMercury = may_call_mercury
;
@@ -799,7 +799,7 @@
;
% Only may_call_mercury pragma_c's can clobber succip.
Uinstr = pragma_c(_, _, may_call_mercury,
- _, _, _, _, _)
+ _, _, _, _, _, _)
)
->
CanClobberSuccip = yes
Index: compiler/goal_form.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_form.m,v
retrieving revision 1.8
diff -u -b -r1.8 goal_form.m
--- compiler/goal_form.m 23 Mar 2004 10:52:03 -0000 1.8
+++ compiler/goal_form.m 7 Jun 2004 08:49:55 -0000
@@ -223,7 +223,7 @@
goal_is_flat_expr(generic_call(_, _, _, _)).
goal_is_flat_expr(call(_, _, _, _, _, _)).
goal_is_flat_expr(unify(_, _, _, _, _)).
-goal_is_flat_expr(foreign_proc(_, _, _, _, _, _, _)).
+goal_is_flat_expr(foreign_proc(_, _, _, _, _, _)).
:- pred goal_is_flat_list(list(hlds_goal)::in) is semidet.
@@ -265,7 +265,7 @@
% expand to incr_hp and variants thereof.
% XXX although you could make it an attribute of the foreign code and
% trust the programmer
-goal_may_allocate_heap_2(foreign_proc(_,_,_,_,_,_,_), yes).
+goal_may_allocate_heap_2(foreign_proc(_, _, _, _, _, _), yes).
goal_may_allocate_heap_2(some(_Vars, _, Goal), May) :-
goal_may_allocate_heap(Goal, May).
goal_may_allocate_heap_2(not(Goal), May) :-
@@ -424,7 +424,7 @@
count_recursive_calls(Goal, PredId, ProcId, Min, Max).
count_recursive_calls_2(unify(_, _, _, _, _), _, _, 0, 0).
count_recursive_calls_2(generic_call(_, _, _, _), _, _, 0, 0).
-count_recursive_calls_2(foreign_proc(_, _, _, _, _, _, _), _, _, 0, 0).
+count_recursive_calls_2(foreign_proc(_, _, _, _, _, _), _, _, 0, 0).
count_recursive_calls_2(call(CallPredId, CallProcId, _, _, _, _),
PredId, ProcId, Count, Count) :-
(
Index: compiler/goal_path.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_path.m,v
retrieving revision 1.19
diff -u -b -r1.19 goal_path.m
--- compiler/goal_path.m 24 Oct 2003 06:17:38 -0000 1.19
+++ compiler/goal_path.m 7 Jun 2004 08:49:55 -0000
@@ -90,11 +90,10 @@
fill_goal_slots(Cond0, [ite_cond | Path0], SlotInfo, Cond),
fill_goal_slots(Then0, [ite_then | Path0], SlotInfo, Then),
fill_goal_slots(Else0, [ite_else | Path0], SlotInfo, Else).
-fill_expr_slots(call(A,B,C,D,E,F), _, _, _, call(A,B,C,D,E,F)).
-fill_expr_slots(generic_call(A,B,C,D), _, _, _, generic_call(A,B,C,D)).
-fill_expr_slots(unify(A,B,C,D,E), _, _, _, unify(A,B,C,D,E)).
-fill_expr_slots(foreign_proc(A,B,C,D,E,F,G), _, _, _,
- foreign_proc(A,B,C,D,E,F,G)).
+fill_expr_slots(Goal @ call(_, _, _, _, _, _), _, _, _, Goal).
+fill_expr_slots(Goal @ generic_call(_, _, _, _), _, _, _, Goal).
+fill_expr_slots(Goal @ unify(_, _, _, _, _), _, _, _, Goal).
+fill_expr_slots(Goal @ foreign_proc(_, _, _, _, _, _), _, _, _, Goal).
fill_expr_slots(shorthand(_), _, _, _, _) :-
% these should have been expanded out by now
error("fill_expr_slots: unexpected shorthand").
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.93
diff -u -b -r1.93 goal_util.m
--- compiler/goal_util.m 21 Dec 2003 05:04:33 -0000 1.93
+++ compiler/goal_util.m 7 Jun 2004 08:49:55 -0000
@@ -196,9 +196,10 @@
:- pred goal_util__reordering_maintains_termination(module_info::in, bool::in,
hlds_goal::in, hlds_goal::in) is semidet.
- % generate_simple_call(ModuleName, ProcName, PredOrFunc, Args, ModeNo,
- % Detism, MaybeFeature, InstMapDelta,
- % ModuleInfo, Context, CallGoal):
+ % generate_simple_call(ModuleName, ProcName, PredOrFunc, ModeNo,
+ % Detism, Args, MaybeFeature, InstMapDelta, ModuleInfo, Context,
+ % CallGoal):
+ %
% Generate a call to a builtin procedure (e.g.
% from the private_builtin or table_builtin module).
% This is used by HLDS->HLDS transformation passes that introduce
@@ -211,10 +212,31 @@
% from 0.
%
:- pred goal_util__generate_simple_call(module_name::in, string::in,
- pred_or_func::in, list(prog_var)::in, mode_no::in, determinism::in,
+ pred_or_func::in, mode_no::in, determinism::in, list(prog_var)::in,
maybe(goal_feature)::in, assoc_list(prog_var, inst)::in,
module_info::in, term__context::in, hlds_goal::out) is det.
+ % generate_foreign_proc(ModuleName, ProcName, PredOrFunc,
+ % ModeNo, Detism, Attributes, Args, ExtraArgs, PrefixCode, Code,
+ % SuffixCode, MaybeFeature, InstMapDelta, ModuleInfo, Context,
+ % CallGoal):
+ %
+ % generate_foreign_proc is similar to generate_simple_call,
+ % but also assumes that the called predicate is defined via a
+ % foreign_proc, that the foreign_proc's arguments are as given in
+ % Args, its attributes are Attributes, and its code is Code.
+ % As well as returning a foreign_code instead of a call, effectively
+ % inlining the call, generate_foreign_proc also puts PrefixCode
+ % before Code, SuffixCode after Code, and passes ExtraArgs as well
+ % as Args.
+ %
+:- pred goal_util__generate_foreign_proc(module_name::in, string::in,
+ pred_or_func::in, mode_no::in, determinism::in,
+ pragma_foreign_proc_attributes::in,
+ list(foreign_arg)::in, list(foreign_arg)::in, string::in, string::in,
+ string::in, maybe(goal_feature)::in, assoc_list(prog_var, inst)::in,
+ module_info::in, term__context::in, hlds_goal::out) is det.
+
:- pred goal_util__generate_unsafe_cast(prog_var::in, prog_var::in,
prog_context::in, hlds_goal::out) is det.
@@ -373,21 +395,24 @@
call(PredId, ProcId, Args, Builtin, Context, Sym)) :-
goal_util__rename_var_list(Args0, Must, Subn, Args).
-goal_util__rename_vars_in_goal_expr(unify(TermL0,TermR0,Mode,Unify0,Context),
- Must, Subn, unify(TermL,TermR,Mode,Unify,Context)) :-
- goal_util__rename_var(TermL0, Must, Subn, TermL),
- goal_util__rename_unify_rhs(TermR0, Must, Subn, TermR),
+goal_util__rename_vars_in_goal_expr(unify(LHS0, RHS0, Mode, Unify0, Context),
+ Must, Subn, unify(LHS, RHS, Mode, Unify, Context)) :-
+ goal_util__rename_var(LHS0, Must, Subn, LHS),
+ goal_util__rename_unify_rhs(RHS0, Must, Subn, RHS),
goal_util__rename_unify(Unify0, Must, Subn, Unify).
-goal_util__rename_vars_in_goal_expr(foreign_proc(A,B,C,Vars0,E,F,G),
- Must, Subn, foreign_proc(A,B,C,Vars,E,F,G)) :-
- goal_util__rename_var_list(Vars0, Must, Subn, Vars).
+goal_util__rename_vars_in_goal_expr(foreign_proc(A,B,C,Args0,Extra0,F),
+ Must, Subn, foreign_proc(A,B,C,Args,Extra,F)) :-
+ goal_util__rename_arg_list(Args0, Must, Subn, Args),
+ goal_util__rename_arg_list(Extra0, Must, Subn, Extra).
goal_util__rename_vars_in_goal_expr(shorthand(ShorthandGoal0), Must, Subn,
shorthand(ShrothandGoal)) :-
goal_util__rename_vars_in_shorthand(ShorthandGoal0, Must, Subn,
ShrothandGoal).
+%-----------------------------------------------------------------------------%
+
:- pred goal_util__rename_vars_in_shorthand(shorthand_goal_expr::in, bool::in,
map(prog_var, prog_var)::in, shorthand_goal_expr::out) is det.
@@ -398,6 +423,23 @@
%-----------------------------------------------------------------------------%
+:- pred goal_util__rename_arg_list(list(foreign_arg)::in, bool::in,
+ map(prog_var, prog_var)::in, list(foreign_arg)::out) is det.
+
+goal_util__rename_arg_list([], _Must, _Subn, []).
+goal_util__rename_arg_list([Arg0 | Args0], Must, Subn, [Arg | Args]) :-
+ goal_util__rename_arg(Arg0, Must, Subn, Arg),
+ goal_util__rename_arg_list(Args0, Must, Subn, Args).
+
+:- pred goal_util__rename_arg(foreign_arg::in, bool::in,
+ map(prog_var, prog_var)::in, foreign_arg::out) is det.
+
+goal_util__rename_arg(foreign_arg(Var0, B, C), Must, Subn,
+ foreign_arg(Var, B, C)) :-
+ goal_util__rename_var(Var0, Must, Subn, Var).
+
+%-----------------------------------------------------------------------------%
+
:- pred goal_util__rename_vars_in_cases(list(case)::in, bool::in,
map(prog_var, prog_var)::in, list(case)::out) is det.
@@ -592,8 +634,10 @@
goal_util__goal_vars_2(B, !Set),
goal_util__goal_vars_2(C, !Set).
-goal_util__goal_vars_2(foreign_proc(_, _, _, ArgVars, _, _, _), !Set) :-
- set__insert_list(!.Set, ArgVars, !:Set).
+goal_util__goal_vars_2(foreign_proc(_, _, _, Args, ExtraArgs, _), !Set) :-
+ ArgVars = list__map(foreign_arg_var, Args),
+ ExtraVars = list__map(foreign_arg_var, ExtraArgs),
+ set__insert_list(!.Set, list__append(ArgVars, ExtraVars), !:Set).
goal_util__goal_vars_2(shorthand(ShorthandGoal), !Set) :-
goal_util__goal_vars_2_shorthand(ShorthandGoal, !Set).
@@ -742,7 +786,7 @@
goal_expr_size(call(_, _, _, _, _, _), 1).
goal_expr_size(generic_call(_, _, _, _), 1).
goal_expr_size(unify(_, _, _, _, _), 1).
-goal_expr_size(foreign_proc(_, _, _, _, _, _, _), 1).
+goal_expr_size(foreign_proc(_, _, _, _, _, _), 1).
goal_expr_size(shorthand(ShorthandGoal), Size) :-
goal_expr_size_shorthand(ShorthandGoal, Size).
@@ -1170,42 +1214,76 @@
%-----------------------------------------------------------------------------%
-goal_util__generate_simple_call(ModuleName, ProcName, PredOrFunc, Args, ModeNo,
- Detism, MaybeFeature, InstMap, Module, Context, CallGoal) :-
+goal_util__generate_simple_call(ModuleName, ProcName, PredOrFunc, ModeNo,
+ Detism, Args, MaybeFeature, InstMap, ModuleInfo, Context,
+ Goal) :-
list__length(Args, Arity),
- lookup_builtin_pred_proc_id(Module, ModuleName, ProcName, PredOrFunc,
- Arity, ModeNo, PredId, ProcId),
+ lookup_builtin_pred_proc_id(ModuleInfo, ModuleName, ProcName,
+ PredOrFunc, Arity, ModeNo, PredId, ProcId),
% builtin_state only uses this to work out whether
% this is the "recursive" clause generated for the compiler
% for each builtin, so an invalid pred_id won't cause problems.
InvalidPredId = invalid_pred_id,
- BuiltinState = builtin_state(Module, InvalidPredId, PredId, ProcId),
+ BuiltinState = builtin_state(ModuleInfo, InvalidPredId,
+ PredId, ProcId),
- Call = call(PredId, ProcId, Args, BuiltinState, no,
+ GoalExpr = call(PredId, ProcId, Args, BuiltinState, no,
qualified(ModuleName, ProcName)),
set__init(NonLocals0),
set__insert_list(NonLocals0, Args, NonLocals),
determinism_components(Detism, _CanFail, NumSolns),
+ ( NumSolns = at_most_zero ->
+ instmap_delta_init_unreachable(InstMapDelta)
+ ;
+ instmap_delta_from_assoc_list(InstMap, InstMapDelta)
+ ),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_get_purity(PredInfo, Purity),
+ goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context,
+ GoalInfo0),
(
- NumSolns = at_most_zero
- ->
+ MaybeFeature = yes(Feature),
+ goal_info_add_feature(GoalInfo0, Feature, GoalInfo)
+ ;
+ MaybeFeature = no,
+ GoalInfo = GoalInfo0
+ ),
+ Goal = GoalExpr - GoalInfo.
+
+goal_util__generate_foreign_proc(ModuleName, ProcName, PredOrFunc, ModeNo,
+ Detism, Attributes, Args, ExtraArgs, PrefixCode, Code,
+ SuffixCode, MaybeFeature, InstMap, ModuleInfo, Context,
+ Goal) :-
+ list__length(Args, Arity),
+ lookup_builtin_pred_proc_id(ModuleInfo, ModuleName, ProcName,
+ PredOrFunc, Arity, ModeNo, PredId, ProcId),
+
+ AllCode = PrefixCode ++ Code ++ SuffixCode,
+ GoalExpr = foreign_proc(Attributes, PredId, ProcId, Args, ExtraArgs,
+ ordinary(AllCode, no)),
+ ArgVars = list__map(foreign_arg_var, Args),
+ ExtraArgVars = list__map(foreign_arg_var, ExtraArgs),
+ Vars = ArgVars ++ ExtraArgVars,
+ set__list_to_set(Vars, NonLocals),
+ determinism_components(Detism, _CanFail, NumSolns),
+ ( NumSolns = at_most_zero ->
instmap_delta_init_unreachable(InstMapDelta)
;
instmap_delta_from_assoc_list(InstMap, InstMapDelta)
),
- module_info_pred_info(Module, PredId, PredInfo),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_get_purity(PredInfo, Purity),
goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context,
- CallGoalInfo0),
+ GoalInfo0),
(
MaybeFeature = yes(Feature),
- goal_info_add_feature(CallGoalInfo0, Feature, CallGoalInfo)
+ goal_info_add_feature(GoalInfo0, Feature, GoalInfo)
;
MaybeFeature = no,
- CallGoalInfo = CallGoalInfo0
+ GoalInfo = GoalInfo0
),
- CallGoal = Call - CallGoalInfo.
+ Goal = GoalExpr - GoalInfo.
generate_unsafe_cast(InArg, OutArg, Context, Goal) :-
set__list_to_set([InArg, OutArg], NonLocals),
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.117
diff -u -b -r1.117 higher_order.m
--- compiler/higher_order.m 20 May 2004 22:18:31 -0000 1.117
+++ compiler/higher_order.m 7 Jun 2004 08:49:55 -0000
@@ -4,7 +4,6 @@
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
-:- module transform_hlds__higher_order.
% Main author: stayl
%
% Specializes calls to higher order or polymorphic predicates where the value
@@ -23,6 +22,8 @@
% is a number that uniquely identifies this specialized version.
%-------------------------------------------------------------------------------
+:- module transform_hlds__higher_order.
+
:- interface.
:- import_module hlds__hlds_module.
@@ -30,7 +31,7 @@
:- import_module io.
:- pred specialize_higher_order(module_info::in, module_info::out,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
%-------------------------------------------------------------------------------
@@ -133,8 +134,7 @@
% Process one lot of requests, returning requests for any
% new specializations made possible by the first lot.
:- pred process_requests(higher_order_global_info::in,
- higher_order_global_info::out,
- io__state::di, io__state::uo) is det.
+ higher_order_global_info::out, io::di, io::uo) is det.
process_requests(Info0, Info) -->
filter_requests(Requests, LoopRequests, Info0, Info1),
@@ -164,7 +164,7 @@
% Process requests until there are no new requests to process.
:- pred recursively_process_requests(higher_order_global_info::in,
- higher_order_global_info::out, io__state::di, io__state::uo) is det.
+ higher_order_global_info::out, io::di, io::uo) is det.
recursively_process_requests(Info0, Info) -->
( { set__empty(Info0 ^ requests) } ->
@@ -178,18 +178,21 @@
:- type higher_order_global_info
---> higher_order_global_info(
- requests :: set(request), % Requested versions.
+ requests :: set(request),
+ % Requested versions.
new_preds :: new_preds,
% Specialized versions for
% each predicate not changed
% by traverse_goal
- version_info :: map(pred_proc_id, version_info),
+ version_info :: map(pred_proc_id,
+ version_info),
% Extra information about
% each specialized version.
module_info :: module_info,
goal_sizes :: goal_sizes,
ho_params :: ho_params,
- next_higher_order_id :: int % Number identifying
+ next_higher_order_id :: int
+ % Number identifying
% a specialized version.
).
@@ -197,13 +200,17 @@
:- type higher_order_info
---> higher_order_info(
global_info :: higher_order_global_info,
- pred_vars :: pred_vars, % higher_order variables
+ pred_vars :: pred_vars,
+ % higher_order variables
pred_proc_id :: pred_proc_id,
- % pred_proc_id of goal being traversed
+ % pred_proc_id of goal being
+ % traversed
pred_info :: pred_info,
- % pred_info of goal being traversed
+ % pred_info of goal being
+ % traversed
proc_info :: proc_info,
- % proc_info of goal being traversed
+ % proc_info of goal being
+ % traversed
changed :: changed
).
@@ -498,7 +505,7 @@
traverse_goal_2(Goal0, Goal).
traverse_goal_2(Goal, Goal) -->
- { Goal = foreign_proc(_, _, _, _, _, _, _) - _ }.
+ { Goal = foreign_proc(_, _, _, _, _, _) - _ }.
traverse_goal_2(Goal0, Goal) -->
{ Goal0 = GoalExpr0 - _ },
@@ -2259,7 +2266,7 @@
% this can create ridiculous numbers of versions.
:- pred filter_requests(list(request)::out, list(request)::out,
higher_order_global_info::in, higher_order_global_info::out,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
filter_requests(FilteredRequests, LoopRequests, Info0, Info) -->
{ Requests0 = set__to_sorted_list(Info0 ^ requests) },
@@ -2269,7 +2276,7 @@
:- pred filter_requests_2(higher_order_global_info::in, request::in,
pair(list(request))::in, pair(list(request))::out,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
filter_requests_2(Info, Request, AcceptedRequests0 - LoopRequests0,
AcceptedRequests - LoopRequests) -->
@@ -2369,7 +2376,7 @@
:- pred create_new_preds(list(request)::in, list(new_pred)::in,
list(new_pred)::out, set(pred_proc_id)::in, set(pred_proc_id)::out,
higher_order_global_info::in, higher_order_global_info::out,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
create_new_preds([], NewPredList, NewPredList, ToFix, ToFix,
Info, Info, IO, IO).
@@ -2433,7 +2440,7 @@
% Here we create the pred_info for the new predicate.
:- pred create_new_pred(request::in, new_pred::out,
higher_order_global_info::in, higher_order_global_info::out,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
create_new_pred(Request, NewPred, !Info, !IO) :-
Request = request(Caller, CalledPredProc, CallArgs, ExtraTypeInfoTVars,
@@ -2547,8 +2554,7 @@
:- pred maybe_write_request(bool::in, module_info::in, string::in,
sym_name::in, arity::in, arity::in, maybe(string)::in,
- list(higher_order_arg)::in, prog_context::in,
- io__state::di, io__state::uo) is det.
+ list(higher_order_arg)::in, prog_context::in, io::di, io::uo) is det.
maybe_write_request(no, _, _, _, _, _, _, _, _) --> [].
maybe_write_request(yes, ModuleInfo, Msg, SymName,
@@ -2570,7 +2576,7 @@
output_higher_order_args(ModuleInfo, NumToDrop, 0, HOArgs).
:- pred output_higher_order_args(module_info::in, int::in, int::in,
- list(higher_order_arg)::in, io__state::di, io__state::uo) is det.
+ list(higher_order_arg)::in, io::di, io::uo) is det.
output_higher_order_args(_, _, _, []) --> [].
output_higher_order_args(ModuleInfo, NumToDrop, Indent, [HOArg | HOArgs]) -->
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.115
diff -u -b -r1.115 hlds_goal.m
--- compiler/hlds_goal.m 19 May 2004 03:59:12 -0000 1.115
+++ compiler/hlds_goal.m 7 Jun 2004 08:49:55 -0000
@@ -165,21 +165,9 @@
% The called predicate
foreign_proc_id :: proc_id,
% The mode of the predicate
- foreign_args :: list(prog_var),
- % The (Mercury) argument variables
- foreign_names :: list(maybe(pair(string, mode))),
- % Foreign variable names and the
- % original mode declaration for each
- % of the arguments. A no for a
- % particular argument means that it is
- % not used by the foreign code. (In
- % particular, the type_info variables
- % introduced by polymorphism.m might
- % be represented in this way).
- foreign_types :: list(type),
- % The original types of the arguments.
- % (With inlining, the actual types may
- % be instances of the original types.)
+ foreign_args :: list(foreign_arg),
+ foreign_extra_args :: list(foreign_arg),
+ % XXX
foreign_impl :: pragma_foreign_code_impl
% Extra information for model_non
% pragma_foreign_codes; none for others.
@@ -211,6 +199,62 @@
%-----------------------------------------------------------------------------%
%
+% Information for calls
+%
+
+ % There may be two sorts of "builtin" predicates - those that we
+ % open-code using inline instructions (e.g. arithmetic predicates),
+ % and those which are still "internal", but for which we generate
+ % a call to an out-of-line procedure. At the moment there are no
+ % builtins of the second sort, although we used to handle call/N
+ % that way.
+
+:- type builtin_state
+ ---> inline_builtin
+ ; out_of_line_builtin
+ ; not_builtin.
+
+%-----------------------------------------------------------------------------%
+%
+% Information for foreign_proc
+%
+
+ % In the usual case, the arguments of a foreign_proc are the
+ % arguments of the call to the predicate whose implementation
+ % is in the foreign language. Each such argument is described
+ % by a foreign_arg.
+ %
+ % The arg_var field gives the identity of the actual parameter.
+ %
+ % The arg_name_mode field gives the foreign variable name and the
+ % original mode declaration for the argument; a no means that the
+ % argument is not used by the foreign code. (In particular, the
+ % type_info variables introduced by polymorphism.m might be
+ % represented in this way).
+ %
+ % The arg_type field gives the original types of the arguments.
+ % (With inlining, the actual types may be instances of the original
+ % types.)
+
+:- type foreign_arg
+ ---> foreign_arg(
+ arg_var :: prog_var,
+ arg_name_mode :: maybe(pair(string, mode)),
+ arg_type :: (type)
+ ).
+
+ % Some compiler transforms give to XXX
+
+:- func foreign_arg_var(foreign_arg) = prog_var.
+:- func foreign_arg_maybe_name_mode(foreign_arg) = maybe(pair(string, mode)).
+:- func foreign_arg_type(foreign_arg) = (type).
+
+:- pred make_foreign_args(list(prog_var)::in,
+ list(maybe(pair(string, mode)))::in, list(type)::in,
+ list(foreign_arg)::out) is det.
+
+%-----------------------------------------------------------------------------%
+%
% Information for generic_calls
%
@@ -249,56 +293,6 @@
%-----------------------------------------------------------------------------%
%
-% Information for quantifications
-%
-
- % The second argument of explicit quantification goals
- % is `can_remove' if the quantification is allowed to
- % be removed. A non-removable explicit
- % quantification may be introduced to keep related goals
- % together where optimizations that separate the goals
- % can only result in worse behaviour. An example is the
- % closures for the builtin aditi update predicates -
- % they should be kept close to the update call where
- % possible to make it easier to use indexes for the update.
- %
- % See also the closely related `keep_this_commit' goal_feature.
- % XXX Why do we have both cannot_remove and keep_this_commit?
- % Do we really need both?
-:- type can_remove
- ---> can_remove
- ; cannot_remove.
-
-%-----------------------------------------------------------------------------%
-%
-% Information for calls
-%
-
- % There may be two sorts of "builtin" predicates - those that we
- % open-code using inline instructions (e.g. arithmetic predicates),
- % and those which are still "internal", but for which we generate
- % a call to an out-of-line procedure. At the moment there are no
- % builtins of the second sort, although we used to handle call/N
- % that way.
-
-:- type builtin_state
- ---> inline_builtin
- ; out_of_line_builtin
- ; not_builtin.
-
-%-----------------------------------------------------------------------------%
-%
-% Information for switches
-%
-
-:- type case
- ---> case(
- cons_id, % functor to match with,
- hlds_goal % goal to execute if match succeeds.
- ).
-
-%-----------------------------------------------------------------------------%
-%
% Information for unifications
%
@@ -617,6 +611,39 @@
%-----------------------------------------------------------------------------%
%
+% Information for switches
+%
+
+:- type case
+ ---> case(
+ cons_id, % functor to match with,
+ hlds_goal % goal to execute if match succeeds.
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Information for quantifications
+%
+
+ % The second argument of explicit quantification goals
+ % is `can_remove' if the quantification is allowed to
+ % be removed. A non-removable explicit
+ % quantification may be introduced to keep related goals
+ % together where optimizations that separate the goals
+ % can only result in worse behaviour. An example is the
+ % closures for the builtin aditi update predicates -
+ % they should be kept close to the update call where
+ % possible to make it easier to use indexes for the update.
+ %
+ % See also the closely related `keep_this_commit' goal_feature.
+ % XXX Why do we have both cannot_remove and keep_this_commit?
+ % Do we really need both?
+:- type can_remove
+ ---> can_remove
+ ; cannot_remove.
+
+%-----------------------------------------------------------------------------%
+%
% Information for all kinds of goals
%
@@ -1078,6 +1105,32 @@
:- import_module map, require, string, term, varset.
%-----------------------------------------------------------------------------%
+
+foreign_arg_var(Arg) = Arg ^ arg_var.
+foreign_arg_maybe_name_mode(Arg) = Arg ^ arg_name_mode.
+foreign_arg_type(Arg) = Arg ^ arg_type.
+
+make_foreign_args(Vars, NamesModes, Types, Args) :-
+ (
+ Vars = [Var | VarsTail],
+ NamesModes = [NameMode | NamesModesTail],
+ Types = [Type | TypesTail]
+ ->
+ make_foreign_args(VarsTail, NamesModesTail, TypesTail,
+ ArgsTail),
+ Arg = foreign_arg(Var, NameMode, Type),
+ Args = [Arg | ArgsTail]
+ ;
+ Vars = [],
+ NamesModes = [],
+ Types = []
+ ->
+ Args = []
+ ;
+ error("make_foreign_args: unmatched lists")
+ ).
+
+%-----------------------------------------------------------------------------%
%
% Predicates dealing with generic_calls
%
@@ -1512,7 +1565,7 @@
HasForeign = no
)
;
- GoalExpr = foreign_proc(_, _, _, _, _, _, _),
+ GoalExpr = foreign_proc(_, _, _, _, _, _),
HasForeign = yes
;
GoalExpr = par_conj(Goals),
@@ -1549,7 +1602,7 @@
goal_is_atomic(generic_call(_,_,_,_)).
goal_is_atomic(call(_,_,_,_,_,_)).
goal_is_atomic(unify(_,_,_,_,_)).
-goal_is_atomic(foreign_proc(_,_,_,_,_,_,_)).
+goal_is_atomic(foreign_proc(_,_,_,_,_,_)).
%-----------------------------------------------------------------------------%
@@ -1644,7 +1697,7 @@
set_goal_contexts_2(_, Goal, Goal) :-
Goal = unify(_, _, _, _, _).
set_goal_contexts_2(_, Goal, Goal) :-
- Goal = foreign_proc(_, _, _, _, _, _, _).
+ Goal = foreign_proc(_, _, _, _, _, _).
set_goal_contexts_2(Context, shorthand(ShorthandGoal0),
shorthand(ShorthandGoal)) :-
set_goal_contexts_2_shorthand(Context, ShorthandGoal0,
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.98
diff -u -b -r1.98 hlds_module.m
--- compiler/hlds_module.m 5 Apr 2004 05:06:48 -0000 1.98
+++ compiler/hlds_module.m 7 Jun 2004 08:49:55 -0000
@@ -1990,13 +1990,13 @@
(
PredOrFunc = predicate,
predicate_table_search_pred_m_n_a(PredTable,
- is_fully_qualified, ModuleName, ProcName, Arity,
- [PredId0])
+ is_fully_qualified, ModuleName, ProcName,
+ Arity, [PredId0])
;
PredOrFunc = function,
predicate_table_search_func_m_n_a(PredTable,
- is_fully_qualified, ModuleName, ProcName, Arity,
- [PredId0])
+ is_fully_qualified, ModuleName, ProcName,
+ Arity, [PredId0])
)
->
PredId = PredId0
--------------------------------------------------------------------------
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