Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

All fd tests work with interval domains

  • Loading branch information...
commit 0c3a5b938074774d75bb8145a250c5b5a80008f1 1 parent cf0172a
@calvis authored
Showing with 38 additions and 11 deletions.
  1. +14 −6 fd.scm
  2. +24 −2 fdtests.scm
  3. +0 −3  interval-domain.scm
View
20 fd.scm
@@ -3,10 +3,15 @@
(export
infd domfd =fd =/=fd <=fd <fd
plusfd timesfd distinctfd range)
- (import (rnrs) (ck) (interval-domain))
+ (import
+ (rename (rnrs) (list-sort rnrs:list-sort))
+ (ck) (interval-domain)
+ (only (chezscheme) trace-define))
;;; helpers
+(define list-sort rnrs:list-sort)
+
(define list-sorted?
(lambda (pred ls)
(cond
@@ -161,10 +166,13 @@
(else
(let ((y (walk (car y*) s)))
(cond
- ((var? y) (loop (cdr y*) n* (cons y x*)))
- ((memv-dom? y n*) #f)
- (else (let ((n* (list-insert < y n*)))
- (loop (cdr y*) n* x*)))))))))))
+ ((var? y)
+ (loop (cdr y*) n* (cons y x*)))
+ ;; n* is NOT A DOM
+ ((memv y n*) #f)
+ (else
+ (let ((n* (list-insert < y n*)))
+ (loop (cdr y*) n* x*)))))))))))
(define exclude-from-dom
(lambda (dom1 c x*)
@@ -282,7 +290,7 @@
(define domfd-c
(lambda (x n*)
(lambdam@ (a : s c)
- ((process-dom (walk x s) (make-dom (list-sort < n*))) a))))
+ ((process-dom (walk x s) (make-dom n*)) a))))
(define-syntax infd
(syntax-rules ()
View
26 fdtests.scm
@@ -173,7 +173,29 @@
(plusfd y 3 z)))
`(3))
-(test-check "14"
+(test-check "14.0"
+ (run* (q)
+ (distinctfd `(1 2 3 4 5)))
+ `(_.0))
+
+(test-check "14.1"
+ (run* (q)
+ (distinctfd `(1 2 3 4 4 5)))
+ `())
+
+(test-check "14.2"
+ (run* (q)
+ (infd q (range 0 2))
+ (distinctfd `(,q)))
+ `(0 1 2))
+
+(test-check "14.3"
+ (run* (q)
+ (infd q (range 0 2))
+ (distinctfd `(,q ,q)))
+ `())
+
+(test-check "14.4"
(run* (q)
(fresh (x y z)
(infd x y z (range 0 2))
@@ -403,4 +425,4 @@
`(503 513 523 533 543 553 563 573 583 593))
(printf "Send More Money (multiplication)\n")
-;; (printf "~s\n" (time (run* (q) (smm-mult q))))
+(printf "~s\n" (time (run* (q) (smm-mult q))))
View
3  interval-domain.scm
@@ -11,17 +11,14 @@
;;; domains (sorted lists of integers)
-;; OK
(define range
(lambda (lb ub)
`((,lb . ,ub))))
-;; OK
(define value-dom?
(lambda (v)
(and (integer? v) (<= 0 v))))
-;; OK
(define interval?
(lambda (x)
(pair? x)))
Please sign in to comment.
Something went wrong with that request. Please try again.