(import (scheme base)
        (scheme char)
        (scheme file)
        (scheme lazy)
        (scheme read)
        (scheme write)
        (scheme eval)
( srfi 9 )
)

(define *num-passed* 0)
(define (assert:equal msg actual expected)
  (if (not (equal? actual expected))
      (error "Unit test failed [" msg "] actual [" actual "] expected [" expected "]")
      (set! *num-passed* (+ *num-passed* 1))))

(define (assert:not-equal msg x y)
  (assert:equal msg (not (equal? x y)) #t))

(define (assert msg val)
  (assert:equal msg (not val) #f))

(assert "Testing assert function" #t)
(assert "Testing assert function" 1)

;; Quotation / Quasi-quotes
(assert:equal "quasi-quote #1" `(read ,(+ 1 2 3)) '(read 6))
(assert:equal "quasi-quote #2" `(read ,(list 1 2 3)) '(read (1 2 3)))
(assert:equal "quasi-quote splicing" `(read ,@(list 1 2 3)) '(read 1 2 3))

;; Lists
(define l (list 'a 'b 'c))
  TODO : seems to break eval below , is there a GC problem with a circular list ?
;(set-cdr! l l)
(set-cdr! l '(c b)) ; Above seems to break if it replaces this line
(assert:equal "list? on circular list" (list? l) #t)

;; Circular data structures
(define v1 (vector #f))
(define v2 (vector v1))
(vector-set! v1 0 v2)
(cond-expand
  (memory-streams
   (let ((fp (open-output-string)))
     (display v1 fp)
     (assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))))
(assert:equal "equality on circular vectors" (equal? v1 v2) #t)
(newline)

(define v1 (vector 1 2 3))
(define v2 (vector 1 v1 3))
(vector-set! v1 1 v2)
(cond-expand
 (memory-streams
  (let ((fp (open-output-string)))
    (write v1 fp)
    (assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))))
(assert:equal "equality on circular vectors, test 2" (equal? v1 v2) #t)
(newline)

(define l1 (list #f))
(define l2 (list l1))
(set-cdr! l1 l2)
(cond-expand
  (memory-streams
   (let ((fp (open-output-string)))
     (display l1 fp)
     (assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))))
(assert:equal "equality on circular lists" (equal? l1 l2) #f)

(define l1 (list 1 2 3))
(define l2 (list 1 l1 3))
(set-cdr! (cdr l1) l2)
(cond-expand
  (memory-streams
   (let ((fp (open-output-string)))
     (write l1 fp)
     (assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))))
(assert:equal "equality on circular lists, test 2" (equal? l1 l2) #f)

;; Adder example
(define (make-adder x)
  (lambda (y) (+ x  y)))
(define increment (make-adder +1))
(assert:equal "Adder #1" (increment 41) 42)
(define decrement (make-adder -1))
(assert:equal "Adder #2" (decrement 42) 41)

(assert:equal "Application example"
  ((lambda (x) x) (+ 41 1))
  42)

;; Apply section
(assert:equal "" (apply length '((#t #f))) 2)
(assert:equal "" (apply cons '(#t #f)) '(#t . #f))
(assert:equal "" (apply cadr (list (list 1 2 3 4))) 2)
(assert:equal "" (apply null? (list '())) #t)
  
(define (list2 a b . objs) objs)
(assert:equal "apply varargs" (list 42 1) '(42 1))
(assert:equal "apply varargs" (list 42 1 2) '(42 1 2))
(assert:equal "apply varargs" (list2 42 1) '())
(assert:equal "apply varargs" (list2 42 1 2) '(2))

(assert:equal "begin" (begin 1 2 (+ 1 2) (+ 3 4)) 7)

;; Continuation section
(assert:equal
    "simple call/cc"
    (call/cc
      (lambda (k)
        (k 2)))
    2)
(assert:equal "escape continuation"
    (call/cc
      (lambda (return)
        (begin
          (return 'return))))
    'return)

;; Closure section
(assert:equal "simple closure"
  (((lambda (x.1) 
    (lambda (y.2) 
      (cons x.1 y.2))) #t) #f)
 '(#t . #f))
(assert:equal "closure #2"
  ((lambda (x y)
    ((lambda () (- x y)))) 5 4)
  1)

;; Anonymous lambda's
(assert:equal "execute anonymous lambda" ((lambda (a . Y) Y) 'x) '())
(assert:equal "execute anonymous lambda" ((lambda (a . Y) Y) 'x 'y) '(y))
(assert:equal "execute anonymous lambda" ((lambda (a . Y) Y) 'x 'y 'z) '(y z)) 
(assert:equal "execute anonymous lambda" ((lambda (a b . Y) Y) 'x 'y 'z) '(z))
(assert:equal "execute anonymous lambda" ((lambda Y Y) 'x 'y 'z) '(x y z))
(assert:equal "execute anonymous lambda" ((lambda Y Y) ) '())

;; Factorial
(define (fac n) (if (= n 0) 1 (* n (fac (- n 1)))))
(assert:equal "Factorial example" (fac 10) 3628800)

;; If section
(assert:equal "if example" (if #t 1 2) 1)
(assert:equal "if example" (if #f 1 2) 2)
(assert:equal "if example" (if (+ 1 2) (+ 3 4) (* 3 4)) 7)
(assert:equal "if" (if ((lambda (x) (+ x 1)) 0) (+ 1 1) (* 0 0)) 2)
(assert:equal "no else clause" (if #t 'no-else-clause) 'no-else-clause)

(assert:equal "" (+ (+ 1 1) (* 3 4)) 14)

;; Set section
((lambda (x)
  ( + 2 ( * 3 4 ) ) )
    (assert:equal "set local x" x #t))
 #f)

(define a (list #f #f))
(define b (cons #f #f))

(set-car! a 1)
(set-cdr! a '(2))
(assert:equal "set car/cdr a" a '(1 2))
(set-cdr! a 2)
(set-car! b '(#t))
(set-cdr! b '#t)

(assert:equal "set a" a '(1 . 2))
(assert:equal "set b" b '((#t) . #t))

;; Scoping example
(define scope #f)
(assert:equal "outer scope" scope #f)
((lambda (scope)
    (assert:equal "inner scope" scope #t)
 ) #t)

;; Square example
(let ((x 10) 
      (y 20) 
      (square (lambda (x) (* x x)))) 
  (begin 
    (assert:equal "square x" (square x) 100) 
    (assert:equal "square y" (square y) 400)))

;; String section
(define a "a0123456789")
(assert:equal "string eq" a "a0123456789")
(assert:not-equal "string eq" a 'a0123456789)
(define b "abcdefghijklmnopqrstuvwxyz")
(define c "hello, world!")
(define d (list->string '(#\( #\" #\a #\b #\c #\" #\))))
(assert:equal "strings" d "(\"abc\")")
  Test GC
  Test GC
(set! a "hello 2")
(assert:equal "strings" a "hello 2")
(define (f) (make-string 3 #\*))
(define (g) "***")
(assert:equal "string-set!" (string-set! (f) 0 #\?) "?**")
(define a "12345")
(define b (string-copy "abcde"))
(assert:equal "string-copy!" (string-copy! b 1 a 0 2) "a12de")
(let ((v '()))
  (string-for-each
    (lambda (c) (set! v (cons (char->integer c) v)))
    "abcde")
  (assert:equal "string-for-each" v '(101 100 99 98 97)))

(assert:equal "interline whitespace" "1 2 \      
3 4" "1 2 3 4")

(assert:equal "interline whitespace" "1 2 \


3 4" "1 2 \n\n3 4")

;; UTF-8 / Strings
(assert:equal "UTF8 string length" (string-length (make-string 1 (integer->char 128))) 1)
(assert:equal "UTF8 bv length" (bytevector-length (string->utf8 (make-string 1 (integer->char 128)))) 2)
(assert:equal "UTF8 char" (string-ref (make-string 1 (integer->char 128)) 0) #\x80)

;; Recursion example:
(letrec ((fnc (lambda (i) 
                (begin
                    ;(display i)
                    (if (> i 0) (fnc (- i 1)) 0)))))
    (fnc 10))

(assert:equal "numeric small reverse" (reverse '(1 2)) '(2 1))
(assert:equal "small reverse" (reverse '(a b c)) '(c b a))
(assert:equal "larger reverse" (reverse '(1 2 3 4 5 6 7 8 9 10)) '(10 9 8 7 6 5 4 3 2 1))
   ; TODO : improper list , this is an error : ( reverse ' ( 1 . 2 ) )
(assert:equal "char whitespace" (char-whitespace? #\space) #t)
(assert:equal "char whitespace" (char-whitespace? #\a) #f)
(assert:equal "char numeric" (char-numeric? #\1) #t)
(assert:equal "char numeric" (char-numeric? #\newline) #f)
(assert:equal "" (and 1 2 3) 3)
(assert:equal "" (and #t #f 'a 'b 'c) #f)
(assert:equal "" (or 1 2 3) 1)
(assert:equal "" (or #f 'a 'b 'c) 'a)
(assert:equal "" (string-append "") "")
error - ( string - append 1 )
(assert:equal "" (string-append "test") "test")
(assert:equal "" (string-append "ab" "cdefgh ij" "klmno" "p" "q" "rs  " "tuv" "w" " x " "yz")
  "abcdefgh ijklmnopqrs  tuvw x yz")
(assert:equal "" (string->number "0") 0)
(assert:equal "" (string->number "42") 42)
;(assert:equal "" (string->number "343243243232") ;; Note no bignum support
(assert:equal "" (string->number "3.14159") 3.14159)
(assert:equal "" (list->string (list #\A #\B #\C)) "ABC")
(assert:equal "" (list->string (list #\A)) "A")
(assert:equal "" (list->string (list)) "") 
(assert:equal "" (integer->char 65) #\A)
(assert:equal "" (char->integer #\a) 97)

(assert:equal "" (number->string (+ 1 2)) "3")
(assert:equal "" (string->list "test") '(#\t #\e #\s #\t))
(assert:equal "" (string->symbol "a-b-c-d") 'a-b-c-d)
(assert:equal "" (symbol->string 'a/test-01) "a/test-01")
(assert:equal "" (eq? 'a-1 'a-1) #t)
(assert:equal "" (eq? (string->symbol "aa") 'aa) #t)
(assert:equal "" (eq? 0.0 0.0) #f)
(assert:equal "" (eq? 33333333333333 33333333333333) #f)
(assert:equal "" (eqv? 'a-1 'a-1) #t)
(assert:equal "" (eqv? (string->symbol "aa") 'aa) #t)
(assert:equal "" (eqv? 0.0 0.0) #t)
(assert:equal "" (eqv? 33333333333333 33333333333333) #t)
(assert:equal "" (equal? (string->symbol "aa") 'aa) #t)

;; Map
(assert:equal "map 1" (map (lambda (x) (car x)) '((a . b) (1 . 2) (#\h #\w))) '(a 1 #\h))
(assert:equal "map 2" (map car '((a . b) (1 . 2) (#\h #\w))) '(a 1 #\h))
(assert:equal "map 3" (map cdr '((a . b) (1 . 2) (#\h #\w))) '(b 2 (#\w)))
(assert:equal "map length"
  (map length '(() (1) (1 2) (1 2 3) (1 2 3 4)))
 '(0 1 2 3 4))

;; Prove internal defines are compiled properly
;;
;; Illustrates an old problem with compiling parser.
;; how to handle the internal define p?
;; trans was trying to wrap p with a lambda, which is not going to
;; work because callers want to pass a,b,c directly.
(define (glob a b c)
  (define (p d)
    (list a b c d))
  (p 4))
(assert:equal "internal defs for global funcs"
        (glob 1 2 3)
       '(1 2 3 4))

;; Global shadowing issue
;; Do not allow global define to shadow local ones
(define x 'global)
((lambda ()
  (define x 1)
  ((lambda ()
    (define x 2)
    (assert:equal "local define of x" x 2)))
  (assert:equal "another local define of x" x 1)))
(assert:equal "global define of x" x 'global)

; TODO: could add parser tests for these
;(
;123(list)
1'b
;(write
;  (list
   1;2
;  ))
1;2
3"four five "
;#\space
;)

  EVAL section
(define x 1)
(define y 2)
(define *z* 3)
;(write (eval '(Cyc-global-vars)))
(assert:equal "eval compiled - x" (eval 'x) x)
(eval '(set! x 'mutated-x))
(assert:equal "Access var with a mangled name" (eval '*z*) *z*)
(assert:equal "Access compiled var mutated by eval" x 'mutated-x)
;; END eval


;; Vectors

(assert:equal "vector-ref" (vector-ref #(1 1 2 3 5 8 13 21) 5) 8)
(assert:equal "vector-set!" (vector-set! #(0 '(2 2 2 2) "anna") 1 "test") #(0 "test" "anna"))
(assert:equal "vector->list" (vector->list #(dah dah didah))
                            '(dah dah didah))
( vector->list    ) 1 2 )
;=. (dah)
(assert:equal "list->vector" (list->vector '(dididit dah))
                             #(dididit dah))

(assert:equal "string->vector" (string->vector "ABC")  #(#\A #\B #\C))
(assert:equal "vector->string" (vector->string #(#\1 #\2 #\3)) "123")

(define a (vector 1 2 3 4 5))
(define b (vector 10 20 30 40 50))
(vector-copy! b 1 a 0 2)
(assert "vector-copy!" (equal? b #(10 1 2 40 50)))

(define a (vector 1 2 3 4 5))
(vector-fill! a 'smash 2 4)
(assert:equal "vector-fill!" a #(1 2 smash smash 5))
;; END vectors

;; I/O
(with-output-to-file 
  "test.out" 
  (lambda ()
    (write 'hello-world)))
;(write "done with output")
(with-input-from-file
  "test.out"
  (lambda ()
    (assert:equal "I/O with-*-file test" (read) 'hello-world)))
  Note : was a good test , did not always work in icyc
(call-with-input-file "test.txt" (lambda (port) (assert:equal "read input" (read port) 'ok)))
;(write "done with input")
  TODO : ( delete - file " test.out " )
;; TODO: (delete-file "test.txt")
;; END I/O

  Macros
(define-syntax test 
  (er-macro-transformer
     (lambda (expr rename compare)
       (cond ((null? (cdr expr)) #t)
             ((null? (cddr expr)) (cadr expr))
             (else (list (rename 'if) (cadr expr)
                         (cons (rename 'and) (cddr expr))
                         #f))))))

(define-syntax test2
  (er-macro-transformer
     (lambda (expr rename compare)
       (test 1 2)
       (test 1 2 3)
       (and ''test ''test2))))

(define-syntax indirect-def
 (syntax-rules ()
  ( (indirect-def x y)
    (begin
     (define z y)
     (define x z) ) ) ) )

(define x 42)
(assert:equal "macro: test2" (test2 1 2 3) 'test2)
(assert:equal "macro: test" (test 1 2 3) 3)
(assert:equal "macro: eval test" (eval '(test 1 2 x)) x)

(assert:equal "macro: define syntax indirect-def" 
  (indirect-def a 3)
  '(3))

(assert:equal "macro: let syntax indirect-def" 
 (let-syntax 
  ( (indirect-def
     (syntax-rules ()
      ( (indirect-def x y)
        (begin
         (define z y)
         (define x z) ) ) ) ) )
  (indirect-def a 3)
  a)
 '3)
;; END macros

;; Record types
(define-record-type <pare>
  (kons x y)
  pare?
  (x kar set-kar!)
  (y kdr))

(define-record-type <point>
  (point x y)
  point?
  (x get-x set-x!)
  (y get-y set-y!)
  (z get-z set-z!))

(assert:equal "Records predicate (t)" (pare? (kons 1 2)) #t)
(assert:equal "Records predicate (f)" (pare? (cons 1 2)) #f)
(assert:equal "Records kar" (kar (kons 1 2)) 1)
(assert:equal "Records kdr" (kdr (kons 1 2)) 2)
(assert:equal "Records setter"
  (let ((k (kons 1 2)))
    (set-kar! k 3)
    (kar k))
  3)
(assert:equal "Record type predicate (t)" (record? (kons 1 2)) #t)
(assert:equal "Record type predicate (f)" (record? (cons 1 2)) #f)

(assert:equal "Record type field not in constructor (f)" (get-z (point 1 2)) #f)
(let ((p (point 1 2)))
  (set-z! p 99)
  (assert:equal "Record type get field not in constructor" (get-z p) 99))
;; END records

;; Lazy evaluation
(assert:equal "Basic lazy" (force (delay (+ 1 2))) 3)
(assert:equal "Lazy test #2"
  (let ((p (delay (+ 1 2))))
    (list (force p) (force p)))
  '(3 3))
((lambda ()
  (define integers
    (letrec ((next
              (lambda (n)
                (delay (cons n (next (+ n 1)))))))
      (next 0)))
  (define head
    (lambda (stream) (car (force stream))))
  (define tail
    (lambda (stream) (cdr (force stream))))
  (assert:equal "Lazy #3" (head (tail (tail integers))) 2)))


; TODO: use display, output without surrounding quotes
(display (list *num-passed* "tests passed with no errors"))
(newline)
;;

 Quotation / Quasi-quotes
 Lists
(set-cdr! l l)
 Above seems to break if it replaces this line
 Circular data structures
 Adder example
 Apply section
 Continuation section
 Closure section
 Anonymous lambda's
 Factorial
 If section
 Set section
 Scoping example
 Square example
 String section
 UTF-8 / Strings
 Recursion example:
(display i)
 TODO : improper list , this is an error : ( reverse ' ( 1 . 2 ) )
(assert:equal "" (string->number "343243243232") ;; Note no bignum support
 Map
 Prove internal defines are compiled properly

 Illustrates an old problem with compiling parser.
 how to handle the internal define p?
 trans was trying to wrap p with a lambda, which is not going to
 work because callers want to pass a,b,c directly.
 Global shadowing issue
 Do not allow global define to shadow local ones
 TODO: could add parser tests for these
(
123(list)
(write
  (list
2
  ))
2
#\space
)
(write (eval '(Cyc-global-vars)))
 END eval
 Vectors
=. (dah)
 END vectors
 I/O
(write "done with output")
(write "done with input")
 TODO: (delete-file "test.txt")
 END I/O
 END macros
 Record types
 END records
 Lazy evaluation
 TODO: use display, output without surrounding quotes

(import (scheme base)
        (scheme char)
        (scheme file)
        (scheme lazy)
        (scheme read)
        (scheme write)
        (scheme eval)
( srfi 9 )
)

(define *num-passed* 0)
(define (assert:equal msg actual expected)
  (if (not (equal? actual expected))
      (error "Unit test failed [" msg "] actual [" actual "] expected [" expected "]")
      (set! *num-passed* (+ *num-passed* 1))))

(define (assert:not-equal msg x y)
  (assert:equal msg (not (equal? x y)) #t))

(define (assert msg val)
  (assert:equal msg (not val) #f))

(assert "Testing assert function" #t)
(assert "Testing assert function" 1)

(assert:equal "quasi-quote #1" `(read ,(+ 1 2 3)) '(read 6))
(assert:equal "quasi-quote #2" `(read ,(list 1 2 3)) '(read (1 2 3)))
(assert:equal "quasi-quote splicing" `(read ,@(list 1 2 3)) '(read 1 2 3))

(define l (list 'a 'b 'c))
  TODO : seems to break eval below , is there a GC problem with a circular list ?
(assert:equal "list? on circular list" (list? l) #t)

(define v1 (vector #f))
(define v2 (vector v1))
(vector-set! v1 0 v2)
(cond-expand
  (memory-streams
   (let ((fp (open-output-string)))
     (display v1 fp)
     (assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))))
(assert:equal "equality on circular vectors" (equal? v1 v2) #t)
(newline)

(define v1 (vector 1 2 3))
(define v2 (vector 1 v1 3))
(vector-set! v1 1 v2)
(cond-expand
 (memory-streams
  (let ((fp (open-output-string)))
    (write v1 fp)
    (assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))))
(assert:equal "equality on circular vectors, test 2" (equal? v1 v2) #t)
(newline)

(define l1 (list #f))
(define l2 (list l1))
(set-cdr! l1 l2)
(cond-expand
  (memory-streams
   (let ((fp (open-output-string)))
     (display l1 fp)
     (assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))))
(assert:equal "equality on circular lists" (equal? l1 l2) #f)

(define l1 (list 1 2 3))
(define l2 (list 1 l1 3))
(set-cdr! (cdr l1) l2)
(cond-expand
  (memory-streams
   (let ((fp (open-output-string)))
     (write l1 fp)
     (assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))))
(assert:equal "equality on circular lists, test 2" (equal? l1 l2) #f)

(define (make-adder x)
  (lambda (y) (+ x  y)))
(define increment (make-adder +1))
(assert:equal "Adder #1" (increment 41) 42)
(define decrement (make-adder -1))
(assert:equal "Adder #2" (decrement 42) 41)

(assert:equal "Application example"
  ((lambda (x) x) (+ 41 1))
  42)

(assert:equal "" (apply length '((#t #f))) 2)
(assert:equal "" (apply cons '(#t #f)) '(#t . #f))
(assert:equal "" (apply cadr (list (list 1 2 3 4))) 2)
(assert:equal "" (apply null? (list '())) #t)
  
(define (list2 a b . objs) objs)
(assert:equal "apply varargs" (list 42 1) '(42 1))
(assert:equal "apply varargs" (list 42 1 2) '(42 1 2))
(assert:equal "apply varargs" (list2 42 1) '())
(assert:equal "apply varargs" (list2 42 1 2) '(2))

(assert:equal "begin" (begin 1 2 (+ 1 2) (+ 3 4)) 7)

(assert:equal
    "simple call/cc"
    (call/cc
      (lambda (k)
        (k 2)))
    2)
(assert:equal "escape continuation"
    (call/cc
      (lambda (return)
        (begin
          (return 'return))))
    'return)

(assert:equal "simple closure"
  (((lambda (x.1) 
    (lambda (y.2) 
      (cons x.1 y.2))) #t) #f)
 '(#t . #f))
(assert:equal "closure #2"
  ((lambda (x y)
    ((lambda () (- x y)))) 5 4)
  1)

(assert:equal "execute anonymous lambda" ((lambda (a . Y) Y) 'x) '())
(assert:equal "execute anonymous lambda" ((lambda (a . Y) Y) 'x 'y) '(y))
(assert:equal "execute anonymous lambda" ((lambda (a . Y) Y) 'x 'y 'z) '(y z)) 
(assert:equal "execute anonymous lambda" ((lambda (a b . Y) Y) 'x 'y 'z) '(z))
(assert:equal "execute anonymous lambda" ((lambda Y Y) 'x 'y 'z) '(x y z))
(assert:equal "execute anonymous lambda" ((lambda Y Y) ) '())

(define (fac n) (if (= n 0) 1 (* n (fac (- n 1)))))
(assert:equal "Factorial example" (fac 10) 3628800)

(assert:equal "if example" (if #t 1 2) 1)
(assert:equal "if example" (if #f 1 2) 2)
(assert:equal "if example" (if (+ 1 2) (+ 3 4) (* 3 4)) 7)
(assert:equal "if" (if ((lambda (x) (+ x 1)) 0) (+ 1 1) (* 0 0)) 2)
(assert:equal "no else clause" (if #t 'no-else-clause) 'no-else-clause)

(assert:equal "" (+ (+ 1 1) (* 3 4)) 14)

((lambda (x)
  ( + 2 ( * 3 4 ) ) )
    (assert:equal "set local x" x #t))
 #f)

(define a (list #f #f))
(define b (cons #f #f))

(set-car! a 1)
(set-cdr! a '(2))
(assert:equal "set car/cdr a" a '(1 2))
(set-cdr! a 2)
(set-car! b '(#t))
(set-cdr! b '#t)

(assert:equal "set a" a '(1 . 2))
(assert:equal "set b" b '((#t) . #t))

(define scope #f)
(assert:equal "outer scope" scope #f)
((lambda (scope)
    (assert:equal "inner scope" scope #t)
 ) #t)

(let ((x 10) 
      (y 20) 
      (square (lambda (x) (* x x)))) 
  (begin 
    (assert:equal "square x" (square x) 100) 
    (assert:equal "square y" (square y) 400)))

(define a "a0123456789")
(assert:equal "string eq" a "a0123456789")
(assert:not-equal "string eq" a 'a0123456789)
(define b "abcdefghijklmnopqrstuvwxyz")
(define c "hello, world!")
(define d (list->string '(#\( #\" #\a #\b #\c #\" #\))))
(assert:equal "strings" d "(\"abc\")")
  Test GC
  Test GC
(set! a "hello 2")
(assert:equal "strings" a "hello 2")
(define (f) (make-string 3 #\*))
(define (g) "***")
(assert:equal "string-set!" (string-set! (f) 0 #\?) "?**")
(define a "12345")
(define b (string-copy "abcde"))
(assert:equal "string-copy!" (string-copy! b 1 a 0 2) "a12de")
(let ((v '()))
  (string-for-each
    (lambda (c) (set! v (cons (char->integer c) v)))
    "abcde")
  (assert:equal "string-for-each" v '(101 100 99 98 97)))

(assert:equal "interline whitespace" "1 2 \      
3 4" "1 2 3 4")

(assert:equal "interline whitespace" "1 2 \


3 4" "1 2 \n\n3 4")

(assert:equal "UTF8 string length" (string-length (make-string 1 (integer->char 128))) 1)
(assert:equal "UTF8 bv length" (bytevector-length (string->utf8 (make-string 1 (integer->char 128)))) 2)
(assert:equal "UTF8 char" (string-ref (make-string 1 (integer->char 128)) 0) #\x80)

(letrec ((fnc (lambda (i) 
                (begin
                    (if (> i 0) (fnc (- i 1)) 0)))))
    (fnc 10))

(assert:equal "numeric small reverse" (reverse '(1 2)) '(2 1))
(assert:equal "small reverse" (reverse '(a b c)) '(c b a))
(assert:equal "larger reverse" (reverse '(1 2 3 4 5 6 7 8 9 10)) '(10 9 8 7 6 5 4 3 2 1))
(assert:equal "char whitespace" (char-whitespace? #\space) #t)
(assert:equal "char whitespace" (char-whitespace? #\a) #f)
(assert:equal "char numeric" (char-numeric? #\1) #t)
(assert:equal "char numeric" (char-numeric? #\newline) #f)
(assert:equal "" (and 1 2 3) 3)
(assert:equal "" (and #t #f 'a 'b 'c) #f)
(assert:equal "" (or 1 2 3) 1)
(assert:equal "" (or #f 'a 'b 'c) 'a)
(assert:equal "" (string-append "") "")
error - ( string - append 1 )
(assert:equal "" (string-append "test") "test")
(assert:equal "" (string-append "ab" "cdefgh ij" "klmno" "p" "q" "rs  " "tuv" "w" " x " "yz")
  "abcdefgh ijklmnopqrs  tuvw x yz")
(assert:equal "" (string->number "0") 0)
(assert:equal "" (string->number "42") 42)
(assert:equal "" (string->number "3.14159") 3.14159)
(assert:equal "" (list->string (list #\A #\B #\C)) "ABC")
(assert:equal "" (list->string (list #\A)) "A")
(assert:equal "" (list->string (list)) "") 
(assert:equal "" (integer->char 65) #\A)
(assert:equal "" (char->integer #\a) 97)

(assert:equal "" (number->string (+ 1 2)) "3")
(assert:equal "" (string->list "test") '(#\t #\e #\s #\t))
(assert:equal "" (string->symbol "a-b-c-d") 'a-b-c-d)
(assert:equal "" (symbol->string 'a/test-01) "a/test-01")
(assert:equal "" (eq? 'a-1 'a-1) #t)
(assert:equal "" (eq? (string->symbol "aa") 'aa) #t)
(assert:equal "" (eq? 0.0 0.0) #f)
(assert:equal "" (eq? 33333333333333 33333333333333) #f)
(assert:equal "" (eqv? 'a-1 'a-1) #t)
(assert:equal "" (eqv? (string->symbol "aa") 'aa) #t)
(assert:equal "" (eqv? 0.0 0.0) #t)
(assert:equal "" (eqv? 33333333333333 33333333333333) #t)
(assert:equal "" (equal? (string->symbol "aa") 'aa) #t)

(assert:equal "map 1" (map (lambda (x) (car x)) '((a . b) (1 . 2) (#\h #\w))) '(a 1 #\h))
(assert:equal "map 2" (map car '((a . b) (1 . 2) (#\h #\w))) '(a 1 #\h))
(assert:equal "map 3" (map cdr '((a . b) (1 . 2) (#\h #\w))) '(b 2 (#\w)))
(assert:equal "map length"
  (map length '(() (1) (1 2) (1 2 3) (1 2 3 4)))
 '(0 1 2 3 4))

(define (glob a b c)
  (define (p d)
    (list a b c d))
  (p 4))
(assert:equal "internal defs for global funcs"
        (glob 1 2 3)
       '(1 2 3 4))

(define x 'global)
((lambda ()
  (define x 1)
  ((lambda ()
    (define x 2)
    (assert:equal "local define of x" x 2)))
  (assert:equal "another local define of x" x 1)))
(assert:equal "global define of x" x 'global)

1'b
3"four five "

  EVAL section
(define x 1)
(define y 2)
(define *z* 3)
(assert:equal "eval compiled - x" (eval 'x) x)
(eval '(set! x 'mutated-x))
(assert:equal "Access var with a mangled name" (eval '*z*) *z*)
(assert:equal "Access compiled var mutated by eval" x 'mutated-x)



(assert:equal "vector-ref" (vector-ref #(1 1 2 3 5 8 13 21) 5) 8)
(assert:equal "vector-set!" (vector-set! #(0 '(2 2 2 2) "anna") 1 "test") #(0 "test" "anna"))
(assert:equal "vector->list" (vector->list #(dah dah didah))
                            '(dah dah didah))
( vector->list    ) 1 2 )
(assert:equal "list->vector" (list->vector '(dididit dah))
                             #(dididit dah))

(assert:equal "string->vector" (string->vector "ABC")  #(#\A #\B #\C))
(assert:equal "vector->string" (vector->string #(#\1 #\2 #\3)) "123")

(define a (vector 1 2 3 4 5))
(define b (vector 10 20 30 40 50))
(vector-copy! b 1 a 0 2)
(assert "vector-copy!" (equal? b #(10 1 2 40 50)))

(define a (vector 1 2 3 4 5))
(vector-fill! a 'smash 2 4)
(assert:equal "vector-fill!" a #(1 2 smash smash 5))

(with-output-to-file 
  "test.out" 
  (lambda ()
    (write 'hello-world)))
(with-input-from-file
  "test.out"
  (lambda ()
    (assert:equal "I/O with-*-file test" (read) 'hello-world)))
  Note : was a good test , did not always work in icyc
(call-with-input-file "test.txt" (lambda (port) (assert:equal "read input" (read port) 'ok)))
  TODO : ( delete - file " test.out " )

  Macros
(define-syntax test 
  (er-macro-transformer
     (lambda (expr rename compare)
       (cond ((null? (cdr expr)) #t)
             ((null? (cddr expr)) (cadr expr))
             (else (list (rename 'if) (cadr expr)
                         (cons (rename 'and) (cddr expr))
                         #f))))))

(define-syntax test2
  (er-macro-transformer
     (lambda (expr rename compare)
       (test 1 2)
       (test 1 2 3)
       (and ''test ''test2))))

(define-syntax indirect-def
 (syntax-rules ()
  ( (indirect-def x y)
    (begin
     (define z y)
     (define x z) ) ) ) )

(define x 42)
(assert:equal "macro: test2" (test2 1 2 3) 'test2)
(assert:equal "macro: test" (test 1 2 3) 3)
(assert:equal "macro: eval test" (eval '(test 1 2 x)) x)

(assert:equal "macro: define syntax indirect-def" 
  (indirect-def a 3)
  '(3))

(assert:equal "macro: let syntax indirect-def" 
 (let-syntax 
  ( (indirect-def
     (syntax-rules ()
      ( (indirect-def x y)
        (begin
         (define z y)
         (define x z) ) ) ) ) )
  (indirect-def a 3)
  a)
 '3)

(define-record-type <pare>
  (kons x y)
  pare?
  (x kar set-kar!)
  (y kdr))

(define-record-type <point>
  (point x y)
  point?
  (x get-x set-x!)
  (y get-y set-y!)
  (z get-z set-z!))

(assert:equal "Records predicate (t)" (pare? (kons 1 2)) #t)
(assert:equal "Records predicate (f)" (pare? (cons 1 2)) #f)
(assert:equal "Records kar" (kar (kons 1 2)) 1)
(assert:equal "Records kdr" (kdr (kons 1 2)) 2)
(assert:equal "Records setter"
  (let ((k (kons 1 2)))
    (set-kar! k 3)
    (kar k))
  3)
(assert:equal "Record type predicate (t)" (record? (kons 1 2)) #t)
(assert:equal "Record type predicate (f)" (record? (cons 1 2)) #f)

(assert:equal "Record type field not in constructor (f)" (get-z (point 1 2)) #f)
(let ((p (point 1 2)))
  (set-z! p 99)
  (assert:equal "Record type get field not in constructor" (get-z p) 99))

(assert:equal "Basic lazy" (force (delay (+ 1 2))) 3)
(assert:equal "Lazy test #2"
  (let ((p (delay (+ 1 2))))
    (list (force p) (force p)))
  '(3 3))
((lambda ()
  (define integers
    (letrec ((next
              (lambda (n)
                (delay (cons n (next (+ n 1)))))))
      (next 0)))
  (define head
    (lambda (stream) (car (force stream))))
  (define tail
    (lambda (stream) (cdr (force stream))))
  (assert:equal "Lazy #3" (head (tail (tail integers))) 2)))


(display (list *num-passed* "tests passed with no errors"))
(newline)
