Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Backtracking and Assert

149 views
Skip to first unread message

Benjamin Yu

unread,
Jul 25, 1991, 11:04:00 AM7/25/91
to
What does your favourite Prolog return given the following query?

:- assertz(count(1)), count(X), Y is X + 1, assertz(count(Y)), Y == 5.

CProlog, SBProlog both return no with count(1) and count(2) asserted.
A.D.A. Prolog returns X = 4, Y = 5 and count(1) .. count(5) asserted
(which I had hoped the query would return!)

[If trace is on in CProlog, it also returns X = 4 and Y = 5 and with
count(1) .. count(5) asserted .. funny how trace can change the semantics
of your query!]

Now if the above query returns no, then why the following query succeeds
with X = 4 and Y = 5 ?

:- assertz(count(1)), assertz(count(1)), count(X), Y is X + 1,
assertz(count(Y)), Y == 5.


Benjamin Yu
University of Toronto b...@csri.toronto.edu
Department of Computer Science be...@torolab3.vnet.ibm.com
Toronto, Ontario Canada M5S 1A4 b...@csri.utoronto.ca
(o)(416)978 - 4299 (h)(416)470 - 8206 {uunet,watmath}!csri.utoronto.edu!byu

Benjamin Yu

unread,
Jul 25, 1991, 11:30:45 PM7/25/91
to
In article <1991Jul25.1...@jarvis.csri.toronto.edu> b...@csri.toronto.edu (Benjamin Yu) writes:
# What does your favourite Prolog return given the following query?
#
# :- assertz(count(1)), count(X), Y is X + 1, assertz(count(Y)), Y == 5.
#
# CProlog, SBProlog both return no with count(1) and count(2) asserted.
# A.D.A. Prolog returns X = 4, Y = 5 and count(1) .. count(5) asserted
# (which I had hoped the query would return!)
#
# [If trace is on in CProlog, it also returns X = 4 and Y = 5 and with
# count(1) .. count(5) asserted .. funny how trace can change the semantics
# of your query!]
#

Just want to clarify what I meant with trace on ... I did not mean repeating
the same query in the same Prolog session. The following script should
clarify the situation:


Script started on Thu Jul 25 23:19:05 1991
21 ) prolog <---------- start Prolog !!!!
C-Prolog version 1.4
| ?- assertz(count(1)), count(X), Y is X + 1, assertz(count(Y)), Y == 5.
no
| ?- count(X).
X = 1 ;

X = 2 ;

no
| ?- ^D
[ Prolog execution halted ]
22 ) prolog <---------- restart Prolog !!!!
C-Prolog version 1.4
| ?- trace.

yes
| ?- assertz(count(1)), count(X), Y is X + 1, assertz(count(Y)), Y == 5.
(1) 1 Call: assertz(count(1)) ?
(1) 1 Exit: assertz(count(1))
(2) 1 Call: count(_6) ?
(2) 1 Exit: count(1)
(3) 1 Call: _10 is 1+1 ?
(3) 1 Exit: 2 is 1+1
(4) 1 Call: assertz(count(2)) ?
(4) 1 Exit: assertz(count(2))
(5) 1 Call: 2==5 ?
(5) 1 Fail: 2==5
(4) 1 Back to: assertz(count(2)) ?
(4) 1 Fail: assertz(count(2))
(3) 1 Back to: _10 is 1+1 ?
(3) 1 Fail: _10 is 1+1
(2) 1 Back to: count(_6) ?
(2) 1 Exit: count(2)
(6) 1 Call: _10 is 2+1 ?
(6) 1 Exit: 3 is 2+1
(7) 1 Call: assertz(count(3)) ?
(7) 1 Exit: assertz(count(3))
(8) 1 Call: 3==5 ?
(8) 1 Fail: 3==5
(7) 1 Back to: assertz(count(3)) ?
(7) 1 Fail: assertz(count(3))
(6) 1 Back to: _10 is 2+1 ?
(6) 1 Fail: _10 is 2+1
(2) 1 Back to: count(_6) ?
(2) 1 Exit: count(3)
(9) 1 Call: _10 is 3+1 ?
(9) 1 Exit: 4 is 3+1
(10) 1 Call: assertz(count(4)) ?
(10) 1 Exit: assertz(count(4))
(11) 1 Call: 4==5 ?
(11) 1 Fail: 4==5
(10) 1 Back to: assertz(count(4)) ?
(10) 1 Fail: assertz(count(4))
(9) 1 Back to: _10 is 3+1 ?
(9) 1 Fail: _10 is 3+1
(2) 1 Back to: count(_6) ?
(2) 1 Exit: count(4)
(12) 1 Call: _10 is 4+1 ?
(12) 1 Exit: 5 is 4+1
(13) 1 Call: assertz(count(5)) ?
(13) 1 Exit: assertz(count(5))
(14) 1 Call: 5==5 ?
(14) 1 Exit: 5==5

