[m-dev.] diff: extras/trailed_update enhancements + bug fixes
Fergus Henderson
fjh at cs.mu.oz.au
Tue Oct 7 15:30:41 AEST 1997
Tyson Richard DOWD, you wrote:
> Fergus Henderson wrote:
> >
> > Various bug fixes and enhancements to var.m and other stuff in
> > extras/trailed_update.
>
> Fergus, either my mail got chopped and your signature was lopped onto
> the end, or you forgot to include the diff (again ;-).
Oops, I'm getting good at that ;-)
cvs diff: Diffing .
Index: Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/mercury/extras/trailed_update/Mmakefile,v
retrieving revision 1.1
diff -u -u -r1.1 Mmakefile
--- Mmakefile 1997/09/11 06:55:04 1.1
+++ Mmakefile 1997/10/06 16:25:08
@@ -1,6 +1,11 @@
GRADE = asm_fast.gc.tr
RM_C = :
+MGNUCFLAGS = -g
+MLFLAGS = -g
MAIN_TARGET = libtrailed_update
depend : trailed_update.depend
+
+# We need this to use shared libraries on Linux
+ML = ml --mercury-libs shared
Index: tr_store.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/extras/trailed_update/tr_store.m,v
retrieving revision 1.1
diff -u -u -r1.1 tr_store.m
--- tr_store.m 1997/09/26 15:28:04 1.1
+++ tr_store.m 1997/10/06 15:45:21
@@ -206,6 +206,10 @@
/* ML_arg() is defined in std_util.m */
bool ML_arg(Word term_type_info, Word *term, Word argument_index,
Word *arg_type_info, Word **argument_ptr);
+
+ /* ML_compare_type_info() is defined in std_util.m */
+ int ML_compare_type_info(Word type_info_1, Word type_info_2);
+
").
:- pragma c_code(arg_ref(Ref::in, ArgNum::in, ArgRef::out, S0::mdi, S::muo),
Index: unsafe.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/extras/trailed_update/unsafe.m,v
retrieving revision 1.1
diff -u -u -r1.1 unsafe.m
--- unsafe.m 1997/09/20 17:15:22 1.1
+++ unsafe.m 1997/10/06 15:43:18
@@ -56,15 +56,13 @@
unsafe_perform_io(P::(pred(di, uo) is det)),
may_call_mercury,
"{
- Word dummy_io_state = 0;
- call_io_pred_det(P, dummy_io_state, &dummy_io_state);
+ call_io_pred_det(P);
}").
:- pragma c_code(
unsafe_perform_io(P::(pred(di, uo) is cc_multi)),
may_call_mercury,
"{
- Word dummy_io_state = 0;
- call_io_pred_cc_multi(P, dummy_io_state, &dummy_io_state);
+ call_io_pred_cc_multi(P);
}").
:- pred call_io_pred(pred(io__state, io__state), io__state, io__state).
Index: var.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/extras/trailed_update/var.m,v
retrieving revision 1.3
diff -u -u -r1.3 var.m
--- var.m 1997/09/27 18:19:27 1.3
+++ var.m 1997/10/06 18:12:20
@@ -17,11 +17,10 @@
% for cyclic terms; if you attempt to do anything much with cyclic terms,
% your program will probably not terminate.
%
-% XXX TODO: add code to check for floundering.
-%
%-----------------------------------------------------------------------------%
:- module var.
:- interface.
+:- import_module io.
% A `var(T)' is a Prolog-style variable that holds a value of type T.
:- type var(T).
@@ -65,13 +64,6 @@
:- mode freeze(in(any), pred(in) is semidet) is semidet.
:- mode freeze(out(any), pred(in) is semidet) is semidet.
- % `debug_freeze(Message, Var, Pred)'
- % is the same as `freeze(Var, Pred)' except
- % that it also prints out some debugging information.
- % WARNING: this is a non-logical hack, use only for debugging!
-:- pred debug_freeze(string, var(T), pred(T)).
-:- mode debug_freeze(in, in(any), pred(in) is semidet) is semidet.
-
% `freeze(Var1, Pred, Var2)' can be used to delay
% execution of a goal until a variable is ground.
% This version is more flexible than freeze/2, since
@@ -88,13 +80,32 @@
:- pred freeze_var(var(T1), pred(T1, var(T2)), var(T2)).
:- mode freeze_var(out(any), pred(in, in(any)) is semidet, out(any)) is semidet.
+ % `debug_freeze(Message, Var, Pred)'
+ % is the same as `freeze(Var, Pred)' except
+ % that it also prints out some debugging information.
+ % WARNING: this is a non-logical hack, use only for debugging!
+:- pred debug_freeze(string, var(T), pred(T)).
+:- mode debug_freeze(in, in(any), pred(in) is semidet) is semidet.
+:- mode debug_freeze(in, out(any), pred(in) is semidet) is semidet.
+
+:- pred debug_freeze(string, var(T1), pred(T1, T2), var(T2)).
+:- mode debug_freeze(in, in, pred(in, out) is semidet, out) is semidet.
+:- mode debug_freeze(in, out(any), pred(in, out) is semidet, out(any))
+ is semidet.
+
+ % dump_var prints out a representation of a variable.
+:- pred dump_var(var(T)::in(any), io__state::di, io__state::uo) is cc_multi.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
%-----------------------------------------------------------------------------%
-:- import_module std_util.
+:- import_module std_util, bool.
:- import_module unsafe, io.
:- import_module require.
+
+:- pragma c_header_code("#include <stdio.h>").
+
%-----------------------------------------------------------------------------%
%
% The implementation is mostly written in impure unsafe Mercury,
@@ -118,13 +129,13 @@
:- type var_rep(T)
---> free
- ; free(conj(delayed_goal(T)))
+ ; free(delayed_conj(T))
; alias(var_rep(T))
; ground(T).
:- inst var_rep_any =
bound( free
- ; free(conj(delayed_goal))
+ ; free(delayed_conj)
; alias(var_rep_any)
; ground(ground)
).
@@ -136,7 +147,7 @@
bound( ground(ground)
).
:- inst var_rep_deref_delayed =
- bound( free(conj(delayed_goal))
+ bound( free(delayed_conj)
).
% We use an extra level of indirection so that we can do
@@ -150,14 +161,21 @@
:- inst ptr(I) = bound(alias(I)).
:- inst uniq_ptr(I) = unique(alias(I)).
-% The type `conj(T)' represents a conjunction of goals of type T.
+% The type `delayed_conj(T)' represents a conjunction of delayed goals
+% that are delayed on a variable of type T.
-:- type conj(T)
- ---> goal(T)
- ; (conj(T), conj(T)).
-:- inst conj(I) =
- bound( goal(I)
- ; (conj(I), conj(I))
+:- type delayed_conj(T)
+ /* Warning: the layout of this type must match its layout in C */
+ ---> goal(delayed_goal(T), bool, delayed_conj(T), delayed_conj(T))
+ % the goal, `yes' if the goal has been woken,
+ % and a pointer to the previous and next delayed goals
+ ; (delayed_conj(T), delayed_conj(T)).
+:- inst delayed_conj =
+ bound( goal(delayed_goal, ground, delayed_goal_list, delayed_goal_list)
+ ; (delayed_conj, delayed_conj)
+ ).
+:- inst delayed_goal_list =
+ bound( goal(delayed_goal, ground, delayed_goal_list, delayed_goal_list)
).
% The type `delayed_goal(T)' represents a goal delayed on a variable
@@ -175,31 +193,31 @@
; /* some [T2] binary_pred(pred(T, T2), var(T2)) */
binary_det_pred(
- pred(type_info_for_t2, T, t2),
+ pred(T, t2),
type_info_for_t2, var(t2))
; /* some [T2] binary_pred(pred(T, T2), var(T2)) */
binary_semidet_pred(
- pred(type_info_for_t2, T, t2),
+ pred(T, t2),
type_info_for_t2, var(t2))
; /* some [T2]
binary_semidet_pred_any(pred(T, var(T2)), var(T2)) */
binary_semidet_pred_any(
- pred(type_info_for_t2, T, var(t2)),
+ pred(T, var(t2)),
type_info_for_t2, var(t2))
.
:- inst delayed_goal
---> unary_pred(pred(in) is semidet)
; binary_det_pred(
- pred(in, in, out) is det,
+ pred(in, out) is det,
ground, any)
; binary_semidet_pred(
- pred(in, in, out) is semidet,
+ pred(in, out) is semidet,
ground, any)
; binary_semidet_pred_any(
- pred(in, in, in(any)) is semidet,
+ pred(in, in(any)) is semidet,
ground, any).
%-----------------------------------------------------------------------------%
@@ -299,32 +317,169 @@
destructively_update_binding(VarPtr, ground(Value))
;
Var = free(DelayedGoals),
- call_delayed_goals(DelayedGoals, Value),
- destructively_update_binding(VarPtr, ground(Value))
+ destructively_update_binding(VarPtr, ground(Value)),
+ wakeup_delayed_goals(DelayedGoals, Value)
).
%-----------------------------------------------------------------------------%
-:- pred call_delayed_goals(conj(delayed_goal(T)), T).
-:- mode call_delayed_goals(in(conj(delayed_goal)), in) is semidet.
+%
+% To allow detection of floundering,
+% we keep a global doubly-linked list of all delayed goals,
+% ordered from oldest to newest.
+% To simplify the code to insert/delete from this list,
+% we keep two dummy nodes, one for the start and one for the end of the list.
+%
+
+:- pragma c_header_code("
+ /* Warning: the layout of this type must match its layout in Mercury */
+ typedef struct ML_var_delayed_conj_struct {
+ Word goal;
+ Word woken;
+ struct ML_var_delayed_conj_struct *prev;
+ struct ML_var_delayed_conj_struct *next;
+ } ML_var_delayed_conj;
+ extern ML_var_delayed_conj ML_var_first_goal, ML_var_last_goal;
+").
+
+:- pragma c_code("
+ ML_var_delayed_conj ML_var_first_goal = {
+ 0,
+ FALSE,
+ NULL,
+ &ML_var_last_goal
+ };
+ ML_var_delayed_conj ML_var_last_goal = {
+ 0,
+ FALSE,
+ &ML_var_first_goal,
+ NULL
+ };
+").
+
+/* impure */
+:- pred get_last_delayed_goal(delayed_conj(_)::out(delayed_goal_list)) is det.
+:- pragma c_code(get_last_delayed_goal(Ptr::out(delayed_goal_list)),
+ will_not_call_mercury,
+"
+ Ptr = (Word) &ML_var_last_goal;
+").
+
+/* impure */
+:- pred set_last_delayed_goal_prev(delayed_conj(_)::in(delayed_goal_list))
+ is det.
+:- pragma c_code(set_last_delayed_goal_prev(Ptr::in(delayed_goal_list)),
+ will_not_call_mercury,
+"
+ MR_trail_function(ML_var_untrail_func, ML_var_last_goal.prev);
+ ML_var_last_goal.prev = (void *) Ptr;
+").
+
+%-----------------------------------------------------------------------------%
+
+/* impure */
+:- pred new_delayed_goal(delayed_goal(T), delayed_conj(T)).
+:- mode new_delayed_goal(in(delayed_goal), out(delayed_conj)) is det.
+
+new_delayed_goal(Pred, Goal) :-
+ %
+ % insert Pred at the end of the global list of delayed goals
+ %
+ /* impure */ get_last_delayed_goal(LastGoal),
+ LastGoal = goal(_, _LastWoken, LastPrev, _LastNext),
+ Goal = goal(Pred, no, LastPrev, LastGoal),
+ /* impure */ set_last_delayed_goal_prev(Goal). % LastGoal->prev := Goal
+
+/* impure */
+:- pred wakeup_delayed_goals(delayed_conj(T), T).
+:- mode wakeup_delayed_goals(in(delayed_conj), in) is semidet.
+
+wakeup_delayed_goals(Goal, Value) :-
+ Goal = goal(DelayedGoal, _Woken, Prev, Next),
+ %
+ % Delete the goal from the global list of delayed goals,
+ % and mark it as woken.
+ %
+ /* impure */ setarg(Goal, 2, yes), % Goal->woken := yes
+ /* impure */ setarg(Next, 3, Prev), % Next->prev := Prev
+ /* impure */ setarg(Prev, 3, Next), % Prev->next := Next
+ %
+ % Call it.
+ %
+ call_delayed_goal(DelayedGoal, Value).
+
+wakeup_delayed_goals((GoalsX, GoalsY), Value) :-
+ wakeup_delayed_goals(GoalsX, Value),
+ wakeup_delayed_goals(GoalsY, Value).
+
+%-----------------------------------------------------------------------------%
+
+:- pragma c_header_code("
+ void ML_var_untrail_func(
+ ML_var_delayed_conj *old_delayed_goals,
+ MR_untrail_reason reason);
+").
+
+:- pragma c_code("
-call_delayed_goals(goal(Goal), Value) :-
- call_delayed_goal(Goal, Value).
-call_delayed_goals((GoalsX, GoalsY), Value) :-
- call_delayed_goals(GoalsX, Value),
- call_delayed_goals(GoalsY, Value).
+void
+ML_var_untrail_func(ML_var_delayed_conj *old_goal, MR_untrail_reason reason)
+{
+ switch (reason) {
+ case MR_exception:
+ case MR_undo:
+ /* just undo the update */
+ ML_var_last_goal.prev = old_goal;
+ break;
+
+ case MR_commit:
+ /*
+ ** Skip past any goals that were created before
+ ** the choice point which we're committing over,
+ ** but which we have since woken up.
+ */
+ while (old_goal->woken) {
+ old_goal = old_goal->prev;
+ }
+ /*
+ ** `old_goal' now points to the delayed goal that
+ ** was most recent at the time we created the choice
+ ** point. If that is not the same as what is currently
+ ** at the end of the list of outstanding (unwoken)
+ ** delayed goals, then we must have created some
+ ** new delayed goals since the choice point started.
+ ** Since there are outstanding delayed goals, we
+ ** can't commit, so the goal flounders.
+ */
+ if (old_goal != ML_var_last_goal.prev) {
+ /* XXX should improve error message */
+ fflush(stdout);
+ fprintf(stderr, ""var.m: warning: ""
+ ""goal floundered.\n"");
+ }
+ break;
+
+ default:
+ fatal_error(""ML_var_untrail_func: ""
+ ""unknown untrail reason"");
+ }
+}
+
+").
+
+%-----------------------------------------------------------------------------%
:- pred call_delayed_goal(delayed_goal(T), T).
:- mode call_delayed_goal(in(delayed_goal), in) is semidet.
call_delayed_goal(unary_pred(Pred), Value) :-
call(Pred, Value).
-call_delayed_goal(binary_det_pred(Pred, TypeInfo2, var(Arg2)), Value) :-
- call(Pred, TypeInfo2, Value, Arg2).
-call_delayed_goal(binary_semidet_pred(Pred, TypeInfo2, var(Arg2)), Value) :-
- call(Pred, TypeInfo2, Value, Arg2).
-call_delayed_goal(binary_semidet_pred_any(Pred, TypeInfo2, Arg2), Value) :-
- call(Pred, TypeInfo2, Value, Arg2).
+call_delayed_goal(binary_det_pred(Pred, _TypeInfo2, var(Arg2)), Value) :-
+ call(Pred, Value, Arg2).
+call_delayed_goal(binary_semidet_pred(Pred, _TypeInfo2, var(Arg2)), Value) :-
+ call(Pred, Value, Arg2).
+call_delayed_goal(binary_semidet_pred_any(Pred, _TypeInfo2, Arg2), Value) :-
+ call(Pred, Value, Arg2).
%-----------------------------------------------------------------------------%
@@ -359,7 +514,8 @@
"ML_var_freeze_out").
var__rep_freeze_out(Var, Pred) :-
- Var = alias(free(goal(Pred))).
+ new_delayed_goal(Pred, Goal),
+ Var = alias(free(Goal)).
:- pred var__rep_freeze_in(var_rep(T), delayed_goal(T)).
:- mode var__rep_freeze_in(in(ptr(var_rep_any)), in(delayed_goal)) is semidet.
@@ -377,11 +533,13 @@
call_delayed_goal(Pred, Value)
;
Var = free,
- NewVar = free(goal(Pred)),
+ new_delayed_goal(Pred, Goal),
+ NewVar = free(Goal),
destructively_update_binding(VarPtr, NewVar)
;
Var = free(OldGoals),
- NewVar = free((OldGoals, goal(Pred))),
+ new_delayed_goal(Pred, Goal),
+ NewVar = free((OldGoals, Goal)),
destructively_update_binding(VarPtr, NewVar)
).
@@ -467,35 +625,35 @@
% The following code just exports the constructors for the type
% delayed_goal/1 to C.
-:- func var_binary_det_pred(pred(type_info_for_t2, T, t2),
- type_info_for_t2, var(t2)) = delayed_goal(T).
-:- mode var_binary_det_pred(pred(in, in, out) is det, in, in(any)) =
+:- func var_binary_det_pred(pred(T, t2), type_info_for_t2, var(t2))
+ = delayed_goal(T).
+:- mode var_binary_det_pred(pred(in, out) is det, in, in(any)) =
out(delayed_goal) is det.
:- pragma export(
- var_binary_det_pred(pred(in, in, out) is det, in, in(any)) =
+ var_binary_det_pred(pred(in, out) is det, in, in(any)) =
out(delayed_goal), "ML_var_binary_det_pred").
var_binary_det_pred(Pred, TypeInfo, SecondArg) =
binary_det_pred(Pred, TypeInfo, SecondArg).
-:- func var_binary_semidet_pred(pred(type_info_for_t2, T, t2),
- type_info_for_t2, var(t2)) = delayed_goal(T).
-:- mode var_binary_semidet_pred(pred(in, in, out) is semidet, in, in(any)) =
+:- func var_binary_semidet_pred(pred(T, t2), type_info_for_t2, var(t2))
+ = delayed_goal(T).
+:- mode var_binary_semidet_pred(pred(in, out) is semidet, in, in(any)) =
out(delayed_goal) is det.
:- pragma export(
- var_binary_semidet_pred(pred(in, in, out) is semidet, in, in(any)) =
+ var_binary_semidet_pred(pred(in, out) is semidet, in, in(any)) =
out(delayed_goal), "ML_var_binary_semidet_pred").
var_binary_semidet_pred(Pred, TypeInfo, SecondArg) =
binary_semidet_pred(Pred, TypeInfo, SecondArg).
:- func var_binary_semidet_pred_any(
- pred(type_info_for_t2, T, var(t2)),
+ pred(T, var(t2)),
type_info_for_t2, var(t2)) = delayed_goal(T).
:- mode var_binary_semidet_pred_any(
- pred(in, in, in(any)) is semidet, in, in(any)) =
+ pred(in, in(any)) is semidet, in, in(any)) =
out(delayed_goal) is det.
:- pragma export(
var_binary_semidet_pred_any(
- pred(in, in, in(any)) is semidet, in, in(any)) =
+ pred(in, in(any)) is semidet, in, in(any)) =
out(delayed_goal), "ML_var_binary_semidet_pred_any").
var_binary_semidet_pred_any(Pred, TypeInfo, SecondArg) =
binary_semidet_pred_any(Pred, TypeInfo, SecondArg).
@@ -586,7 +744,7 @@
;
Y = free(DelayedGoals),
X = ground(Value),
- call_delayed_goals(DelayedGoals, Value),
+ wakeup_delayed_goals(DelayedGoals, Value),
destructively_update_binding(YPtr, X)
).
@@ -606,7 +764,7 @@
;
Y = ground(Value),
X = free(XGoals),
- call_delayed_goals(XGoals, Value),
+ wakeup_delayed_goals(XGoals, Value),
destructively_update_binding(XPtr, Y)
;
Y = free(YGoals),
@@ -627,6 +785,7 @@
setarg(VarPtr, 1, NewBinding).
%-----------------------------------------------------------------------------%
+
/*
** setarg/3 provides non-logical backtrackable destructive update.
** `setarg(Term, N, Value)' destructively modifies the Nth
@@ -643,8 +802,6 @@
:- pred setarg(T1, int, T2).
:- mode setarg(in(any), in, in(any)) is det.
-%-----------------------------------------------------------------------------%
-
:- pragma c_code(
setarg(MercuryTerm::in(any), ArgNum::in, NewValue::in(any)),
will_not_call_mercury,
@@ -654,6 +811,19 @@
ptr[ArgNum - 1] = NewValue;
}").
+% untrailed_setarg/3 is similar to setarg/3 except the update is not
+% trailed, so it will not be undone on backtracking.
+:- pred untrailed_setarg(T1, int, T2).
+:- mode untrailed_setarg(in(any), in, in(any)) is det.
+
+:- pragma c_code(
+ untrailed_setarg(MercuryTerm::in(any), ArgNum::in, NewValue::in(any)),
+ will_not_call_mercury,
+"{
+ Word *ptr = (Word *) strip_tag(MercuryTerm); /* strip off tag bits */
+ ptr[ArgNum - 1] = NewValue;
+}").
+
%-----------------------------------------------------------------------------%
:- pragma no_inline(debug_freeze/3).
@@ -662,50 +832,131 @@
unsafe_perform_io(print("freezing: ")),
unsafe_perform_io(print(Msg)),
unsafe_perform_io(print(": ")),
- unsafe_perform_io(print_any(Var)),
+ unsafe_perform_io(dump_var(Var)),
+ unsafe_perform_io(nl),
+
+ freeze(Var, debug_pred(Msg, Pred)),
+
+ unsafe_perform_io(print("frozen: ")),
+ unsafe_perform_io(print(Msg)),
+ unsafe_perform_io(print(": ")),
+ unsafe_perform_io(dump_var(Var)),
+ unsafe_perform_io(nl)
+
+ ;
+
+ unsafe_perform_io(print("freeze failed: ")),
+ unsafe_perform_io(print(Msg)),
+ unsafe_perform_io(print(": ")),
+ unsafe_perform_io(dump_var(Var)),
+ unsafe_perform_io(nl),
+ fail.
+
+:- pragma no_inline(debug_freeze/4).
+
+debug_freeze(Msg, X, Pred, Y) :-
+ unsafe_perform_io(print("freezing: ")),
+ unsafe_perform_io(print(Msg)),
+ % unsafe_perform_io(print(": ")),
+ % unsafe_perform_io(dump_var(X)),
+ unsafe_perform_io(nl),
+
+ freeze(X, debug_pred2(Msg, Pred), Y),
+
+ unsafe_perform_io(print("frozen: ")),
+ unsafe_perform_io(print(Msg)),
+ unsafe_perform_io(print(": ")),
+ unsafe_perform_io(dump_var(X)),
+ unsafe_perform_io(nl)
+
+ ;
+
+ unsafe_perform_io(print("freeze failed: ")),
+ unsafe_perform_io(print(Msg)),
+ unsafe_perform_io(print(": ")),
+ unsafe_perform_io(dump_var(X)),
unsafe_perform_io(nl),
- ( freeze(Var, debug_pred(Msg, Pred)) ->
- unsafe_perform_io(print("frozen: ")),
+ fail.
+
+:- pred debug_pred(string, pred(T), T) is semidet.
+:- mode debug_pred(in, pred(in) is semidet, in) is semidet.
+
+debug_pred(Msg, Pred, Var) :-
+ unsafe_perform_io(print("woke: ")),
+ unsafe_perform_io(print(Msg)),
+ unsafe_perform_io(print(": ")),
+ unsafe_perform_io(print(Var)),
+ unsafe_perform_io(nl),
+ ( call(Pred, Var) ->
+ unsafe_perform_io(print("succeeded: ")),
unsafe_perform_io(print(Msg)),
unsafe_perform_io(print(": ")),
- unsafe_perform_io(print_any(Var)),
+ unsafe_perform_io(print(Var)),
unsafe_perform_io(nl)
;
- unsafe_perform_io(print("freeze failed: ")),
+ unsafe_perform_io(print("failed: ")),
unsafe_perform_io(print(Msg)),
unsafe_perform_io(print(": ")),
- unsafe_perform_io(print_any(Var)),
+ unsafe_perform_io(print(Var)),
unsafe_perform_io(nl),
semidet_fail
).
+:- pred debug_pred2(string, pred(T1, T2), T1, T2) is semidet.
+:- mode debug_pred2(in, pred(in, out) is semidet, in, out) is semidet.
-:- pred debug_pred(string::in, pred(T)::(pred(in) is semidet), T::in)
- is semidet.
-
-debug_pred(Msg, Pred, Var) :-
+debug_pred2(Msg, Pred, X, Y) :-
unsafe_perform_io(print("woke: ")),
unsafe_perform_io(print(Msg)),
unsafe_perform_io(print(": ")),
- unsafe_perform_io(print(Var)),
+ unsafe_perform_io(print(X)),
unsafe_perform_io(nl),
- ( call(Pred, Var) ->
+ ( call(Pred, X, Y),
unsafe_perform_io(print("succeeded: ")),
unsafe_perform_io(print(Msg)),
unsafe_perform_io(print(": ")),
- unsafe_perform_io(print(Var)),
+ unsafe_perform_io(print(X)),
+ unsafe_perform_io(print(", ")),
+ unsafe_perform_io(print(Y)),
unsafe_perform_io(nl)
;
unsafe_perform_io(print("failed: ")),
unsafe_perform_io(print(Msg)),
unsafe_perform_io(print(": ")),
- unsafe_perform_io(print(Var)),
+ unsafe_perform_io(print(X)),
+ unsafe_perform_io(print(", ")),
+ unsafe_perform_io(print(Y)),
unsafe_perform_io(nl),
- semidet_fail
+ fail
).
-:- pred print_any(T::in(any), io__state::di, io__state::uo) is det.
-print_any(X) -->
- print(unsafe_promise_ground(X)).
+:- pragma c_code(dump_var(Var::in(any), IO0::di, IO::uo), may_call_mercury, "
+ ML_var_print(TypeInfo_for_T, Var);
+ IO = IO0;
+").
+
+:- pred dump_var_rep(var_rep(T)::in(var_rep_any),
+ io__state::di, io__state::uo) is det.
+:- pragma export(dump_var_rep(in(var_rep_any), di, uo), "ML_var_print").
+
+dump_var_rep(alias(Var)) -->
+ print("alias("), dump_var_rep(Var), print(")").
+dump_var_rep(ground(Val)) -->
+ print("ground("), print(Val), print(")").
+dump_var_rep(free) -->
+ print("free").
+dump_var_rep(free(Goals)) -->
+ print("free("), dump_goals(Goals), print(")").
+
+:- pred dump_goals(delayed_conj(T)::in(delayed_conj),
+ io__state::di, io__state::uo) is det.
+dump_goals((A,B)) -->
+ print("("), dump_goals(A), print(", "), dump_goals(B), print(")").
+dump_goals(goal(_, Woken, _, _)) -->
+ ( { Woken = yes } ->
+ print("<woken goal>")
+ ;
+ print("<delayed goal>")
+ ).
%-----------------------------------------------------------------------------%
cvs diff: Diffing samples
Index: samples/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/mercury/extras/trailed_update/samples/Mmakefile,v
retrieving revision 1.1
diff -u -u -r1.1 Mmakefile
--- Mmakefile 1997/09/29 15:24:14 1.1
+++ Mmakefile 1997/10/06 17:38:20
@@ -5,23 +5,38 @@
# We need to use a grade with trailing
GRADE = asm_fast.gc.tr
+MCFLAGS = --infer-all
+
+MGNUCFLAGS=-g
+RM_C=:
+MLFLAGS=-g
+
# Link in the trailed_update library from ..
-MCFLAGS = -I.. $(EXTRA_MCFLAGS)
-MLFLAGS = -R`pwd`/.. -L.. $(EXTRA_MLFLAGS)
+MCFLAGS += -I.. $(EXTRA_MCFLAGS)
+MLFLAGS += -R`pwd`/.. -L.. $(EXTRA_MLFLAGS)
MLLIBS = -ltrailed_update $(EXTRA_MLLIBS)
VPATH = ..:$(MMAKE_VPATH)
C2INITFLAGS = ../trailed_update.init
%_init.c: $(C2INITFLAGS)
+# We need the following to use shared libraries on Linux
+# MGNUCFLAGS += -DPIC_REG
+# ML = ml --mercury-libs shared
+
+ML = ml --mercury-libs static
+MLLIBS = ../libtrailed_update.a
+
#-----------------------------------------------------------------------------#
-PROGS = interpreter vqueens
+PROGS = interpreter vqueens tests
DEPENDS = $(PROGS:%=%.depend)
CS = $(PROGS:%=%.c)
RESS = $(PROGS:%=%.res)
#-----------------------------------------------------------------------------#
+
+$(PROGS): ../libtrailed_update.a
%.out: %
./$< > $@ 2>&1;
cvs diff: samples/tests.m is a new entry, no comparison available
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
More information about the developers
mailing list