Fixing Racklog cut error found by Erik Dominikus
Basically, Racklog (and all versions of schelog) implement ! by causing the failure continuation of the entire relation being returned. They did not also cause the unification caused by the relation to be un-done. However, it is not easy to separate un-doing the local changes because the unification just returns a failure continuation too. I had to call that fail continuation but use state to communicate to its target that the next clause should not be visited. I don't know if this is correct. My test suite contains a lot of cut tests that still pass. Erik's test passes too. But I'm not confident that this really works.
This commit is contained in:
parent
23226b41da
commit
3ddaf5e32b
|
@ -52,19 +52,29 @@
|
|||
(syntax-rules ()
|
||||
((%rel (v ...) ((a ...) subgoal ...) ...)
|
||||
(lambda __fmls
|
||||
(lambda (__fk)
|
||||
(let/racklog-cc __sk
|
||||
(let ((this-! (lambda (fk1) __fk)))
|
||||
(syntax-parameterize
|
||||
([! (make-rename-transformer #'this-!)])
|
||||
(%let (v ...)
|
||||
(let/racklog-cc __fk
|
||||
(let* ((__fk ((%= __fmls (list a ...)) __fk))
|
||||
(__fk ((logic-var-val* subgoal) __fk))
|
||||
...)
|
||||
(__sk __fk)))
|
||||
...
|
||||
(__fk 'fail))))))))))
|
||||
(lambda (fail-relation)
|
||||
(define cut? #f)
|
||||
(let/racklog-cc
|
||||
__sk
|
||||
(%let (v ...)
|
||||
(begin
|
||||
(let/racklog-cc
|
||||
fail-case
|
||||
(define fail-unify
|
||||
((%= __fmls (list a ...))
|
||||
fail-case))
|
||||
(define this-!
|
||||
(lambda (fk1)
|
||||
(set! cut? #t)
|
||||
fail-unify))
|
||||
(syntax-parameterize
|
||||
([! (make-rename-transformer #'this-!)])
|
||||
(__sk
|
||||
((%and subgoal ...) fail-unify))))
|
||||
(when cut?
|
||||
(fail-relation 'fail)))
|
||||
...
|
||||
(fail-relation 'fail))))))))
|
||||
|
||||
(define %fail
|
||||
(lambda (fk) (fk 'fail)))
|
||||
|
|
19
collects/tests/racklog/pr/pr-ed.rkt
Normal file
19
collects/tests/racklog/pr/pr-ed.rkt
Normal file
|
@ -0,0 +1,19 @@
|
|||
#lang racket
|
||||
(require racklog)
|
||||
|
||||
(define %a
|
||||
(%rel (x)
|
||||
((x) (%b x))
|
||||
((x) (%c x))
|
||||
))
|
||||
|
||||
(define %b
|
||||
(%rel ()
|
||||
((1) !)
|
||||
((2))))
|
||||
|
||||
(define %c
|
||||
(%rel ()
|
||||
((2))))
|
||||
|
||||
(%find-all (x) (%a x))
|
Loading…
Reference in New Issue
Block a user