;;;; lib.lith
;;;; the standard library of lith

(define (list . args) args)
(define (caar x) (car (car x)))
(define (cadr x) (car (cdr x)))
(define (cdar x) (cdr (car x)))
(define (cddr x) (cdr (cdr x)))

(define (not x) (if x #f #t))

(define (pair? p)
    (eq? (typeof p) 'pair))
(define (integer? i)
    (eq? (typeof i) 'integer))
(define (number? n)
    (eq? (typeof n) 'number))
(define (boolean? n)
    (eq? (typeof n) 'boolean))
(define (string? s)
    (eq? (typeof s) 'string))

(define (foldl f init lst)
    (if (nil? lst)
        init
        (foldl f (f init (car lst)) (cdr lst))))

(define (map f lst)
    (if (nil? lst)
        ()
        (cons (f (car lst)) (map f (cdr lst)))))

(define (foldr f init lst)
    (if (nil? lst)
        init
        (f (car lst) (foldr f init (cdr lst)))))

(define (last lst)
    (if (nil? lst)
        ()
        (if (nil? (cdr lst))
            (car lst)
            (last (cdr lst)))))

(define (reverse lst)
    (foldl (lambda (a x) (cons x a)) () lst))

(define (append a b)
    (foldr cons b a))

(define-macro (quasiquote x)
    (if (pair? x)
        (if (eq? (car x) 'unquote)
            (cadr x)
            (if (if (pair? (car x)) (eq? (caar x) 'unquote-splicing) #f)
                (list 'append
                    (cadr (car x))
                    (list 'quasiquote (cdr x)))
                (list 'cons
                    (list 'quasiquote (car x))
                    (list 'quasiquote (cdr x)))))
        (list 'quote x)))

(define (flip f)
    (lambda (a b)
        (f b a)))

(define-macro (and . x)
    (if (nil? x)
        #t
        `(if ,(car x) (and . ,(cdr x)) #f)))

(define-macro (or . x)
    (if (nil? x)
        #f
        `(if ,(car x) #t (or . ,(cdr x)))))

(define-macro (let env . body)
    `((lambda ,(map car env) . ,body) . ,(map cadr env)))

(define (numeric? x)
    (or (integer? x) (number? x)))

(define (+ . n)
    (foldl :+ 0 n))
(define (* . n)
    (foldl :* 1 n))

(define (- . n)
    (if (nil? n)
        0
        (foldl :- (car n) (cdr n))))

(define (/ . n)
    (if (nil? n)
        1
        (foldl :/ (car n) (cdr n))))

(define infty (:/ 1.0 0.0))
(define -infty (:/ -1.0 0.0))

(define (:<= a b) (not (:> a b)))
(define (:>= a b) (not (:< a b)))

(define (< a b . c)
    (if (nil? c)
        (:< a b)
        (and (:< a b) (apply < (cons b c)))))
(define (> a b . c)
    (if (nil? c)
        (:> a b)
        (and (:> a b) (apply > (cons b c)))))
(define (= a b . c)
    (if (nil? c)
        (:== a b)
        (and (:== a b) (apply = (cons b c)))))
(define (<= a b . c)
    (if (nil? c)
        (:<= a b)
        (and (:<= a b) (apply <= (cons b c)))))
(define (>= a b . c)
    (if (nil? c)
        (:>= a b)
        (and (:>= a b) (apply >= (cons b c)))))

(define (!= a b)
    (not (:== a b)))

(define (mod a b) (:% a b))

(define-macro (begin a . body)
    `((lambda () ,a . ,body)))

(define-macro (cond . body)
    (if (nil? body)
        (error "cond: no else clause")
        (if (not (pair? (car body)))
            (error "cond: expecting a list as clause")
            (if (eq? (caar body) 'else)
                `(begin . ,(cdar body))
                `(if ,(caar body)
                    (begin . ,(cdar body))
                    (cond . ,(cdr body)))))))

(define (sign x)
    (cond
        ((not (numeric? x)) (error "sign: input must be numeric"))
        ((< x 0) -1)
        ((> x 0) 1)
        (else 0)))

(define (filter f lst)
    (if (nil? lst)
        ()
        (let ((rest (filter f (cdr lst)))
              (cur (car lst)))
            (if (f cur)
                (cons cur rest)
                rest))))

(define (abs x)
    (if (< x 0) (- x) x))
(define (divides a b)
    (= (mod a b) 0))

(define (1+ x) (+ x 1))
(define (1- x) (- x 1))

(define (range a b)
    (if (> a b)
        ()
        (cons a (range (1+ a) b))))

(define (o f g) (lambda (x) (f (g x))))

(define (for-each f lst)
    (if (nil? lst)
        ()
        (begin (f (car lst)) (for-each f (cdr lst)))))