;;;; File: samples-run.scm
;;;; Author: Juergen Lorenz
;;;; ju (at) jugilo (dot) de
;;;; Date: Feb 12, 2011
;;;;       Feb 17, 2011
;;;;       Mar 06, 2011


(require 'samples 'tests 'srfi-102)
(import samples
        chicken   ; cut 
        (only srfi-102 procedure-arity-includes?))

(define-syntax values->list
  (syntax-rules ()
    ((_ vals)
     (call-with-values (lambda () vals) list))))

(define divisible?
  (lambda (x y) (= (remainder x y) 0)))

(define run
  (lambda ()
    (if
      (and
      (equal?
        (values->list (quotient+remainder 25 3)) '(8 1))
       (equal?
         (vector-tail (vector 0 1 2 3) 0) '#(0 1 2 3))
       (equal?
         (vector-tail (vector 0 1 2 3) 4) '#())
       (equal?
         (vector-tail (vector 0 1 2 3) 2) '#(2 3))
       (equal? 
         (vector-head (vector 0 1 2 3) 4) '#(0 1 2 3))
       (equal? 
         (vector-head (vector 0 1 2 3) 0) '#())
       (equal? 
         (vector-head (vector 0 1 2 3) 2) '#(0 1))
       (equal?
         (vector-append '#(1 2) '#(3 4 5)) '#(1 2 3 4 5))
       (equal?
         (vector-append '#(1 2) '#()) '#(1 2))
       (equal?
         (vector-append '#() '#(3 4 5)) '#(3 4 5))
       (equal?
         (vector-append '#() '#()) '#())
       (string=?
         (string-tail "0123" 0) "0123")
       (string=?
         (string-tail "0123" 4) "")
       (string=?
         (string-tail "0123" 2) "23")
       (string=?
         (string-head "0123" 0) "")
       (string=?
         (string-head "0123" 4) "0123")
       (string=?
         (string-head "0123" 2) "01")
       (eq?
         (flat? '(1 2 3)) #t)
       (eq?
         (flat? 1) #f)
       (eq?
         (flat? '((1 . 2) 3)) #f)
       (eq?
         (flat? '()) #t)
       (equal?
         (create-list 5 (cut > <> 10) add1)
         '(5 6 7 8 9 10))
       (equal?
         (create-list 1 (cut > <> 100) (cut * 2 <>))
         '(1 2 4 8 16 32 64))            
       (equal?
         (create-list 5 zero? sub1)
         '(5 4 3 2 1))
       (equal?
         (list-head '(1 2 3 4 5) 3) '(1 2 3))
       (equal?
         (list-head '(1 2 3 4 5) 0) '())
       (equal?
         (enum 0) '())
       (equal?
         (enum 5) '(0 1 2 3 4))
       (equal?
         (sublist '(1 2 3 4 5) 1 5) '(2 3 4 5))
       (equal?
         (sublist '(1 2 3 4 5) 0 3) '(1 2 3))
       (equal?
         (sublist '(1 2 3 4 5) 3 3) '())
       (equal?
         (sublist '(1 2 3 4 5) 1 3) '(2 3))
       (equal?
         (memp even? '(1 2 3 4 5)) '(2 3 4 5))
       (equal?
         (memp odd? '()) #f)
       (equal?
         (memp odd? '(2 4 6 8)) #f)
       (equal?
         (filter even? '()) '())
       (equal?
         (filter even? '(1 3 5 7)) '())
       (equal?
         (filter even? '(1 2 3 4 5)) '(2 4))
       (equal?
         (sieve divisible?
                (list-tail (enum 20) 2))
         '(2 3 5 7 11 13 17 19))
       (equal?
         (sieve (cut = <> <>) '(1 2 1 4 1 5 3 4 5))
         '(1 2 4 5 3))
       (=
         (fold-left (cut * <> <> <>) 1 '(1 2 3) '(1 2 3)) 36)
       (=
         (fold-left (cut + <> <>) 0 '(1 2 3 4)) 10)
       (=
         (fold-right (cut + <> <> <>) 0 '(1 2 3 4) '(10 20 30 40)) 110)
       (equal?
         (fold-right cons '() '(1 2 3 4))
         '(1 2 3 4))
       (=
         (fold-mapped (cut + <> <>) 0 (cut * <> <>) '(1 2 3 4) '(1 2 3 4)))
         30
       (=
         (fold-mapped (cut + <> <>) 0 (cut * <> 10) '(1 2 3 4)) 100)
       (=
         (last '(1 2 3)) 3)
       (equal?
         (append-item '() 1) '(1))
       (equal?
         (append-item '(1 2 3) 4) '(1 2 3 4))
       (equal?
         (map* sub1 '()) '())
       (equal?
         (map* sub1 '(1 (2 (3 (4))))) '(0 (1 (2 (3)))))
       (equal?
         (map* add1 '(1 (2 3) 4)) '(2 (3 4) 5))
       (equal?
         (filter* even? '()) '())
       (equal?
         (filter* odd? '(1 2 (3 4 (5 6 (7 8))))) '(1 (3 (5 (7)))))
       (equal?
         (filter* even? '(1 (2 3) 4)) '((2) 4))
       (=
         (plength 1) 1)
       (=
         (plength '(1 2 . 3)) 3)
       (equal?
         (listify '(1 2 . 3)) '(1 2 3))
       (equal?
         (listify 1) '(1))
       (equal?
         (listify '(1 2 3)) '(1 2 3))
       (equal?
         (unlist '(1 2 3)) '(1 2 . 3))
       (equal?
         (unlist '(1 (2 . 3) 4)) '(1 (2 . 3) . 4))
       (equal?
         (unlist '(1)) 1)
       (equal?
         (pmap add1 '(1 2 . 3)) '(2 3 . 4))
       (equal?
         (pmap add1 1) 2)
       (=
         (pmap (cut * <> <> <>) 1 2 3) 6)
       (equal?
         (pmap (cut + <> <>) '(1 2 . 3) '(10 20 . 30))
         '(11 22 . 33))
       (=
         (pmap* add1 1) 2)
       (equal?
         (pmap* add1 '(1 (2 . 3) . 4))
         '(2 (3 . 4) . 5))
       (eq?
         (pflat? 1) #t)
       (eq?
         (pflat? '(1 2 . 3)) #t)
       (eq?
         (pflat? '()) #f)
       (eq?
         (pflat? '(1 2 3)) #f)
       (equal?
         (pflatten '(1 (2 . 3) . 4))
         '(1 2 3 4))
       (equal?
         (cons* 1 2 3) '(1 2 . 3))
       (=
         (cons* 1) 1)
       (equal?
         (cons* 1 2 '(3 4))
         '(1 2 3 4))
       (equal?
         (cons* 1 '(2 3 . 4))
         '(1 2 3 . 4))
     )
     (print "All tests passed")
     (print "##### Some tests failed #####"))))