X = 4
Y = 5

yes
| ?- untrace.

no
| ?- notrace.

no
| ?- count(X).

X = 1 ;

X = 2 ;

X = 3 ;

X = 4 ;

X = 5 ;

no
| ?- ^D
[ Prolog execution halted ]

Francois-Michel Lang

unread,
Jul 26, 1991, 11:40:31 AM7/26/91
to
>What does your favourite Prolog return given the following query?
>
>:- assertz(count(1)), count(X), Y is X + 1, assertz(count(Y)), Y == 5.
>
>CProlog, SBProlog both return no with count(1) and count(2) asserted.
>A.D.A. Prolog returns X = 4, Y = 5 and count(1) .. count(5) asserted
>(which I had hoped the query would return!)

This comes up every once in a while. The behavior of your Prolog system
depends on its semantics for dynamic code. Two common methods for handling
such things are the "logical" and "immediate update" view. The following
articles discuss the topic.

@INPROCEEDINGS{DefensibleSemantics,
AUTHOR="Timothy G. Lindholm and Richard A. O'Keefe",
TITLE="Efficient Implementation of a Defensible Semantics
for Dynamic Prolog Code",
BOOKTITLE=ilpc4,
EDITOR="Jean-Louis Lassez",
PAGES="21-39",
PUBLISHER="The MIT Press",
ADDRESS="Cambridge, MA",
YEAR=1987
}

@TECHREPORT{KUL-120,
AUTHOR="E. Boerger and Bart Demoen",
TITLE="A Framework to Specify Database Update Views for Prolog",
TYPE="Technical Report",
NUMBER="CW120",
INSTITUTION="Katholieke Universiteit Leuven",
ADDRESS="Leuven, Belgium",
MONTH=dec,
YEAR=1990
}

@TECHREPORT{KUL-121,
AUTHOR="Bart Demoen",
TITLE="From a Specification to an Implementation
of a Database Update View for Prolog:
A Correctness Proof",
TYPE="Technical Report",
NUMBER="CW121",
INSTITUTION="Katholieke Universiteit Leuven",
ADDRESS="Leuven, Belgium",
MONTH=dec,
YEAR=1990
}


@INPROCEEDINGS{CutAndPaste,
AUTHOR="Chris Moss",
TITLE="Cut and Paste: Definining the Impure Primitives of Prolog",
BOOKTITLE=ilpc3,
EDITOR="Ehud Shapiro",
PAGES="686-694",
PUBLISHER="Springer-Verlag",
ADDRESS="New York",
YEAR=1986
}

Briefly (as I understand it), in systems using the "logical" view,
the definition of a predicate (i.e., the clauses available to it)
is fixed when that predicate is called, and will not change even
if additional clauses are assertz-ed after the predicate succeeds
and before it is backtracked into. In the "immediate update" view,
clauses assertz-ed as above *do* become visible. I'd always thought
that CProlog uses the "logical" view, which is supported by the first
example....

>[If trace is on in CProlog, it also returns X = 4 and Y = 5 and with
>count(1) .. count(5) asserted .. funny how trace can change the semantics
>of your query!]

...except while debugging! Several years ago, I posted a query about
this exact problem in CProlog, and Fernando offered the following explanation:

