; Typical combinations of car & cdr: (def 'cadr (lambda (x) (car (cdr x)))) (def 'caddr (lambda (x) (car (cddr x)))) (def 'cddr (lambda (x) (cdr (cdr x)))) (def 'cdddr (lambda (x) (cdr (cdr (cdr x))))) ; More englishy names for cars & cdrs: (def 'first (lambda (x) (car x))) (def 'rest (lambda (x) (cdr x))) (def 'second (lambda (x) (cadr x))) (def 'third (lambda (x) (caddr x))) (def 'defun (nlambda (args) (let name (first args) params (second args) body (third args) _ (assert (null (cdddr args))) (def name (list 'lambda params body))))) ; wrappers for cmp, which is really strcmp from C (defun str-lt (a b) (eq '< (cmp a b))) (defun str-le (a b) (let c (cmp a b) (if (eq c '<) t (eq c '=)))) (defun str-eq (a b) (eq '= (cmp a b))) (defun str-ne (a b) (not (eq '= (cmp a b)))) (defun str-gt (a b) (eq '> (cmp a b))) (defun str-ge (a b) (let c (cmp a b) (if (eq c '>) t (eq c '=)))) (defun equal (a b) ; recursively compare lists with eq (if (atomp a) (eq a b) (if (atomp b) 'nil (if (equal (car a) (car b)) (equal (cdr a) (cdr b)) 'nil)))) (assert (equal 'nil 'nil)) (assert (equal 'foo 'foo)) (assert (not (equal 'foo 'bar))) (assert (equal '(foo bar) '(foo bar))) (assert (not (equal '(foo bar) '(foo)))) (assert (not (equal '(foo bar) '(foo bar bar)))) (defun assert-equal (a b) (if (equal a b) (assert 't) ; just to increment count_prim_assert (assert (not (say (list 'FAILURE: (list 'assert-equal a b))))))) (defun append (x y) (if (null x) y (cons (car x) (append (cdr x) y)))) (assert-equal '(a b c d e f) (append '(a b) (append '(c d) '(e f)))) (defun reverse (x) (if (null x) x (append (reverse (cdr x)) (list (car x))))) (assert-equal '(a b c d e f) (reverse '(f e d c b a))) ; Helper Function for isort: (defun ins (x L) ; insert item x into sorted list L at correct place (if (null L) (list x) (if (str-lt x (car L)) (cons x L) (cons (car L) (ins x (cdr L)))))) ; Insertion Sort (defun isort (L) ; sort list, using insertion sort (if (null L) 'nil (ins (car L) (isort (cdr L))))) ; test the isort command (assert (equal '(a b c x y z) (isort '(x b a z y c)))) (assert (equal 'nil (isort 'nil))) ; Normal MAPCAR (defun mapcar (lst fn) ; apply fn to each element of list & return results in a new list. (if (null lst) 'nil (cons (fn (car lst)) (mapcar (cdr lst) fn)))) (assert-equal '(= > > <) (mapcar '(one two three four) (lambda (x) (cmp x 'one)))) ; Normal subst & subst-if (Common Lisp 15.4) (defun subst (new old tree) (if (eq tree old) new (if (atomp tree) tree (cons (subst new old (car tree)) (subst new old (cdr tree)))))) (assert equal '(shakespeare wrote (the tempest)) (subst 'tempest 'hurricane '(shakespeare wrote (the hurricane)))) (defun subst-if (new test tree) (if (test tree) new (if (atomp tree) tree (cons (subst new test (car tree)) (subst new test (cdr tree)))))) (assert equal '(tempest tempest (tempest tempest)) (subst-if 'tempest atomp '(shakespeare wrote (the hurricane)))) (assert equal '(shakespeare wrote CENSORED) (subst-if 'CENSORED (lambda (x) (if (atomp x) 'nil (eq x 'the))) '(shakespeare wrote (the hurricane)))) ; member, for Using Lists as Sets. (common Lisp 15.5) (defun member (item lst) (if (null lst) 'nil (if (eq item (car lst)) lst (member item (cdr lst))))) (assert (not (member 'foo '(one two three)))) (assert (not (member 'nil '(one two three)))) (assert (member 'one '(one two three)))) (assert (member 'three '(one two three)))) (assert (member 'nil '(one two three nil)))) ; union & intersection of lists (defun union (a b) (if (null a) b (if (member (car a) b) (union (cdr a) b) (union (cdr a) (cons (car a) b))))) (assert (equal '() (isort (union '() '())))) (assert (equal '(a) (isort (union '(a) '())))) (assert (equal '(z) (isort (union '() '(z))))) (assert (equal '(a b c d) (isort (union '() '(a b c d))))) (assert (equal '(a b c d) (isort (union '(a b c) '(c d))))) (assert (equal '(a b c d) (isort (union '(a b c d) '())))) (defun intersection (a b) (if (null a) 'nil (if (member (car a) b) (cons (car a) (intersection (cdr a) b)) (intersection (cdr a) b))))) (assert (equal '() (isort (intersection '() '())))) (assert (equal '() (isort (intersection '(a) '())))) (assert (equal '() (isort (intersection '() '(z))))) (assert (equal '(x) (isort (intersection '(a x) '(x z))))) ; now try MACRO subst (defun zip (a b) (if (null a) 'nil (cons (list (car a) (car b)) (zip (cdr a) (cdr b))))) ;('zork (zip '(a b c) '(x y z))) (assert (equal '((a x) (b y) (c z)) (zip '(a b c) '(x y z)))) (defun subst-list (newList oldList tree) (let zipped (zip newList oldList) (subst-list-zipped zipped zipped tree))) (defun subst-list-zipped (newOldZip fullZip tree) (if (null newOldZip) (if (atomp tree) tree (cons (subst-list-zipped fullZip fullZip (car tree)) (subst-list-zipped fullZip fullZip (cdr tree)))) (let pair (car newOldZip) rest (cdr newOldZip) new (car pair) old (cadr pair) (if (eq tree old) new (subst-list-zipped rest fullZip tree))))) (assert (equal '(shakespeare wrote (a tempest)) (subst-list '(a tempest) '(the hurricane) '(shakespeare wrote (the hurricane))))) ; Test NLAMBDA (def 'test-quote-list '(nlambda (a) a)) (assert (equal '(one 2 3) (test-quote-list one 2 3))) 'OKAY (defun filter (lst p) (if (null lst) 'nil (if (p (car lst)) (cons (car lst) (filter (cdr lst) p)) (filter (cdr lst) p)))) (assert (equal '(nil nil) (filter '(1 nil 2 nil 3) not))) (let tmp (filter '(1 a 2 b 3 c) (lambda (x) (str-lt x '@))) ;_ (say tmp) (assert (equal '(1 2 3) tmp))) ;(mapcar '(111 222 333) say) (defun reduce (lst f init) (if (null lst) init (f (car lst) (reduce (cdr lst) f init)))) (let tmp (reduce '((1 2) () (3 4 5) (6)) append 'nil) ;_ (say tmp) (assert-equal '(1 2 3 4 5 6) tmp))