(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) `(= ,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) ; flatten 'things into a single list (ie unnest lists) ; convert each item to a string ; return a single string which is the concatenation of each ; stringified item, with given 'txt inserted in between ; each item (let joinables (flatten things) (apply + (to-string (car joinables)) (flatten (zip (map (fn (_) txt) (cdr joinables)) (map to-string (cdr joinables))))))) (def j items ; delegate to 'joinstr with an empty join string (joinstr "" items)) (def string-pieces pieces ; string-interpolation syntax emits this form. Default implementation ; is to delegate to 'j , but containing forms may use macros that ; override this in order to provide specific interpolation behaviour ; (for example, formatting numbers or stripping HTML tags) (j 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 reject (f things) ; return all the items in 'things for which 'f returns nil (collect !f things)) (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 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))