# calvis/cKanren

Actually adding intervals. Very close to working

1 parent 8b8c827 commit cf0172a1fcd815540b2e6f3fc97cbc970456d7a8 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
17 fd.scm
 @@ -3,10 +3,25 @@ (export infd domfd =fd =/=fd <=fd
 @@ -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))
 @@ -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