1+ ; ;
2+ ; ; Simple library of useful functions and macros
3+ ; ;
4+
5+ (defun list (x . y)
6+ (cons x y))
7+
8+
9+ ; ; (and e1 e2 ...)
10+ ; ; => (if e1 (and e2 ...))
11+ ; ; (and e1)
12+ ; ; => e1
13+ (defmacro and (expr . rest )
14+ (if rest
15+ (list ' if expr (cons ' and rest ))
16+ expr))
17+
18+ ; ; (or e1 e2 ...)
19+ ; ; => (let <tmp> e1
20+ ; ; (if <tmp> <tmp> (or e2 ...)))
21+ ; ; (or e1)
22+ ; ; => e1
23+ ; ;
24+ ; ; The reason to use the temporary variables is to avoid evaluating the
25+ ; ; arguments more than once.
26+ (defmacro or (expr . rest )
27+ (if rest
28+ (let var (gensym )
29+ (list ' let var expr
30+ (list ' if var var (cons ' or rest ))))
31+ expr))
32+
33+ ; ; (let var val body ...)
34+ ; ; => ((lambda (var) body ...) val)
35+ (defmacro let (var val . body)
36+ (cons (cons ' lambda (cons (list var) body))
37+ (list val)))
38+
39+ ; ; (when expr body ...)
40+ ; ; => (if expr (progn body ...))
41+ (defmacro when (expr . body)
42+ (cons ' if (cons expr (list (cons ' progn body)))))
43+
44+ ; ; (unless expr body ...)
45+ ; ; => (if expr () body ...)
46+ (defmacro unless (expr . body)
47+ (cons ' if (cons expr (cons () body))))
48+
49+ ; ;;
50+ ; ;; List operators
51+ ; ;;
52+
53+ ; ;; Applies each element of lis to fn, and returns their return values as a list.
54+ (defun map (lis fn)
55+ (when lis
56+ (cons (fn (car lis))
57+ (map (cdr lis) fn))))
58+
59+ (defun reduce (fn lst init)
60+ (if (eq () lst)
61+ init
62+ (reduce fn
63+ (cdr lst)
64+ (fn init (car lst)))))
65+
66+ ; ; Applies each element of lis to pred. If pred returns a true value, terminate
67+ ; ; the evaluation and returns pred's return value. If all of them return (),
68+ ; ; returns ().
69+ (defun any (lis pred)
70+ (when lis
71+ (or (pred (car lis))
72+ (any (cdr lis) pred))))
73+
74+ ; ; returns t if elem exists in list l
75+ (defun member (l elem)
76+ (any l (lambda (x) (or (eq x elem) (= x elem)))))
77+
78+ ; ; Returns nth element of lis.
79+ (defun nth (lis n)
80+ (if (= n 0 )
81+ (car lis)
82+ (nth (cdr lis) (- n 1 ))))
83+
84+ ; ; Returns the nth tail of lis.
85+ (defun nth-tail (lis n)
86+ (if (= n 0 )
87+ lis
88+ (nth-tail (cdr lis) (- n 1 ))))
89+
90+ ; ; Returns a list consists of m .. n-1 integers.
91+ (defun %iota (m n)
92+ (unless (<= n m)
93+ (cons m (%iota (+ m 1 ) n))))
94+
95+ ; ; Returns a list consists of 0 ... n-1 integers.
96+ (defun iota (n) (%iota 0 n))
97+
98+ ; ; Returns a new list whose length is len and all members are init.
99+ (defun make-list (len init)
100+ (unless (= len 0 )
101+ (cons init (make-list (- len 1 ) init))))
102+
103+ ; ; Applies fn to each element of lis.
104+ (defun for-each (lis fn)
105+ (or (not lis)
106+ (progn (fn (car lis))
107+ (for-each (cdr lis) fn))))
108+
109+ ; Concatenates and flattens lists into a single list
110+ (defun append (first . rest )
111+ (if (eq () rest )
112+ first
113+ (append2 first
114+ (append-reduce rest ))))
115+
116+ (defun append2 (x y)
117+ (if (eq () x)
118+ y
119+ (cons (car x)
120+ (append2 (cdr x) y))))
121+
122+ (defun append-reduce (lists)
123+ (if (eq () (cdr lists))
124+ (car lists)
125+ (append2 (car lists)
126+ (append-reduce (cdr lists)))))
127+
128+ (defun filter (pred lst)
129+ (if (eq () lst)
130+ ()
131+ (if (pred (car lst))
132+ (cons (car lst)
133+ (filter pred (cdr lst)))
134+ (filter pred (cdr lst)))))
135+
136+ (defun quicksort (lst)
137+ (if (eq () lst)
138+ ()
139+ (if (eq () (cdr lst))
140+ lst
141+ (let pivot (car lst)
142+ (append
143+ (quicksort (filter (lambda (x) (< x pivot)) (cdr lst)))
144+ (cons pivot ())
145+ (quicksort (filter (lambda (x) (>= x pivot)) (cdr lst)))) ))))
146+
0 commit comments