> Date: Wed 12 Nov 86 10:38:41-PST
> From: Fernando Pereira <PER...@SRI-CANDIDE.ARPA>
> Subject: C-Prolog 1.5 bug
>
> The different behaviors of C-Prolog in debug or
> nodebug mode when new clauses are added to an
> active procedure are there by design. When not
> debugging, the interpreter recognizes it has got
> to the last clause of a predicate and throws away
> the corresponding choice point. Thus any clauses
> appended to the predicate will not be seen.
> However, when debugging, the choice point has to
> be kept so that appropriate information is printed
> on a fail port. Newly appended clauses are then
> visible as a result.
>
> Earlier versions of C-Prolog always removed the
> choice point, but I got many complaints about the
> incomplete debugging information, so I implemented
> the current compromise. Now this has the unfortunate
> consequence that appended clauses will be seen by
> active procedures when in debug mode but not otherwise.
> However, I think this is a relatively small cost to
> pay for better efficiency when not debugging and full
> information when debugging. What happens to active
> procedures is not part of any accepted Prolog
> specification, anyway, and different Prolog systems do
> it differently, so relying on any particular behavior
> is bad programming practice.
>
> Now I believe that the correct behavior should be that
> changes to a predicate are NEVER visible to active
> invocations of the predicate, whatever the change
> (assert, retract, etc.). This is not easy to achieve
> (I know of only one Prolog system that does it correctly)
> and it would require a major rewrite of C-Prolog. Given
> this, I saw no reason to waste time nibbling at the edges
> of the problem.
>
> Finally, retract has always been nondeterminate. This is
> not a bug in C-Prolog, but just compliance with the
> Edinburgh ``standard''.
>
> -- Fernando Pereira
> (retired) C-Prolog implementer

>Now if the above query returns no, then why the following query succeeds
>with X = 4 and Y = 5 ?
>
>:- assertz(count(1)), assertz(count(1)), count(X), Y is X + 1,
> assertz(count(Y)), Y == 5.

This is indeed what happens in CProlog. In Quintus Prolog, however,
this query fails, just as the other one did. It seems that perhaps
CProlog's implementation of the immediate update view won't see any
clauses added when there is no active choice point, but that if there
*is* a choice point (as there is if you assertz count(1) twice), and
new clause are added "below" the choice point, then they are seen?

I'm not a prolog implementor, so take all this with several large
grains of salt. Richard, Fernando, any thoughts on this?
---------------------------------------------------------------
Francois-Michel Lang (202) 752-6067
Fannie Mae Asset/Liability Strategy uunet!almserv!alufml
Dept of Comp & Info Science, U of PA la...@linc.cis.upenn.edu

Mitanu Paul

unread,
Jul 26, 1991, 12:27:55 PM7/26/91
to
>What does your favourite Prolog return given the following query?
>
>:- assertz(count(1)), count(X), Y is X + 1, assertz(count(Y)), Y == 5.
>
>CProlog, SBProlog both return no with count(1) and count(2) asserted.
>A.D.A. Prolog returns X = 4, Y = 5 and count(1) .. count(5) asserted
>(which I had hoped the query would return!)
>
>[If trace is on in CProlog, it also returns X = 4 and Y = 5 and with
>count(1) .. count(5) asserted .. funny how trace can change the semantics
>of your query!]
>
>Now if the above query returns no, then why the following query succeeds
>with X = 4 and Y = 5 ?
>
>:- assertz(count(1)), assertz(count(1)), count(X), Y is X + 1,
> assertz(count(Y)), Y == 5.
>

In Quintus Prolog the first query fails with count(1) and count(2) asserted
(even with trace on). The reason is that, in Quintus prolog (and probably
CProlog and SBProlog), the count(X) is backtracked over only those
clauses which were asserted when count(X) was first called.
That would also explain why the second query also fails in Quintus prolog,
but asserts count(1), count(1), count(2) and count(2).

-- Mitanu Paul (mit...@top.cis.syr.edu)

Fernando Pereira

