From 76b23bc8837adad50be12aa759dcfce5bd4b2787 Mon Sep 17 00:00:00 2001 From: Teddy Date: Mon, 12 Aug 2013 13:57:56 +0800 Subject: more tests --- test/robust_test.scm | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 75 insertions(+), 1 deletion(-) (limited to 'test') diff --git a/test/robust_test.scm b/test/robust_test.scm index 30f24f2..ed5dbfb 100644 --- a/test/robust_test.scm +++ b/test/robust_test.scm @@ -297,7 +297,7 @@ x res) (display (queen 8)) - +(display "\n") (display "Test Bibonacci numbers: \n") (define (f x) (if (<= x 2) 1 (+ (f (- x 1)) (f (- x 2))))) @@ -319,3 +319,77 @@ x #f (and (display (g i)) (display "\n") (all (+ i 1) n)))) (all 1 100) + +(display "Test Eval: \n") +(eval + '(define (shl bits) + (define len (vector-length bits)) + (define res (make-vector len)) + (eval + '(define (copy i) + (if (= i (- len 1)) + #t + (and + (vector-set! res i + (vector-ref bits (+ i 1))) + (copy (+ i 1)))))) + (copy 0) + (vector-set! res (- len 1) #f) + res)) + +(eval + '(define (shr bits) + (define len (vector-length bits)) + (define res (make-vector len)) + (define (copy i) + (if (= i (- len 1)) + #t + (and + (vector-set! res (+ i 1) + (vector-ref bits i)) + (copy (+ i 1))))) + (copy 0) + (vector-set! res 0 #f) + res)) + +(define (empty-bits len) (make-vector len #f)) +(define vs vector-set!) +(define vr vector-ref) +(define res 0) +(define (queen n) + (eval + '(define (search l m r step) + (define (col-iter c) + (if (= c n) + #f + (and + (if (and (eq? (vr l c) #f) + (eq? (vr r c) #f) + (eq? (vr m c) #f)) + (eval + '(and + (vs l c #t) + (vs m c #t) + (vs r c #t) + ((lambda () (search l m r (+ step 1)) #t)) + (vs l c #f) + (vs m c #f) + (vs r c #f))) + ) + (col-iter (+ c 1)) + ))) + (set! l (shl l)) + (set! r (shr r)) + (if (= step n) + (set! res (+ res 1)) + (col-iter 0)))) + + (eval + '(search (empty-bits n) + (empty-bits n) + (empty-bits n) + 0)) + res) + +(display (queen 8)) +(display "\n") -- cgit v1.2.3