(require-library messages generics simple-tests)
(import messages generics simple-cells simple-tests)
;(load "messages.scm") (import messages)

(define-test (Sequences)
  (check
    (define-protocol SEQ (Drop k) (Take k) (At k))
    (equal? (protocol-docs SEQ)
            '((Drop k) (Take k) (At k)))
    (define-method (Drop (seq string??))
                   (lambda (k) (substring seq k)))
    (define-method (Drop (seq vector??))
                   (lambda (k) (subvector seq k)))
    (define-method (Drop (seq list??))
                   (lambda (k) (list-tail seq k)))
    (define-method (Take (seq string??))
                   (lambda (k) (substring seq 0 k)))
    (define-method (Take (seq vector??))
                   (lambda (k) (subvector seq 0 k)))
    (define-method (Take (seq list??))
                   (lambda (k)
                     (let loop ((n 0) (tail seq) (head '()))
                       (if (fx= k n)
                         (reverse head)
                         (loop (fx+ 1 n)
                               (cdr tail)
                               (cons (car tail) head))))))
    (define-method (At (seq string??))
                   (lambda (k) (string-ref seq k)))
    (define-method (At (seq vector??))
                   (lambda (k) (vector-ref seq k)))
    (define-method (At (seq list??))
                   (lambda (k) (list-ref seq k)))
    (message? Drop)
    (message? Take)
    (message? At)
    (fx= (message-arity Drop) 1)
    (fx= (message-arity Take) 1)
    (fx= (message-arity At) 1)
    (not (message-variadic? Drop))
    (not (message-variadic? Take))
    (not (message-variadic? At))
    (protocol-adopts? SEQ '())
    (protocol-adopts? SEQ #())
    (protocol-adopts? SEQ "")
    (not (protocol-adopts? SEQ #f))
    (define lst '(0 1 2 3 4))
    (define vec #(0 1 2 3 4))
    (define str "01234")
    (fx= ((At 0) lst) 0)
    (fx= ((At 1) vec) 1)
    (char=? ((At 2) str) #\2)
    (equal? ((Drop 1) lst) '(1 2 3 4))
    (equal? ((Drop 2) vec) #(2 3 4))
    (string=? ((Drop 3) str) "34")
    (equal? ((Take 1) lst) '(0))
    (equal? ((Take 2) vec) #(0 1))
    (string=? ((Take 3) str) "012")
    ))

(define-test (Stacks)
  (check
    (define-protocol STACK (Push! arg) Pop! Top)
    (equal? (protocol-docs STACK)
            '((Push! arg) Pop! Top))
    (fx= (message-arity Push!) 1)
    (fx= (message-arity Pop!) 0)
    (fx= (message-arity Top) 0)
    (not (message-variadic? Top))
    (not (message-variadic? Pop!))
    (not (message-variadic? Push!))
    (define-selector stack?? list?? cell?)
    (define-method (Push! (obj stack??))
                   (lambda (arg)
                     (let ((old (obj)))
                       (obj (cons arg old))
                       old)))
    (define-method (Top (obj stack??))
                   (if (null? (obj))
                     (gensym 'stack-empty)
                     (car (obj))))
    (define-method (Pop! (obj stack??))
                   (if (null? (obj))
                     (gensym 'stack-empty)
                     (let ((old (obj)))
                       (obj (cdr old))
                       old)))
    (define stk (cell '() list?))
    (null? ((Push! 0) stk))
    (equal? '(0) ((Push! 1) stk))
    (fx= (Top stk) 1)
    (equal? '(1 0) ((Push! 2) stk))
    (fx= (Top stk) 2)
    (equal? '(2 1 0) (Pop! stk))
    (fx= (Top stk) 1)
    (equal? '(1 0) (Pop! stk))
    (fx= (Top stk) 0)
    (protocol-adopts? STACK (cell '()))
    ))
(define-test (Foo)
  (check
    (define-message ((foo x y . zs) obj))
    (fx= (message-arity foo) 2)
    (message-variadic? foo)
    ))

(compound-test (MESSAGES)
  (Sequences)
  (Stacks)
  (Foo)
  )