(require-library datatypes simple-tests)
(import datatypes simple-tests) 

(define-test (datatypes?)
  (check

    "Concrete types"
    (define-concrete-type LIST List?
      (List-null)
      (List-cons (first) (rest List?)))

    (define (Null? obj)
      (concrete-case LIST obj
        ((List-null) #t)
        (else #f)))
    (define (List-first obj)
      (concrete-case LIST obj
        ((List-null)
         (error 'List-first))
        ((List-cons first rest)
         first)))
    (define (List-rest obj)
      (concrete-case LIST obj
        ((List-null)
         (error 'List-rest))
        ((List-cons first rest)
         rest)))
    (define Lst (List-null))
    (Null? Lst)
    (set! Lst (List-cons 1 Lst))
    (not (Null? Lst))
    (Null? (List-rest Lst))
    (= 1 (List-first Lst))

    "Integers as chains"
    (define-concrete-type CHAIN chain?
      (Chain-link (item integer? (lambda (x) (>= x 0)))
                  (next procedure?)))
    (define (integers n) 
      (Chain-link n integers))
    (not (chain? integers))
    (chain? (integers 0))
    (chain? (integers 10))
    (define (chain-item n xpr)
      (concrete-case CHAIN xpr
        ((Chain-link i fn)
         (if (= n 1)
           i
           (chain-item (- n 1) (fn (+ i 1)))))))
    (= 0 (chain-item 1 (integers 0)))
    (= 25 (chain-item 26 (integers 0)))

    "Abstract types"
    (define-abstract-type POINT point?
      (Point (x number?) (y number?))
      (with
        ((point x y) (Point x y))
        ((point-x pt)
         (concrete-case POINT pt
           ((Point x y) x)))
        ((point-y pt)
         (concrete-case POINT pt
           ((Point x y) y))))
      (printer
        (lambda (pt out)
          (display "#,(POINT " out)
          (display (point-x pt) out)
          (display " " out)
          (display (point-y pt) out)
          (display ")\n" out)))
      (reader Point))
    (define pt (point 1 2))
    (print pt)
    (= (point-x pt) 1)
    (point? pt)
    (not (point? Lst))
))

(compound-test (DATATYPES)
  (datatypes?)
  )