unread,
Jul 27, 1991, 8:27:28 PM7/27/91
to
In article <46...@netnews.upenn.edu> la...@linc.cis.upenn.edu (Francois-Michel Lang) writes:
>This is indeed what happens in CProlog. In Quintus Prolog, however,
>this query fails, just as the other one did. It seems that perhaps
>CProlog's implementation of the immediate update view won't see any
>clauses added when there is no active choice point, but that if there
>*is* a choice point (as there is if you assertz count(1) twice), and
>new clause are added "below" the choice point, then they are seen?
>
>I'm not a prolog implementor, so take all this with several large
>grains of salt. Richard, Fernando, any thoughts on this?
Thanks for reposting my explanation of C-Prolog's puzzling behavior.
You are exactly right: C-Prolog in debug mode uses the immediate
update view, but in nondebug mode will only see assertz'ed clauses
if there is an active choice point on the predicate being modified,
which there will not be the the next clause to be tried is the
last one in the predicate before the assertz. This is a necessity
to conserve space given C-Prolog's rather primitive memory management
and execution model. Much has been learned about Prolog implementation
since C-Prolog was hacked together in a few months in the early 80's,
and many of those lessons have been incorporated in such commercial systems
as Quintus Prolog, Prolog by BIM or ZYX Prolog, and such experimental systems
as SICStus Prolog, SB-Prolog or Sepia. There is still a debate as
to which view of updates is better (I prefer the ``logical'' view,
but I could live with a well-implemented ``immediate'' view). However,
C-Prolog's imperfect compromise is hopelessly outdated and outclassed,
and there's little point in spending time arguing about it.

Fernando Pereira
AT&T Bell Laboratories, MUrray Hill, NJ

David Bowen

unread,
Jul 29, 1991, 4:52:57 PM7/29/91
to
In defence of CProlog, it should be pointed out that a great many other
implementations, including several "commercial" implementations, do
similar sorts of things. The ISO Prolog standardization committee
(WG17) was, until recently, attempting to accommodate existing practice
by essentially leaving it undefined whether or not changes to a
predicate (by assertz or retract) are found on backtracking. However,
at its last meeting (July 1-3 in Paris) it decided to require the
"logical" view. This was at the instigation of the German group which
gave the following example:

p :- assertz(p), fail.

q :- retract(q), fail.
q.

They pointed out that not only are were all four possibilities of
{p/q succeeds/fails} permitted, but implementations were not even
required to be consistent. Thus behavior could be different depending
on whether or not debugging was on, or perhaps it could change when
garbage-collection occurred.

To avoid this inconsistency, the draft standard will now require the
logical view, which means that the clauses applicable to a particular
call of a predicate P are determined at the time that P is called. I.e.
it is as if the clauses were copied at the time of the call; any changes
affect all future calls of P, but not backtracking into the original
call. Under this view, p fails and q succeeds in the above example.

Efficient implementation of this view is possible using a kind of
"time-stamp" which is associated with a choice-point for a dynamic
predicate, and by maintaining a birth-time and a death-time for each
dynamic clause. This was described in the paper by Lindholm and O'Keefe
which was referenced in an earlier posting.

Tim Menzies,315,6974026,3694562

unread,
Aug 3, 1991, 2:41:19 AM8/3/91
to
From article <15...@quintus.UUCP>, by da...@quintus.UUCP (David Bowen):

[stuff deleted re bactracking and asserts]

>
> To avoid this inconsistency, the draft standard will now require the
> logical view, which means that the clauses applicable to a particular
> call of a predicate P are determined at the time that P is called. I.e.
> it is as if the clauses were copied at the time of the call; any changes
> affect all future calls of P, but not backtracking into the original
> call. Under this view, p fails and q succeeds in the above example.

this is a really low level question but how does the draft standard allow
the prolog programmer to implement "repeat n times"? right now, i can

repeatN(N,CODE) :-
counter(init),
repeat,
counter(next(CURRENT)),
call(CODE), % assumes CODE can never fail
CURRENT = N,
!,
counter(clear).

