; Misc handy library functions (many based on Haskell and ML)
; Copyright 2005 Brian Alliet

; Undefined
(define (undefined) (error "undefined"))

; error
(define (error msg) ((string-append "Error: " msg)))

; Take an n-argumet function and m initial arguments, returns a procedure that 
; applys the m initial arguments followed by any remaining arguments
; This is a little different than Haskell's curry but Haskell's curry doesn't make much 
; sense in Scheme
(define (curry f . initial)
    (lambda rest
        (apply f (append initial rest))))

; Left and right section operators (as in SML or Haskell)
(define (left-section  op arg) (lambda (x) (op arg x)))
(define (right-section op arg) (lambda (x) (op x arg)))

; fromTo generates a list containing each number in the range [beg,end]
; FEATURE: Use an accumulator
(define (from-to beg end)
    (cond
        ((> beg end) '())
        (else (cons beg (from-to (+ beg 1) end)))
    ))


; filter keeps only the elements of a list that match a predicate
; FEATURE: filer: optimize
(define (filter p xs)
    (match xs
        ('() '())
        ((cons x xs) (let ((rest (filter p xs))) (if (p x) (cons x rest) rest)))
    ))

; concat concatenates a list of lists
(define (concat xs) (apply append xs))

; haskell names for car and cdr
(define head car)
(define tail cdr)
(define fst car)
(define snd cdr)

; find the last element of a list
; FEATURE: last: optimize
(define-match last
    ('() (error "last: empty list"))
    ((list x) x)
    ((cons _ xs) (last xs)))

; FEATURE: init: optimize
(define-match init
    ('() (error "init: empty list"))
    ((list x) '())
    ((cons x xs) (cons x (init xs))))

; FEATURE: foldl: optimize
(define (foldl f z xs)
    (match xs
        ('() z)
        ((cons x xs) (foldl f (f z x) xs))))

; FEATURE: foldr: optimize
(define (foldr f z xs)
    (match xs
        ('() z)
        ((cons x xs) (f x (foldr f z xs)))))

; FEATURE: take: optimize
(define (take n xs)
    (if (eqv? n 0)
        '()
        (match xs
            ('() '())
            ((cons x xs) (cons x (take (- n 1) xs))))))

(define (drop n xs) (list-tail xs n))

(define (intersperse sep xs)
    (match xs
        ('() '())
        ((list _) '())
        ((cons x xs) (cons x (cons sep (intersperse sep xs))))))

; concatMap concatenates the results of applying map to a list
(define (concat-map f xs) 
    (concat (map f xs)))

(define (show x) (apply string-append (show_ x '())))

(define (show_ x rest)
    (cond
        ((null? x) (cons "()" rest))
        ((pair? x) (cons "(" (tail (foldr (lambda (x r) (cons " " (show_ x r))) (cons ")" rest) x))))
        ((string? x) (cons "\"" (cons x (cons "\"" rest))))
        ((number? x) (cons (number->string x) rest))
        ((symbol? x) (cons (symbol->string x) rest))
        ((char? x) (cons (list->string (list x)) rest))
        ('#t (cons "#t" rest))
        ('#f (cons "#f" rest))
        (else (error "can't show that"))
    ))

(define (lookup a xs)
    (match xs
        ('() #f)
        ((cons (cons k v) xs) (if (equal? k a) v (lookup a xs)))))

(define (zipWith f xs ys) (map f xs ys))
(define zip (curry zipWith cons))

(define (max x y) (if (> x y) x y))
(define (min x y) (if (< x y) x y))

(define (all f xs)
    (match xs
        ('() #t)
        ((cons x xs) (and (f x) (all f xs)))))

(define (compose f g) (lambda x (f (apply g x))))