more tests

1 files changed, 75 insertions, 1 deletions

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")