path: root/test/robust_test.scm

(+)
(-)
(*)
(/)
(+ 0)
(- 0)
(* 0)
(/ 0)
(<)
(>)
(=)
(< 1)
(> 1)
(= 1)
(+ 0 . 0)
(+ . 0)
(- 0 . 0)
(- . 0)
(< 0 . 0)
(< . 0)

(+ 0 'a)
(- 0 'a)
(* 0 'a)
(/ 0 'a)
(< #f)
(> #f)
(= #f)

(exact?)
(exact? 'a)
(exact? 1 2)
(exact? . 0)
(exact? 0 . 0)

(inexact?)
(inexact? 'b)
(inexact? 1 2)
(inexact? . 0)
(inexact? 0 . 0)

(not)
(not 1 2)
(not 1)
(not #f)
(not '())
(not . 0)
(not 0 . 0)

(boolean?)
(boolean? 1 2)
(boolean? 1)
(boolean? #t)
(boolean? . 0)
(boolean? 0 . 0)

(pair?)
(pair? 1 2)
(pair? '())
(pair? (cons 1 2))
(pair? '(3 . 4))
(pair? 3)
(pair? . 0)
(pair? 0 . 0)

(cons)
(cons 1)
(cons 1 2 3)
(cons 'a '())
(cons . 0)
(cons 0 . 0)


(define t (cons 'a '()))

(car)
(car 1)
(car 1 2)
(car '())
(car t)
(car . 0)
(car 0 . 0)

(cdr)
(cdr 1)
(cdr 1 2)
(cdr '())
(cdr t)
(cdr . 0)
(cdr 0 . 0)

(set-car!)
(set-car! 1)
(set-car! 1 2)
(set-car! t '())
t
(set-car! . 0)
(set-car! 0 . 0)

(set-cdr!)
(set-cdr! 1)
(set-cdr! 1 2)
(set-cdr! t 'a)
t
(set-cdr! . 0)
(set-cdr! 0 . 0)

(null?)
(null? 1 2)
(null? 1)
(null? '())
(null? #f)
(null? . 0)
(null? 0 . 0)

(list?)
(list? 1 2)
(list? '())
(list? t)
(set-cdr! t '())
t
(list? t)
(list? . 0)
(list? 0 . 0)

(list)
(list 1)
(list 1 2)
(list . 0)
(list 0 . 0)

(length)
(length 1 2)
(length '( 1 . 2))
(length '())
(length '( 1 2 3 ))

(append)
(append '())
(append '(1 2) 3)
(append '(1 2) '(3 4) 5)
(append '(1 2) 3 '(1))
(append '() '() '() '(1 2) 3)

(display)
(display 1 2)
(display . 0)
(display 0 . 0)
(display t)

(define)
(define x)
(define 1)
(define x x)
(define x 1 2)
(define x . 1)
(define x 1 . 2)
(define ())
(define (f))
(define (f . ) 1)
(define () 3)

(lambda)
(lambda ())
(lambda 1)
(lambda () '(1 2 3))
(lambda () 1 2 3)
(lambda #() 1)

(define src
  '(define g (lambda (x) (if (= x 5) 0 ((lambda () (display x) (g (+ x 1))))))))
src
(eval src)
(eval '(g 0))
(eval (list * 2 3))
(eval '(* 2 3))

(define f (lambda (x) (+ x x))) ;; test comments
((lambda (x y) (f 3)) 1 2)      ;; first-class procedure
; this is a single line comment
; another line
(define f (lambda (x) (lambda (y) (+ x y))))

(f 1)   ; #<procedure>

((f 1) 2) ; 3

(define g (lambda (x) (define y 2) (+ x y)))
(g 3)

((lambda () (display 2) (display 1) (+ 1 2)))
(define g (lambda (x) (if (= x 5) 0 ((lambda () (display x) (g (+ x 1)))))))
(g 0)

(define g (lambda (x)
            (if (= x 5)
              0
              ((lambda ()
                 (display x)
                 (g (+ x 1)))))))
(g 0)

(define square (lambda (x) (* x x)))

(square 2)

(define (f x y)
  ((lambda (a b)
	 (+ (* x (square a))
		(* y b)
		(* a b)))
   (+ 1 (* x y ))
   (- 1 y)))

(f 1 2)

((lambda (x + y) (+ x y)) 4 / 2) ; a classic trick

(if #t 1 ())
(if #f 1 ()) ; Error
; "Test double quotes in comments"
(display " Test double quotes outside the comments ; ;; ; ; ")

(equal? #(1 2 '()) #(1 2 '(1)))
(equal? #(1 2 '(1)) #(1 2 '(1)))

(define x '(1 . 1))
(set-cdr! x x)
(list x)
x
(cons x  x)

(display "Test the eight queen puzzle: \n")
(define (shl bits)
  (define len (vector-length bits))
  (define res (make-vector len))
  (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)

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

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

  (search (empty-bits n)
          (empty-bits n)
          (empty-bits n)
          0)
  res)

(display (queen 8))
(display "\n")
(display "Test Bibonacci numbers: \n")
(define (f x)
  (if (<= x 2) 1 (+ (f (- x 1)) (f (- x 2)))))
(f 1)
(f 2)
(f 3)
(f 4)
(f 5)

(define (g n)
  (define (f p1 p2 n)
    (if (<= n 2)
      p2
      (f p2 (+ p1 p2) (- n 1))))
  (f 1 1 n))

(define (all i n)
  (if (= n i)
    #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")

(define prom (delay (and (display "world\n") (lambda () 3))))
(define prom2 (delay (and (display "hello\n") (force prom))))
(force prom2)
(force prom2)
(force prom2)
(force prom2)