216 lines
6.8 KiB
Common Lisp
216 lines
6.8 KiB
Common Lisp
;;;; stdlib
|
|
|
|
;;; useful stuff
|
|
(def \n "
|
|
")
|
|
(def nil '())
|
|
(def fn lambda)
|
|
(def nil? (macro (l) (_=_ l nil)))
|
|
(def list (lambda (. args) args))
|
|
|
|
;;; easier functions
|
|
(def defmacro-defun-codegen
|
|
(lambda (head name args body)
|
|
(list def name
|
|
(list head args
|
|
(if (nil? body) nil
|
|
(if (nil? (cdr body)) (car body)
|
|
(cons do body)))))))
|
|
(def defmacro (macro (name args . body) (eval (defmacro-defun-codegen macro 'name 'args 'body))))
|
|
(defmacro defun (name args . body) (eval (defmacro-defun-codegen lambda 'name 'args 'body)))
|
|
(def defn defun)
|
|
|
|
;;; useful functions
|
|
(defmacro comment (. a) nil)
|
|
|
|
(defun reduce (f a l) (if (nil? l) a (reduce f (f a (car l)) (cdr l))))
|
|
(defun foldr (f a l) (if (nil? l) a (f (foldr f a (cdr l)) (car l))))
|
|
|
|
;;; boolean functions
|
|
(defun not (boo) (if boo false true))
|
|
(defun or-codegen (args) (if (nil? args) false (list if (car args) true (or-codegen (cdr args)))))
|
|
(defun and-codegen (args) (if (nil? args) true (list if (car args) (and-codegen (cdr args)) false)))
|
|
(defmacro or (. args) (eval ( or-codegen 'args)))
|
|
(defmacro and (. args) (eval (and-codegen 'args))) ; (and 1 2 3) = (if 1 (if 2 3 false) false)
|
|
|
|
(defun cond-codegen (args)
|
|
(if (nil? args) nil ; (raise "wrong arity of cond")
|
|
(if (nil? (cdr args)) (car args)
|
|
(list if (car args) (car (cdr args)) (cond-codegen (cdr (cdr args)))))))
|
|
(defmacro cond (. args) (eval (cond-codegen 'args))) ; (cond 1 2 3 4 5) = (if 1 2 (if 3 4 5))
|
|
|
|
;;; basic math operations
|
|
; (defun + (. args) (if (nil? args) 0 (reduce _+_ (car args) (cdr args)))) ; ability to interop +
|
|
(defun + (. args) (reduce _+_ 0 args)) ; (+ 1 2 3 4) = (_+_ 0 (_+_ 1 (_+_ 2 (_+_ 3 4))))
|
|
(defun * (. args) (reduce _*_ 1 args))
|
|
(defun ++ (. args) (reduce _++_ "" args))
|
|
|
|
(defun - (. args)
|
|
(cond (nil? args) (raise "zero args for -")
|
|
(nil? (cdr args)) (_-_ 0 (car args))
|
|
(reduce _-_ (car args) (cdr args))))
|
|
(defun / (. args)
|
|
(cond (nil? args) (raise "zero args for /")
|
|
(nil? (cdr args)) (_/_ 1 (car args))
|
|
(reduce _/_ (car args) (cdr args))))
|
|
(defun % (. args)
|
|
(cond (nil? args) (raise "zero args for %")
|
|
(nil? (cdr args)) (raise "one arg for %")
|
|
(reduce _%_ (car args) (cdr args))))
|
|
|
|
;;; basic binary predicates
|
|
(defun bp-core (bp a l) (if (nil? l) true (if (bp a (car l)) (bp-core bp (car l) (cdr l)) false )))
|
|
(defun bp-pre-core (bp args) (if (nil? args) true (bp-core bp (car args) (cdr args))))
|
|
|
|
(defun < (. args) (bp-pre-core _<_ args))
|
|
(defun > (. args) (bp-pre-core _>_ args))
|
|
|
|
(defun _>=_ (a b) (not (_<_ a b)))
|
|
(defun _<=_ (a b) (not (_>_ a b)))
|
|
(defun <= (. args) (bp-pre-core _<=_ args))
|
|
(defun >= (. args) (bp-pre-core _>=_ args))
|
|
|
|
(defun three-op-eq (a b c) (if (_=_ a b) (_=_ b c) false))
|
|
(defun bineq (a b)
|
|
(def type-a (typeof a))
|
|
(def type-b (typeof b))
|
|
(cond (three-op-eq type-a type-b "Symbol") (_=_ (++ a) (++ b))
|
|
(three-op-eq type-a type-b "List") (_=_ (++ a) (++ b))
|
|
(_=_ a b)))
|
|
(defun = (. args) (bp-pre-core bineq args))
|
|
(defun != (. args) (not (bp-pre-core bineq args)))
|
|
|
|
;;; list tools
|
|
(defun map (func lst)
|
|
(if (nil? lst) nil
|
|
(cons (func (car lst)) (map func (cdr lst)))))
|
|
|
|
(defun reverse-core (lst acc) (if (nil? lst) acc (reverse-core (cdr lst) (cons (car lst) acc))))
|
|
(defun reverse (lst) (reverse-core lst nil))
|
|
|
|
(defun map-reverse-core (func lst acc)
|
|
(if (nil? lst) acc
|
|
(map-reverse-core func (cdr lst) (cons (func (car lst)) acc))))
|
|
(defun map-reverse (func lst) (map-reverse-core func lst nil))
|
|
(defun map-tail (func lst) (reverse (map-reverse func lst)))
|
|
|
|
(defun filter (pred lst)
|
|
(cond (nil? lst) nil
|
|
(pred (car lst)) (cons (car lst) (filter pred (cdr lst)))
|
|
(filter pred (cdr lst))))
|
|
|
|
(defun take (n lst)
|
|
(cond (< n 1) nil
|
|
(nil? lst) nil
|
|
(cons (car lst) (take (- n 1) (cdr lst)))))
|
|
|
|
(defun drop (n lst)
|
|
(cond (< n 1) lst
|
|
(nil? lst) nil
|
|
(drop (- n 1) (cdr lst))))
|
|
|
|
(defun append-reverse (a b)
|
|
(if (nil? a) b (append-reverse (cdr a) (cons (car a) b))))
|
|
(defun append (a b) (append-reverse (reverse a) b))
|
|
|
|
(defun concat (lsts) (reduce append nil lsts))
|
|
|
|
(defun length (lst) (reduce (lambda (a b) (+ a 1)) 0 lst))
|
|
|
|
(defun all? (pred lst)
|
|
(cond (nil? lst) true
|
|
(pred (car lst)) (all? pred (cdr lst))
|
|
false))
|
|
|
|
(defun any? (pred lst)
|
|
(cond (nil? lst) false
|
|
(pred (car lst)) true
|
|
(any? pred (cdr lst))))
|
|
|
|
(defun indexof-from (elem lst idx)
|
|
(cond (nil? lst) -1
|
|
(= elem (car lst)) idx
|
|
(indexof-from elem (cdr lst) (+ 1 idx))))
|
|
(defun indexof (elem lst) (indexof-from elem lst 0))
|
|
|
|
(defun range (a b) ; [a b)
|
|
(if (< a b) (cons a (range (+ 1 a) b)) nil))
|
|
|
|
(defun range-tail-core (a b acc)
|
|
(if (< a b) (range-tail-core a (- b 1) (cons (- b 1) acc)) acc))
|
|
(defun range-tail (a b) (range-tail-core a b nil))
|
|
|
|
(defun list-ref (n lst)
|
|
(def tmp (drop n lst))
|
|
(if (nil? tmp) (raise (++ "index out of bounds: " n " of " lst))
|
|
(car tmp)))
|
|
|
|
(defun zip-with (f a b)
|
|
(if (or (nil? a) (nil? b)) nil
|
|
(cons (f (car a) (car b)) (zip-with f (cdr a) (cdr b)))))
|
|
|
|
(defun flatten (lsts)
|
|
(cond (!= (typeof lsts) "List") (list lsts)
|
|
(nil? lsts) nil
|
|
(append (flatten (car lsts)) (flatten (cdr lsts)))))
|
|
|
|
(defun distinct (lst)
|
|
(if (nil? lst) nil
|
|
(cons (car lst) (distinct (filter (lambda (v) (!= v (car lst))) (cdr lst))))))
|
|
|
|
|
|
; (defn map-n (f . l)
|
|
; (cond (nil? l) nil
|
|
; (any? nil? l) nil
|
|
; (cons (eval (cons f (map car 'l))) (eval (cons map-n (cons f (map cdr 'l)))))))
|
|
|
|
|
|
(defmacro apply-1 (f args)
|
|
(eval (cons f args)))
|
|
|
|
(defn map-n-core (f l)
|
|
(if (or (nil? l) (any? nil? l))
|
|
nil
|
|
(cons (apply-1 f (map car l))
|
|
(map-n-core f (map cdr l)))))
|
|
|
|
(defn map-n (f . l)
|
|
(map-n-core f l))
|
|
|
|
|
|
(defn cond-append (u v) (if (or (= false u) (= false v)) false (append u v))) ;; append-revers
|
|
|
|
(defn match-codegen (p v) ;; check-pattern
|
|
(def type-p (typeof p))
|
|
(cond (= type-p "Symbol") (if (= p '_) nil (list (list def p (list quote v)))) ;; TODO quote only lists
|
|
(= type-p "List")
|
|
(cond
|
|
(!= (typeof v) "List") false
|
|
(nil? p) (if (nil? v) nil false)
|
|
(= (car p) '.) (match-codegen (car (cdr p)) v)
|
|
(nil? v) false
|
|
(cond-append (match-codegen (car p) (car v))
|
|
(match-codegen (cdr p) (cdr v))))
|
|
(= p v) nil
|
|
false))
|
|
|
|
(defmacro when (c . body) (if c (eval (cons do 'body)) nil))
|
|
|
|
(defn check-pattern? (p)
|
|
(def syms (filter (lambda (e) (and (= (typeof e) "Symbol") (!= e '_) (!= e '.))) (flatten p)))
|
|
(= syms (distinct syms) syms))
|
|
|
|
(defn match-wrap (p v)
|
|
; (when (not (check-pattern? p)) (raise (++ "bad pattern: " p)))
|
|
(def code (match-codegen p v))
|
|
(if (= code false) false
|
|
(cons do (append code '(true)))))
|
|
|
|
(defmacro match (p v) (eval (match-wrap 'p v)))
|
|
|
|
|
|
(defun prints (. args) (reduce (lambda (nothing arg) (print arg)) nil args))
|
|
|
|
|
|
|
|
(prints "stdlib loaded" \n) |