counter(init) :-
assert(repeatnCounter(0)).
counter(next(N)) :-
retract(repeatNCounter(LAST)),
N is LAST + 1,
assert(repeatNCounter(N)).
counter(clear) :-
retractall(repeatNCounter(_)).

I know its kludgey and not-logical and etc and etc but its better
than using recursion if N is very large (requires less memory) and
sometime I just can't avoid it. My programs must count something.

Anyway, as I understand the draft standard, this will not be allowed.
Does the draft standard insist then on end-tail recursion optimisation?

--
_--_|\ Tim Menzies (ti...@spectrum.cs.unsw.oz.au) "Kung fu\ that was one
/ \ FAX: +61-2-313-7987 of good ones\ what's a
\_.--._/ MAIL: AI Group, Com. Sci., Uni. NSW, PO few broken bones and
v BOX 1, Kensington, Australia, 2033 after all its good
clean fun?\
Skateboards\ i almost
made them respectable\
you see i can't always
get thru to you so i
go for your son!!"

Fernando Pereira

unread,
Aug 4, 1991, 10:32:03 PM8/4/91
to
In article <20...@usage.csd.unsw.oz.au> ti...@spectrum.cs.unsw.oz.au (Tim Menzies) writes:
>this is a really low level question but how does the draft standard allow
>the prolog programmer to implement "repeat n times"? right now, i can
>
>repeatN(N,CODE) :-
> [...]

>I know its kludgey and not-logical and etc and etc but its better
>than using recursion if N is very large (requires less memory) and
>sometime I just can't avoid it. My programs must count something.

When you complain about recursion, I think you may be referring to the
standard implementation of repeat-n-times:

repeat(N, Goal) :-
N > 0,
( Goal
; N0 is N - 1, repeat(N0, Goal) ).

Your repeatN/2 is just

repeatN(N, Goal) :-
( repeat(N, Goal), fail
; true ).

These days, any Prolog worth its salt has last call optimization so the above
code doesn't grow any stack (no choice points are pending when the recursive call
to repeat/2 happens). If you are using an obsolete Prolog, try

repeat(N, Goal) :-
repeat(0, N, Goal).

repeat(Low, High, Goal) :-
Low < High,
( Goal
; Mid is (Low + High) / 2, % assuming / does integer division for integers
Mid1 is Mid + 1,
( repeat(Low, Mid, Goal)
; repeat(Mid1, High, Goal) ) ).

The stack for this grows with log2 N (cuts in the last alternatives of the
disjunctions may be needed to ensure this), which should be good enough
for even very long counting (-:)

Fernando Pereira
AT&T Bell Laboratories, Murray Hill
per...@research.att.com

Mark Lutz

unread,
Aug 5, 1991, 1:25:05 PM8/5/91
to

In article <20...@usage.csd.unsw.oz.au> ti...@spectrum.cs.unsw.oz.au (Tim Menzies) writes:
> this is a really low level question but how does the draft standard allow
> the prolog programmer to implement "repeat n times"? right now, i can
>
> [example using assert/retract to implement a counter loop]...

>
> I know its kludgey and not-logical and etc and etc but its better
> than using recursion if N is very large (requires less memory) and
> sometime I just can't avoid it. My programs must count something.


Consider the following:

between(I,J,I) :- I =< J.
between(I,J,K) :- I < J, T is I+1, between(T,J,K).

try_once(Goal) :- Goal, !.
try_once(Goal).

for((I in N..M),Goal) :-
between(N,M,I), try_once(Goal), I = M, !.

repeat(N,Goal) :-
for((I in 1..N), Goal).


along with the appropriate 'in' and '..' operator declarations;
'Goal' can succeed or fail. This code uses between() to generate
successive integers on backtracking, rather than assert/retract.
In for(), the control variable can be used in the Goal, for example:
?- for((I in 1..10), (factorial(I,J),write([I,J]),nl)).

