tabling works much better with negations

parent aa83a415
......@@ -292,7 +292,6 @@
;; this will try to make a success and if so reset the state and continue
;; it's a companion to <not>.
(define-guile-log <succeds>
(syntax-rules ()
((_ (cut s p cc) g ...)
......@@ -445,16 +444,31 @@
(parse<> (cut ss pp cc) (<and> code ...)))))))
(ccc s p)))))
#|
For tabling, negations are tricky. the reason is that when a recursive application runs out of solutions it issues a fail, which in case the mode is not mode will produce a success. What we must make sure is that if a not is delayed, then the not will also be delayed and hence the not will fail at all levels e.g. the code stops at all negations, a delay that hits an or will try the next branches as well but if all or's fails, then the result is a delay so basically delay is a state of a not.
|#
(define gp-not-n (gp-make-var 0))
(define gp-is-delayed? (gp-make-var #f))
(define-guile-log <not>
(syntax-rules ()
((_ (cut s p cc) code ...)
(let* ((ss (gp-newframe s))
(ccc (lambda x (p)))
(ppp (lambda ()
(ss2 (gp-set! gp-not-n (+ (gp-lookup gp-not-n s) 1) ss))
(ccc (lambda x
(gp-unwind ss)
(cc ss p))))
(parse<> (ppp ss ppp ccc) (<and> code ...))))))
(p)))
(ppp (lambda ()
(let ((n (gp-lookup gp-not-n ss2))
(d (gp-lookup gp-is-delayed? ss2)))
(gp-unwind ss)
(if (and (> n 1) d)
(begin
(gp-set! gp-is-delayed? #t ss)
(p))
(cc ss p))))))
(parse<> (ppp ss2 ppp ccc) (<and> code ...))))))
(define-guile-log <when>
(syntax-rules ()
......
......@@ -184,6 +184,13 @@ Also it is possible to solve inifinite recursion.
(<define> (memo-ref f x) (<=> x ,(hashq-ref memo f #f)))
(<define> (rec-ref f x) (<=> x ,(vhashq-ref (fluid-ref recs) f #f)))
(<define> (table-ref f x) (<=> x ,(vhashq-ref (fluid-ref tables) f #f)))
(<define> (my-postpone . x)
(<let> ((n (<lookup> (@@ (logic guile-log) gp-not-n))))
(if (odd? n)
(<set> (@@ (logic guile-log) gp-is-delayed?) #t)
<cc>)
(<apply> postpone x)))
(define do-tabling
(<case-lambda>
((f tag x first)
......@@ -196,11 +203,11 @@ Also it is possible to solve inifinite recursion.
(<let> ((L0 (memo-ref0 f tag vlist-null)))
(<vhash-fold> P () (key val) next L0
(<and>
(postpone 1 1)
(my-postpone 1 1)
(<recur> lp1 ()
(<let> ((L1 (memo-ref0 f tag '())))
(if (eq? L0 L1)
(<and> (postpone) (lp1))
(<and> (my-postpone) (lp1))
(lp L0 fail?)))))
(if (eq? key #t)
......
......@@ -14,6 +14,10 @@ ff(X) :- (X=[Y,A,B]),ff(A),ff(B),(Y=1;Y=2).
-functorize(with_canon).
f(X) :- ff(X).
-functorize(tabling).
f2(X) :- \\+f2(X).
-functorize(tabling).
f3(X) :- X=[1|Y],\\+\\+f3(Y).
")
(compile-prolog-string
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment