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