Permalink
Browse files

Changing tests into libraries, fixing some typos

  • Loading branch information...
1 parent 620bdfd commit fe0bbb1057b4fa982d3ee7ca93a70e101572cb72 @calvis committed Apr 16, 2012
Showing with 1,469 additions and 1,463 deletions.
  1. +67 −58 comptests.scm
  2. +419 −422 fdtests.scm
  3. +445 −423 miniKanren.scm
  4. +436 −451 neqtests.scm
  5. +0 −1 never-true.scm
  6. +46 −35 nevertruetests.scm
  7. +40 −69 pref.scm
  8. +3 −1 preftests.scm
  9. +13 −3 testall.scm
View
@@ -1,66 +1,75 @@
-(import (cKanren ck))
-(import (cKanren neq))
-(import (cKanren tree-unify))
+(library (cKanren comptests)
+ (export run-comptests)
+ (import
+ (rnrs)
+ (cKanren ck)
+ (cKanren neq)
+ (cKanren fd)
+ (cKanren tester)
+ (cKanren tree-unify))
-(define n-queenso
- (lambda (q n)
- (let loop ((i n) (l '()))
- (cond
- ((zero? i)
- (fresh ()
- (== q l)
- (distinctfd l)
- (diagonalso n l)))
- (else
- (fresh (x)
- (infd x (range 1 n))
- (loop (sub1 i) (cons x l))))))))
+ (define n-queenso
+ (lambda (q n)
+ (let loop ((i n) (l '()))
+ (cond
+ ((zero? i)
+ (fresh ()
+ (== q l)
+ (distinctfd l)
+ (diagonalso n l)))
+ (else
+ (fresh (x)
+ (infd x (range 1 n))
+ (loop (- i 1) (cons x l))))))))
-(define diagonalso
- (lambda (n l)
- (let loop ((r l) (s (cdr l)) (i 0) (j 1))
- (cond
- ((or (null? r) (null? (cdr r))) succeed)
- ((null? s) (loop (cdr r) (cddr r) (+ i 1) (+ i 2)))
- (else
- (let ((qi (car r)) (qj (car s)))
- (fresh ()
- (diago qi qj (- j i) (range 0 (* 2 n)))
- (loop r (cdr s) i (+ j 1)))))))))
+ (define diagonalso
+ (lambda (n l)
+ (let loop ((r l) (s (cdr l)) (i 0) (j 1))
+ (cond
+ ((or (null? r) (null? (cdr r))) succeed)
+ ((null? s) (loop (cdr r) (cddr r) (+ i 1) (+ i 2)))
+ (else
+ (let ((qi (car r)) (qj (car s)))
+ (fresh ()
+ (diago qi qj (- j i) (range 0 (* 2 n)))
+ (loop r (cdr s) i (+ j 1)))))))))
-(define diago
- (lambda (qi qj d rng)
- (fresh (si sj)
- (infd si sj rng)
- (=/=fd qi sj)
- (plusfd qi d si)
- (=/=fd qj si)
- (plusfd qj d sj))))
+ (define diago
+ (lambda (qi qj d rng)
+ (fresh (si sj)
+ (infd si sj rng)
+ (=/=fd qi sj)
+ (plusfd qi d si)
+ (=/=fd qj si)
+ (plusfd qj d sj))))
-(define distincto
- (lambda (l)
- (conde
- ((== l '()))
- ((fresh (a) (== l `(,a))))
- ((fresh (a ad dd)
- (== l `(,a ,ad . ,dd))
- (=/= a ad)
- (distincto `(,a . ,dd))
- (distincto `(,ad . ,dd)))))))
+ (define distincto
+ (lambda (l)
+ (conde
+ ((== l '()))
+ ((fresh (a) (== l `(,a))))
+ ((fresh (a ad dd)
+ (== l `(,a ,ad . ,dd))
+ (=/= a ad)
+ (distincto `(,a . ,dd))
+ (distincto `(,ad . ,dd)))))))
-(test-check "Distinct Queens 1"
- (run* (q)
- (fresh (x)
- (n-queenso x 8)
- (distincto x)))
- '(_.0))
+ (define (run-comptests)
-(test-check "Distinct Queens 2"
- (let ((answers (run* (q) (n-queenso q 4))))
- (run* (q) (distincto answers)))
- '(_.0))
+ (test-check "Distinct Queens 1"
+ (run* (q)
+ (fresh (x)
+ (n-queenso x 8)
+ (distincto x)))
+ '(_.0))
-(test-check "infd/Distinct 1"
- (run* (q) (infd q '(2 3 4)) (distincto `(a 3 ,q)))
- '(2 4))
+ (test-check "Distinct Queens 2"
+ (let ((answers (run* (q) (n-queenso q 4))))
+ (run* (q) (distincto answers)))
+ '(_.0))
+ (test-check "infd/Distinct 1"
+ (run* (q) (infd q '(2 3 4)) (distincto `(a 3 ,q)))
+ '(2 4)))
+
+ )
Oops, something went wrong.

0 comments on commit fe0bbb1

Please sign in to comment.