Permalink
Browse files

Actually adding intervals. Very close to working

  • Loading branch information...
1 parent 8b8c827 commit cf0172a1fcd815540b2e6f3fc97cbc970456d7a8 @calvis committed Mar 2, 2012
Showing with 321 additions and 65 deletions.
  1. +16 −1 fd.scm
  2. +10 −3 fdtests.scm
  3. +0 −15 finite-domain.scm
  4. +295 −46 interval-domain.scm
View
17 fd.scm
@@ -3,10 +3,25 @@
(export
infd domfd =fd =/=fd <=fd <fd
plusfd timesfd distinctfd range)
- (import (rnrs) (ck) (finite-domain))
+ (import (rnrs) (ck) (interval-domain))
;;; helpers
+(define list-sorted?
+ (lambda (pred ls)
+ (cond
+ ((or (null? ls) (null? (cdr ls))) #t)
+ ((pred (car ls) (cadr ls))
+ (list-sorted? pred (cdr ls)))
+ (else #f))))
+
+(define list-insert
+ (lambda (pred x ls)
+ (cond
+ ((null? ls) (cons x '()))
+ ((pred x (car ls)) (cons x ls))
+ (else (cons (car ls) (list-insert pred x (cdr ls)))))))
+
(define pred_x
(lambda (x)
(lambda (oc)
View
@@ -28,18 +28,25 @@
;; (<=fd c 5)))
;; '((1 2 3)))
-(test-check "1^^"
+(test-check "0.0"
(run* (x)
(infd x '(1 2)))
'(1 2))
-(test-check "1^"
+(test-check "0.1"
+ (run* (x)
+ (fresh (y)
+ (infd x y '(1 2))
+ (=fd x y)))
+ '(1 2))
+
+(test-check "1.0"
(run* (x)
(infd x '(1 2))
(=/=fd x 1))
`(2))
-(test-check "1"
+(test-check "1.1"
(run* (q)
(fresh (x)
(infd x q '(1 2))
View
@@ -22,21 +22,6 @@
;; of value-doms?, with no duplicates.
(define make-dom (lambda (n*) n*))
-(define list-sorted?
- (lambda (pred ls)
- (cond
- ((or (null? ls) (null? (cdr ls))) #t)
- ((pred (car ls) (cadr ls))
- (list-sorted? pred (cdr ls)))
- (else #f))))
-
-(define list-insert
- (lambda (pred x ls)
- (cond
- ((null? ls) (cons x '()))
- ((pred x (car ls)) (cons x ls))
- (else (cons (car ls) (list-insert pred x (cdr ls)))))))
-
(define map-sum
(lambda (f)
(letrec
Oops, something went wrong.

0 comments on commit cf0172a

Please sign in to comment.