Provided that:
(1) tail-recursion-optimization is implemented (and prolog is almost
useless without it), and
(2) the integer terms generated by the is() predicate are reclaimed,
by t.r.o popping, a clever temporary allocation scheme, or a later
garbage collection,
then the between() predicate can succeed any number of times without
growing the stacks or heaps. In principle, between() should not
require more than 1 backtrack node and 1 deterministic parent node on
the control stack at any time. (The backtrack node generated for the
tail recursive call is repeatedly collapsed into its deterministic
parent, each time clause 2 is selected.)

It is important to note that prolog systems are generally optimized
to do best on clean, horn-clause, recursive programs. assert()
and retract() are almost never a good idea-- in some systems, the
dynamic analysis costs they require make them almost as complex as
calling a compiler for each new assert().

It is also important to note that space released by retract() cannot
always be immediately reclaimed. If it is possible for a clause to
become referenced from other variables or control pointers, retracted
clause space may not be available for re-allocation during the current
proof, due to the danger of generating dangling pointers. This is
particularly problematic in structure-sharing systems, where variables
routinely point at parts of shared clauses. Some systems provide varients
of assert/retract that do reclaim space immediately, because of this.

If you're using a prolog that does not do tail-recursion-optimization,
consider trying a different prolog... IMHO if you are forced to use
assert/retract to do this sort of thing, it may be easier to use C.


Mark Lutz
ml...@convex.com

Richard A. O'Keefe

unread,
Aug 5, 1991, 10:02:34 PM8/5/91
to
In article <20...@usage.csd.unsw.oz.au>, ti...@usage.csd.oz (Tim Menzies,315,6974026,3694562) writes:
> this is a really low level question but how does the draft standard allow
> the prolog programmer to implement "repeat n times"?

Like so:

repeat(N) :-
integer(N),
N > 0,
repeat_aux(N).

repeat_aux(N) :- % Coded to be determinate
( N =:= 1 -> true % as soon as it can be.
; true
; M is N-1, repeat_aux(M)
).

> right now, i can

> repeatN(N, CODE) :-


> counter(init),
> repeat,
> counter(next(CURRENT)),
> call(CODE), % assumes CODE can never fail

> CURRENT = N, % ********* ALWAYS A BAD IDEA! *********


> !,
> counter(clear).
>
> counter(init) :-
> assert(repeatnCounter(0)).
> counter(next(N)) :-
> retract(repeatNCounter(LAST)),
> N is LAST + 1,
> assert(repeatNCounter(N)).
> counter(clear) :-
> retractall(repeatNCounter(_)).
>

> I know it's kludgey and not-logical etc etc but it's better


> than using recursion if N is very large (requires less memory) and

> sometimes I just can't avoid it. My programs must count something.

It does *not* "require less memory". At least, not with any halfway decent
Prolog compiler. Look at the code for repeat/N I gave. That can hack
your repeatN(N, Code) thus:

( repeat(N), Code, fail ; true )

which lets the compiler see (and thus compile) Code, and won't go off into
never-never land if Code fails, *AND* the memory it uses is *ONE* stack
frame and ONE choice point. What's more, repeatN/2 as presented has an
intolerable limitation: you can't nest such loops, because there is just
ONE global counter. That can be hacked around, but it is better to use an
approach which simply has no such limitation.

> Anyway, as I understand the draft standard, this will not be allowed.
> Does the draft standard insist then on end-tail recursion optimisation?

You have misunderstood the standard. You are issuing SEPARATE commands
to change the data base. Each of them will see the state left behind by
the previoud one. (By the way, if your Prolog does _not_ do things this
way, each call to retract/1 is likely to leave behind a choice point, and
your code made do very nasty things to you.) The usual term, by the way,
is not "end-tail recursion optimisation" but "tail recursion optimisation"
or (if you are pedantic, like me, "last call optimisation").

--
It really is a nice theory. The only defect I think it has is probably
common to all philosophical theories. It's wrong. -- Saul Kripke.
I'm o...@goanna.cs.rmit.oz.au; all donations accepted.

David Bowen

unread,
Aug 5, 1991, 8:35:10 PM8/5/91
to

