(import anaphora simple-tests (chicken sort))

(define-test (basics?)
  (equal?
    (aif (memv 3 '(1 2 3 4 5))
      it)
    '(3 4 5))
  (equal?
    (nif it (memv 3 '(1 2 3 4 5))
      it)
    '(3 4 5))

  (equal?
    (acond
      ((memv 6 '(1 2 3 4 5)) it)
      ((memv 3 '(1 2 3 4 5)) it)
      (else it))
    '(3 4 5))
  (equal?
    (ncond it
      ((memv 6 '(1 2 3 4 5)) it)
      ((memv 3 '(1 2 3 4 5)) it)
      (else it))
    '(3 4 5))
  (eq?
    (acond
      ((memv 6 '(1 2 3 4 5)) it)
      (else it))
    #t)
  (eq?
    (ncond it
      ((memv 6 '(1 2 3 4 5)) it)
      (else it))
    #t)
  
  (equal?
    (let ((lst '(1 2 3 4 5 #f)) (res '()))
      (awhile (car lst)
        (set! res (cons (car lst) res))
        (set! lst (cdr lst)))
      res)
  '(5 4 3 2 1))
  (equal?
    (let ((lst '(1 2 3 4 5 #f)) (res '()))
      (nwhile it (car lst)
        (set! res (cons (car lst) res))
        (set! lst (cdr lst)))
      res)
  '(5 4 3 2 1))

  (equal?
    (awhen (memv 3 '(1 2 3 4 5)) it)
    '(3 4 5))
  (equal?
    (nwhen it (memv 3 '(1 2 3 4 5)) it)
    '(3 4 5))

  (not (aand '(1 2 3) (memv 0 it) (car it)))
  (= (aand '(1 2 3 4 5) (memv 3 it) (car it)) 3)
  (= (aand '(1 2 3 4 5) (cdr it) (car it)) 2)
  (= (nand it '(1 2 3 4 5) (cdr it) (cdr it) (car it)) 3)

  (equal?
    (map (alambda (n)
           (if (zero? n)
             1
             (* n (self (- n 1)))))
         '(1 2 3 4 5))
    '(1 2 6 24 120))
  (equal?
    (map (nlambda self (n)
           (if (zero? n)
             1
             (* n (self (- n 1)))))
         '(1 2 3 4 5))
    '(1 2 6 24 120))
  )
(basics?)

(define-test (properties?)
  (define-properties color weight)
  (color! 'foo 'red)
  (eq? (color 'foo) 'red)
  (weight! 'foo 5)
  (= (weight 'foo) 5)
  (color! 'foo 'blue)
  (eq? (color 'foo) 'blue)
  (weight! 'foo 50)
  (= (weight 'foo) 50)
  )
(properties?)

(define llength
  (list-recurser (lambda (lst th) (add1 (th))) 0))
(define allength
  (alist-recurser (add1 (go-on)) 0))
(define (lsome? ok?)
  (list-recurser (lambda (lst th) (or (ok? (car lst)) (th))) #f))
(define (alsome? ok?)
  (alist-recurser (or (ok? (car it)) (go-on)) #f))
(define (alevery? ok?)
  (alist-recurser (and (ok? (car it)) (go-on)) #t))
(define (lfind ok?)
  (list-recurser (lambda (lst th) (if (ok? (car lst)) lst (th))) '()))
(define (alfind ok?)
  (alist-recurser (if (ok? (car it)) it (go-on)) '()))
(define lcopy
  (list-recurser (lambda (lst th) (cons (car lst) (th))) '()))
(define alcopy
  (alist-recurser (cons (car it) (go-on)) '()))
(define lremove-dups
  (list-recurser (lambda (lst th) (adjoin (car lst) (th))) '()))
(define alremove-dups
  (alist-recurser (adjoin (car it) (go-on)) '()))
(define (adjoin obj lst) (if (member obj lst) lst (cons obj lst)))

(define-test (list-recursers?)
  #;(define llength
    (list-recurser (lambda (lst th) (add1 (th))) 0))
  #;(define allength
    (alist-recurser (add1 (go-on)) 0))
  (= (llength '(1 2 3)) 3)
  (= (allength '(1 2 3)) 3)
  #;(define (lsome? ok?)
    (list-recurser (lambda (lst th) (or (ok? (car lst)) (th))) #f))
  #;(define (alsome? ok?)
    (alist-recurser (or (ok? (car it)) (go-on)) #f))
  ((lsome? odd?) '(2 3 4))
  ((alsome? odd?) '(2 3 4))
  #;(define (alevery? ok?)
    (alist-recurser (and (ok? (car it)) (go-on)) #t))
  (not ((alevery? odd?) '(1 2 3)))
  #;(define (lfind ok?)
    (list-recurser (lambda (lst th) (if (ok? (car lst)) lst (th))) '()))
  #;(define (alfind ok?)
    (alist-recurser (if (ok? (car it)) it (go-on)) '()))
  (equal? ((lfind odd?) '(2 3 4)) '(3 4))
  (equal? ((alfind odd?) '(2 3 4)) '(3 4))
  #;(define lcopy
    (list-recurser (lambda (lst th) (cons (car lst) (th))) '()))
  #;(define alcopy
    (alist-recurser (cons (car it) (go-on)) '()))
  (equal? (lcopy '(1 2 3)) '(1 2 3))
  (equal? (alcopy '(1 2 3)) '(1 2 3))
  #;(define lremove-dups
    (list-recurser (lambda (lst th) (adjoin (car lst) (th))) '()))
  #;(define alremove-dups
    (alist-recurser (adjoin (car it) (go-on)) '()))
  #;(define (adjoin obj lst) (if (member obj lst) lst (cons obj lst)))
  (equal? (sort (lremove-dups '(1 2 1 3 2 4 3)) <) '(1 2 3 4))
  (equal? (sort (alremove-dups '(1 2 1 3 2 4 3)) <) '(1 2 3 4))
  )
(list-recursers?)

(define tflatten
  (tree-recurser (lambda (tree left right)
                   (append (left)
                           (or (right) '())))
                 (lambda (tree)
                   (if (list? tree) tree (list tree)))))
(define atflatten
  (atree-recurser (append (go-left) (or (go-right) '()))
                  (if (list? it) it (list it))))
(define tcopy
  (tree-recurser (lambda (tree left right)
                   (cons (left) (or (right) '())))
                 identity))
(define atcopy
  (atree-recurser (cons (go-left) (or (go-right) '())) it))
(define (tfind ok?)
  (tree-recurser (lambda (tree left right)
                   (or (left) (right))) 
                 (lambda (tree)
                   (and (ok? tree) tree))))
(define (atfind ok?)
  (atree-recurser (or (go-left) (go-right))
                  (and (ok? it) it)))
(define tcount-leaves
  (tree-recurser (lambda (tree left right)
                   (+ (left) (or (right) 1)))
                 1))
(define atcount-leaves
  (atree-recurser (+ (go-left) (or (go-right) 1)) 1))

(define-test (tree-recursers?)
  #;(define tflatten
    (tree-recurser (lambda (tree left right)
                     (append (left)
                             (or (right) '())))
                   (lambda (tree)
                     (if (list? tree) tree (list tree)))))
  #;(define atflatten
    (atree-recurser (append (go-left) (or (go-right) '()))
                    (if (list? it) it (list it))))
  (equal? (tflatten '(1 (2 3 (4)) 5)) '(1 2 3 4 5))
  (equal? (atflatten '(1 (2 3 (4)) 5)) '(1 2 3 4 5))
  #;(define tcopy
    (tree-recurser (lambda (tree left right)
                     (cons (left) (or (right) '())))
                   identity))
  #;(define atcopy
    (atree-recurser (cons (go-left) (or (go-right) '())) it))
  (equal? (tcopy '(1 (2 3 (4)) 5)) '(1 (2 3 (4)) 5))
  (equal? (atcopy '(1 (2 3 (4)) 5)) '(1 (2 3 (4)) 5))
  #;(define (tfind ok?)
    (tree-recurser (lambda (tree left right)
                     (or (left) (right))) 
                   (lambda (tree)
                     (and (ok? tree) tree))))
  #;(define (atfind ok?)
    (atree-recurser (or (go-left) (go-right))
                    (and (ok? it) it)))
  (= ((tfind odd?) '(2 (4 5) 1)) 5)
  (= ((atfind odd?) '(2 (4 6) 1)) 1)
  #;(define tcount-leaves
    (tree-recurser (lambda (tree left right)
                     (+ (left) (or (right) 1)))
                   1))
  #;(define atcount-leaves
    (atree-recurser (+ (go-left) (or (go-right) 1)) 1))
  (= (tcount-leaves '((1 2 (3 4)) (5) 6)) 10)
  (= (atcount-leaves '((1 2 (3 4)) (5) 6)) 10)
  )
(tree-recursers?)

(define-test (define-anaphor?)
  (define-anaphor alist list #:cascade)
  (define-anaphor a+ + #:cascade)
  (define-anaphor a- - #:cascade)
  (equal? (alist 1 (+ it 2) (* it 3)) '(1 3 9))
  (= (a+ 1 (+ it 2) (* it 3)) 13)
  (= (a- 1 (+ it 2) (* it 3)) -11)
  (define-anaphor aand and #:cascade)
  (equal? (aand (list 1 2 3) (cdr it) (cdr it)) '(3))
  (define-anaphor awhen when #:first)
  (= (awhen (* 1 2 3 4 5) (* 2 it)) 240)
  )
(define-anaphor?)

(compound-test (ANAPHORA)
  (basics?)
  (properties?)
  (list-recursers?)
  (tree-recursers?)
  (define-anaphor?)
  )


(import anaphora simple-tests (chicken sort))

(define-test (basics?)
  (equal?
    (aif (memv 3 '(1 2 3 4 5))
      it)
    '(3 4 5))
  (equal?
    (nif it (memv 3 '(1 2 3 4 5))
      it)
    '(3 4 5))

  (equal?
    (acond
      ((memv 6 '(1 2 3 4 5)) it)
      ((memv 3 '(1 2 3 4 5)) it)
      (else it))
    '(3 4 5))
  (equal?
    (ncond it
      ((memv 6 '(1 2 3 4 5)) it)
      ((memv 3 '(1 2 3 4 5)) it)
      (else it))
    '(3 4 5))
  (eq?
    (acond
      ((memv 6 '(1 2 3 4 5)) it)
      (else it))
    #t)
  (eq?
    (ncond it
      ((memv 6 '(1 2 3 4 5)) it)
      (else it))
    #t)
  
  (equal?
    (let ((lst '(1 2 3 4 5 #f)) (res '()))
      (awhile (car lst)
        (set! res (cons (car lst) res))
        (set! lst (cdr lst)))
      res)
  '(5 4 3 2 1))
  (equal?
    (let ((lst '(1 2 3 4 5 #f)) (res '()))
      (nwhile it (car lst)
        (set! res (cons (car lst) res))
        (set! lst (cdr lst)))
      res)
  '(5 4 3 2 1))

  (equal?
    (awhen (memv 3 '(1 2 3 4 5)) it)
    '(3 4 5))
  (equal?
    (nwhen it (memv 3 '(1 2 3 4 5)) it)
    '(3 4 5))

  (not (aand '(1 2 3) (memv 0 it) (car it)))
  (= (aand '(1 2 3 4 5) (memv 3 it) (car it)) 3)
  (= (aand '(1 2 3 4 5) (cdr it) (car it)) 2)
  (= (nand it '(1 2 3 4 5) (cdr it) (cdr it) (car it)) 3)

  (equal?
    (map (alambda (n)
           (if (zero? n)
             1
             (* n (self (- n 1)))))
         '(1 2 3 4 5))
    '(1 2 6 24 120))
  (equal?
    (map (nlambda self (n)
           (if (zero? n)
             1
             (* n (self (- n 1)))))
         '(1 2 3 4 5))
    '(1 2 6 24 120))
  )
(basics?)

(define-test (properties?)
  (define-properties color weight)
  (color! 'foo 'red)
  (eq? (color 'foo) 'red)
  (weight! 'foo 5)
  (= (weight 'foo) 5)
  (color! 'foo 'blue)
  (eq? (color 'foo) 'blue)
  (weight! 'foo 50)
  (= (weight 'foo) 50)
  )
(properties?)

(define llength
  (list-recurser (lambda (lst th) (add1 (th))) 0))
(define allength
  (alist-recurser (add1 (go-on)) 0))
(define (lsome? ok?)
  (list-recurser (lambda (lst th) (or (ok? (car lst)) (th))) #f))
(define (alsome? ok?)
  (alist-recurser (or (ok? (car it)) (go-on)) #f))
(define (alevery? ok?)
  (alist-recurser (and (ok? (car it)) (go-on)) #t))
(define (lfind ok?)
  (list-recurser (lambda (lst th) (if (ok? (car lst)) lst (th))) '()))
(define (alfind ok?)
  (alist-recurser (if (ok? (car it)) it (go-on)) '()))
(define lcopy
  (list-recurser (lambda (lst th) (cons (car lst) (th))) '()))
(define alcopy
  (alist-recurser (cons (car it) (go-on)) '()))
(define lremove-dups
  (list-recurser (lambda (lst th) (adjoin (car lst) (th))) '()))
(define alremove-dups
  (alist-recurser (adjoin (car it) (go-on)) '()))
(define (adjoin obj lst) (if (member obj lst) lst (cons obj lst)))

(define-test (list-recursers?)
  #;(define llength
    (list-recurser (lambda (lst th) (add1 (th))) 0))
  #;(define allength
    (alist-recurser (add1 (go-on)) 0))
  (= (llength '(1 2 3)) 3)
  (= (allength '(1 2 3)) 3)
  #;(define (lsome? ok?)
    (list-recurser (lambda (lst th) (or (ok? (car lst)) (th))) #f))
  #;(define (alsome? ok?)
    (alist-recurser (or (ok? (car it)) (go-on)) #f))
  ((lsome? odd?) '(2 3 4))
  ((alsome? odd?) '(2 3 4))
  #;(define (alevery? ok?)
    (alist-recurser (and (ok? (car it)) (go-on)) #t))
  (not ((alevery? odd?) '(1 2 3)))
  #;(define (lfind ok?)
    (list-recurser (lambda (lst th) (if (ok? (car lst)) lst (th))) '()))
  #;(define (alfind ok?)
    (alist-recurser (if (ok? (car it)) it (go-on)) '()))
  (equal? ((lfind odd?) '(2 3 4)) '(3 4))
  (equal? ((alfind odd?) '(2 3 4)) '(3 4))
  #;(define lcopy
    (list-recurser (lambda (lst th) (cons (car lst) (th))) '()))
  #;(define alcopy
    (alist-recurser (cons (car it) (go-on)) '()))
  (equal? (lcopy '(1 2 3)) '(1 2 3))
  (equal? (alcopy '(1 2 3)) '(1 2 3))
  #;(define lremove-dups
    (list-recurser (lambda (lst th) (adjoin (car lst) (th))) '()))
  #;(define alremove-dups
    (alist-recurser (adjoin (car it) (go-on)) '()))
  #;(define (adjoin obj lst) (if (member obj lst) lst (cons obj lst)))
  (equal? (sort (lremove-dups '(1 2 1 3 2 4 3)) <) '(1 2 3 4))
  (equal? (sort (alremove-dups '(1 2 1 3 2 4 3)) <) '(1 2 3 4))
  )
(list-recursers?)

(define tflatten
  (tree-recurser (lambda (tree left right)
                   (append (left)
                           (or (right) '())))
                 (lambda (tree)
                   (if (list? tree) tree (list tree)))))
(define atflatten
  (atree-recurser (append (go-left) (or (go-right) '()))
                  (if (list? it) it (list it))))
(define tcopy
  (tree-recurser (lambda (tree left right)
                   (cons (left) (or (right) '())))
                 identity))
(define atcopy
  (atree-recurser (cons (go-left) (or (go-right) '())) it))
(define (tfind ok?)
  (tree-recurser (lambda (tree left right)
                   (or (left) (right))) 
                 (lambda (tree)
                   (and (ok? tree) tree))))
(define (atfind ok?)
  (atree-recurser (or (go-left) (go-right))
                  (and (ok? it) it)))
(define tcount-leaves
  (tree-recurser (lambda (tree left right)
                   (+ (left) (or (right) 1)))
                 1))
(define atcount-leaves
  (atree-recurser (+ (go-left) (or (go-right) 1)) 1))

(define-test (tree-recursers?)
  #;(define tflatten
    (tree-recurser (lambda (tree left right)
                     (append (left)
                             (or (right) '())))
                   (lambda (tree)
                     (if (list? tree) tree (list tree)))))
  #;(define atflatten
    (atree-recurser (append (go-left) (or (go-right) '()))
                    (if (list? it) it (list it))))
  (equal? (tflatten '(1 (2 3 (4)) 5)) '(1 2 3 4 5))
  (equal? (atflatten '(1 (2 3 (4)) 5)) '(1 2 3 4 5))
  #;(define tcopy
    (tree-recurser (lambda (tree left right)
                     (cons (left) (or (right) '())))
                   identity))
  #;(define atcopy
    (atree-recurser (cons (go-left) (or (go-right) '())) it))
  (equal? (tcopy '(1 (2 3 (4)) 5)) '(1 (2 3 (4)) 5))
  (equal? (atcopy '(1 (2 3 (4)) 5)) '(1 (2 3 (4)) 5))
  #;(define (tfind ok?)
    (tree-recurser (lambda (tree left right)
                     (or (left) (right))) 
                   (lambda (tree)
                     (and (ok? tree) tree))))
  #;(define (atfind ok?)
    (atree-recurser (or (go-left) (go-right))
                    (and (ok? it) it)))
  (= ((tfind odd?) '(2 (4 5) 1)) 5)
  (= ((atfind odd?) '(2 (4 6) 1)) 1)
  #;(define tcount-leaves
    (tree-recurser (lambda (tree left right)
                     (+ (left) (or (right) 1)))
                   1))
  #;(define atcount-leaves
    (atree-recurser (+ (go-left) (or (go-right) 1)) 1))
  (= (tcount-leaves '((1 2 (3 4)) (5) 6)) 10)
  (= (atcount-leaves '((1 2 (3 4)) (5) 6)) 10)
  )
(tree-recursers?)

(define-test (define-anaphor?)
  (define-anaphor alist list #:cascade)
  (define-anaphor a+ + #:cascade)
  (define-anaphor a- - #:cascade)
  (equal? (alist 1 (+ it 2) (* it 3)) '(1 3 9))
  (= (a+ 1 (+ it 2) (* it 3)) 13)
  (= (a- 1 (+ it 2) (* it 3)) -11)
  (define-anaphor aand and #:cascade)
  (equal? (aand (list 1 2 3) (cdr it) (cdr it)) '(3))
  (define-anaphor awhen when #:first)
  (= (awhen (* 1 2 3 4 5) (* 2 it)) 240)
  )
(define-anaphor?)

(compound-test (ANAPHORA)
  (basics?)
  (properties?)
  (list-recursers?)
  (tree-recursers?)
  (define-anaphor?)
  )