lith/lib.lith

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

(def list (lambda args args))

(macro (func decl body . rest)
    (if (eq? (typeof decl) 'pair)
        (list 'def (car decl)
            (cons 'lambda (cons (cdr decl) (cons body rest))))
        (error "func: expected function declaration")))

(func (caar x) (car (car x)))
(func (cadr x) (car (cdr x)))
(func (cdar x) (cdr (car x)))
(func (cddr x) (cdr (cdr x)))

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

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

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

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

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

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

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

(func (append a b)
    (foldr cons b a))

(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)))

(func (flip f)
    (lambda (a b)
        (f b a)))

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

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

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

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

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

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

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

(def infinity (:/ 1.0 0.0))
(def -infinity (:/ -1.0 0.0))

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

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

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

(func (mod a b) (:% a b))

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

(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)))))))

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

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

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

(func (1+ x) (+ x 1))
(func (1- x) (- x 1))

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

(func (length lst)
    (if (nil? lst)
        0
        (1+ (length (cdr lst)))))

(func (o f g) (lambda (x) (f (g x))))

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