(def eachr (f things) (when things (eachr f (cdr things)) (f (car things)))) (def zip (a b) ; takes two lists, (p q r) and (1 2 3), returns ((p 1) (q 2) (r 3)) (if a (cons (list (car a) (car b)) (zip (cdr a) (cdr b))))) (mac push (x things) `(assign ,things (cons ,x ,things))) (def flatten (things) (let acc nil (rfnwith flattenize (x things) (if (pair? x) (eachr flattenize x) (push x acc))) acc)) (def string-strip (txt) (string-replace "\\s+$" "" (string-replace "^\\s+" "" txt))) (def joinstr (txt . things) (let joinables (flatten things) (apply + (to-string (car joinables)) (flatten (zip (map (fn (_) txt) (cdr joinables)) (map to-string (cdr joinables))))))) (def string-pieces pieces (joinstr "" pieces)) (def collect (f things) ; if 'things is a list, return all the items in the list for which 'f returns non-nil ; otherwise, return 'things if (f things) is non-nil ; otherwise, nil (rfnwith collector (items things) (if (no items) nil (pair? items) (if (f (car items)) (cons (car items) (collector (cdr items))) (collector (cdr items))) (f items) items))) (def nth (n things) ; returns the n-th item in the list 'things (if (eq? n 0) (car things) (nth (- n 1) (cdr things)))) (def iso (x y) (or (eq? x y) (and (pair? x) (pair? y) (iso (car x) (car y)) (iso (cdr x) (cdr y))))) (def x1 (thing) thing) (def sym? (arg) (isa 'symbol arg)) (def string? (arg) (isa 'string arg)) (mac just (arg) arg) (def quotify (arg) `(quote ,arg)) (def caris (obj things) ; returns true if 'things is a list and the first item of the ; list is the given object (and (isa 'pair things) (eq? (car things) obj))) (def list-length (things) (if (no things) 0 (atom? things) 1 (+ 1 (list-length:cdr things)))) (def len (xs) (if (no xs) 0 (pair? xs) (list-length xs) (string? xs) (string-length xs) (hash? xs) (list-length:hash-keys xs) nil)) (assign dynamics (hash)) (mac dynamic (name) ; creates a dynamic variable. (hash-set dynamics name t) (let with-mac-name (sym "w/~name") (w/uniq prev `(do (mac ,with-mac-name (new-value . body) (w/uniq result `(let ,',prev (hash-get (thread-locals) ',',name) (hash-set (thread-locals) ',',name ,new-value) (let ,result (do ,@body) (hash-set (thread-locals) ',',name ,',prev) ,result)))) (def ,name () (hash-get (thread-locals) ',name)))))) (mac on-err (handler . body) ; executes 'body. If an error is raised, executes 'handler. Inside ; 'handler, the parameter 'err refers to the error that was raised. `(handle-error (fn (err) ,handler) (fn () ,@body))) (mac ensure (protection . body) ; executes 'body. Afterwards, executes 'protection. ; 'protection is always executed even if there is an error. `(ensuring (fn () ,protection) (fn () ,@body))) (mac while (test . body) ; tests 'test, as long as 'test is non-nil, ; repeatedly executes 'body (w/uniq (rfname pred) `(rfnwith ,rfname (,pred ,test) (when ,pred ,@body (,rfname ,test))))) (mac loop (start test update . body) ; execute 'start. then for as long as 'test returns non-nil, ; execute 'body and 'update (w/uniq (gfn gparm) `(do ,start ((rfn ,gfn (,gparm) (if ,gparm (do ,@body ,update (,gfn ,test)))) ,test)))) (mac for (v init max . body) (w/uniq (gi gm) `(with (,v nil ,gi ,init ,gm (+ ,max 1)) (loop (assign ,v ,gi) (< ,v ,gm) (assign ,v (+ ,v 1)) ,@body)))) (mac mapx (things x expr) `(map (fn (,x) ,expr) ,things)) (def atom? (thing) (and thing (!pair? thing) (!hash? thing))) (def empty? (things) ; t if it's nil or an empty list, string, or hash ; nil otherwise (let l (len things) (and l (eq? l 0)))) (def present? (thing) ; t if it's a symbol or number, or a non-empty string, list or hash ; nil otherwise (!empty? thing)) (mac each (var things code) ; repeatedly assigns an element of 'things to 'var, ; and executes 'code each time (w/uniq (xs c) `((rfn ,c (,xs) (if (pair? ,xs) (do (let ,var (car ,xs) ,code) (,c (cdr ,xs))))) ,things))) (def reduce (f things) ((rfn rd (acc list) (if (pair? list) (rd (f acc (car list)) (cdr list)) acc)) (car things) (cdr things))) (def proper? (list) ; t if this is a proper list (last cdr is nil) ; nil otherwise (last cdr is neither cons nor nil) (or (no list) (and (pair? list) (proper? (cdr list))))) (def firstn (n things) ; returns the first 'n items in the list 'things (if (eq? n 0) nil (cons (car things) (firstn (- n 1) (cdr things))))) (def nthcdr (n things) ; returns the nth cdr of the list 'things (if (> n 0) (nthcdr (- n 1) (cdr things)) things)) (def joinlists (things . more-thingses) ; return a new list which is the concatenation of all the given lists ; 'things is a list ; 'more-thingses is a list of lists ; call like this: (joinlists '(a b c) '(x y z) '(1 2 3)) (if things (cons (car things) (apply joinlists (cdr things) more-thingses)) more-thingses (apply joinlists more-thingses))) (def curry (func . args1) ; return a new function which is the original function with ; the given args1 already applied ; arguments to the new function are whatever arguments remain ; for the old function (fn args (apply func (joinlists args1 args)))) (def detect (f things) ; if 'f is a function, ; if 'things is a list, return the first item in the list for which 'f returns non-nil ; otherwise, return 'things if (f things) is non-nil ; otherwise, nil ; if 'f is not a function, self-invoke with a function checking for equality with f ; ; WARNING: if the detected thing is nil, returns t instead. A return value of nil ; means the thing was not found ; non-nil means the thing was found, including when ; the found thing is itself nil. (if (isa 'fn f) (rfnwith d (items things) (if (pair? items) (let it (car items) (or (and (f it) (or it t)) (d:cdr items))) (f items) items)) (detect (curry eq? f) things))) (def tuples (n things) ;; split things into a list of lists each n long (rfnwith _ (list things) (if (no list) nil (cons (firstn n list) (_ (nthcdr n list)))))) (def range (start stop) ; return a list containing the range ; of elements starting with 'start, up ; to but not including 'stop (if (< start stop) (cons start (range (+ start 1) stop)))) (def best (f things) (if (no things) nil (let winner (car things) (each thing (cdr things) (if (f thing winner) (= winner thing))) winner))) (def min things (best < things)) (def max things (best > things)) (def hash-cons (h k v) (= h.,k (cons v h.,k)))