>counter(init) :-
> assert(repeatnCounter(0)).
>counter(next(N)) :-
> retract(repeatNCounter(LAST)),
> N is LAST + 1,
> assert(repeatNCounter(N)).
>counter(clear) :-
> retractall(repeatNCounter(_)).
>
>I know its kludgey and not-logical and etc and etc but its better
>than using recursion if N is very large (requires less memory) and
>sometime I just can't avoid it. My programs must count something.

As Fernando Pereira has pointed out, you don't need to use an asserted
counter in the particular example you gave of executing a goal N times by
backtracking. Kludginess aside, it will be a fair bit faster to avoid
using an asserted counter in this case.

In Quintus Prolog you could use the library predicate repeat/1 which takes
a positive integer N as its argument and succeeds N times. E.g.

:- use_module(library(between)).

repeatN(Count, Goal) :-
repeat(Count),
call(Goal),
fail.
repeatN(_, _).

For those who don't have Quintus Prolog, the definition of repeat/1 is
simple and can be easily written in standard Prolog (when there is a
standard Prolog):

repeat(_).
repeat(N) :-
N > 1,
M is N-1,
repeat(M).

(ignoring any error checking). However, it is true that on some (old?)
implementations this would use up N stack frames - so you could redefine
repeat/1 along the lines suggested by Fernando to get a version that only
uses log2(N) stack frames.

However, to return to your question:

>Anyway, as I understand the draft standard, this will not be allowed.
>Does the draft standard insist then on end-tail recursion optimisation?

The answer is that the standard WILL allow your definition of counter/1.
Had the logical view not been required, you would have had to put a cut
after the retract/1 call in order to guarantee that it not be re-satisfied
with a later-asserted clause. If you want your code to be portable in the
meantime (before the standard is in place and widely supported by
implementations) it is a good idea to put the cut after the retract anyway.
Systems supporting the logical view do not need this cut, since for them
the set of clauses applicable to the retract is fixed to be the single
clause present when (each time) retract is called. But the cut will do no
harm.

Jonas Barklund

unread,
Aug 8, 1991, 6:01:00 AM8/8/91
to
In article <20...@usage.csd.unsw.oz.au> ti...@usage.csd.oz (Tim Menzies,315,6974026,3694562) writes:

...


this is a really low level question but how does the draft standard allow
the prolog programmer to implement "repeat n times"? right now, i can

...

The idea is very ugly, of course, but here is code which should work under any scheme.

repeatN(N, Code) :-
assert(to_go(N)),
repeat,
to_go(X),
retract(to_go(X)),
( X > 0 ->
call(Code), % assuming that Code succeeds exactly once
Y is X-1,
assert(to_go(Y)),
fail ;
% otherwise ->
true ),
!. % Get rid of repeat choice point.

However, to address exactly this problem I invented (together with my
colleague Hakan Millroth) long time ago a little device called garbage
cut (written as "!!"). For the program it meant exactly the same as cut,
except that it also collected all garbage in the part of the heap
created since the choice point. It was intended to be used in a loop
such as

loop(State0, State) :- final_state(State0), !, State0 = State.
loop(State0, State) :- trans(State0, State1), !!, loop(State1, State0).

It turned out that these garbage collections collected much garbage in
little time (since it only looks in the part of the heap which can
contain garbage, the idea of generation gc). For example, we inserted
garbage cut in a Prolog compiler so it was executed between the
compilation of each predicate. When compiling the compiler with
itself (221 predicates) we replaced two big GCs with 221 small ones.
That cut the total GC time by 60% and the page fault rate by 75%
(since the heap never grew big, in fact it was more or less constant
between predicates). We did not compare it with a fail loop but I
think that the garbage cut was marginally less efficient and
infinitely more elegant, since it (in that case) avoided asserting the
forwarded state (as in the loop above) etc. I would of course like to
see garbage cut in more Prolog implementations, anyone who would like
to read more about it can look up the Proceedings of the 1986
Symposium on Logic Programming (Salt Lake City) or UPMAIL TR 38.

--
Jonas Barklund, Computing Science Department, Uppsala University
Email jo...@csd.uu.se, phone +46-18-181050, fax +46-18-521270

0 new messages