Skip to content
Newer
Older
100644 229 lines (180 sloc) 6.06 KB
afe72ee @itfrombit Split out CL functions. Started test cases.
authored
1 ;; @file cl_utils.nu
2 ;; @discussion Nu versions of popular Common Lisp functions and macros.
3 ;;
4 ;; @copyright Copyright (c) 2009 Jeff Buck
5 ;;
6 ;; Licensed under the Apache License, Version 2.0 (the "License");
7 ;; you may not use this file except in compliance with the License.
8 ;; You may obtain a copy of the License at
9 ;;
10 ;; http://www.apache.org/licenses/LICENSE-2.0
11 ;;
12 ;; Unless required by applicable law or agreed to in writing, software
13 ;; distributed under the License is distributed on an "AS IS" BASIS,
14 ;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15 ;; See the License for the specific language governing permissions and
16 ;; limitations under the License.
17
18
19 ;; These functions are part of Common Lisp.
20 ;; The subsequent examples in the book assume they are defined.
21
22
23 (function mapcar-1 (f l)
24 (cond
25 ((null? l) nil)
26 (else
27 (cons (f (car l)) (mapcar-1 f (cdr l))))))
28
29 ;; Nu's cadr-type built-ins are postfix.
30 ;; Not as suitable for lispy mapping functions.
31 (function caar (l)
32 (car (car l)))
33
34 (function cadr (l)
35 (car (cdr l)))
36
37 (function cddr (x)
38 (cdr (cdr x)))
39
40
41
42 (macro-1 incf (n *delta)
43 (if (not (eq *delta '()))
44 (then `(set ,n (+ ,n ,(car *delta))))
45 (else `(set ,n (+ ,n 1)))))
46
47 (macro-1 decf (n *delta)
48 (if (not (eq *delta '()))
49 (then `(set ,n (- ,n ,(car *delta))))
50 (else `(set ,n (- ,n 1)))))
51
52
53 (function evenp (x)
54 ((eq 0 (% x 2))))
55
56 (function oddp (x)
57 (not (evenp x)))
58
a846094 @itfrombit Split functionality across files. Added NuTestCase wrapper for logging.
authored
59 (set even? evenp)
60 (set odd? oddp)
61
afe72ee @itfrombit Split out CL functions. Started test cases.
authored
62 (function select-if (f l)
63 (function select-if-acc (f l acc)
64 (if (null? l)
65 (then acc)
66 (else
67 (if (f (car l))
68 (then (select-if-acc f (cdr l) (append acc (list (car l)))))
69 (else (select-if-acc f (cdr l) acc))))))
70 (select-if-acc f l nil))
71
72
73 (function nthcdr (n source)
74 (cond ((eq n 0)
75 source)
76 ((> n (source length)) nil)
77 (else (nthcdr (- n 1) (cdr source)))))
78
79
80 (function subseq (l start end)
81 (if (eq (l class) ("a" class))
82 (then
a846094 @itfrombit Split functionality across files. Added NuTestCase wrapper for logging.
authored
83 (if (>= start end)
84 (then "")
85 (else
86 ;; String - use substring
87 (l substringWithRange:(list start (- end start))))))
afe72ee @itfrombit Split out CL functions. Started test cases.
authored
88 (else
a846094 @itfrombit Split functionality across files. Added NuTestCase wrapper for logging.
authored
89 ;; Assume a list - use cdrs
90 (set len (l length))
afe72ee @itfrombit Split out CL functions. Started test cases.
authored
91 (set i start)
92 (set result nil)
a846094 @itfrombit Split functionality across files. Added NuTestCase wrapper for logging.
authored
93 (while (and (< i end) (< i len))
afe72ee @itfrombit Split out CL functions. Started test cases.
authored
94 (set result (append result (list (car (nthcdr i l)))))
95 (set i (+ i 1)))
96 result)))
97
98
a846094 @itfrombit Split functionality across files. Added NuTestCase wrapper for logging.
authored
99 (function last (l *n)
afe72ee @itfrombit Split out CL functions. Started test cases.
authored
100 (let ((len (l length)))
a846094 @itfrombit Split functionality across files. Added NuTestCase wrapper for logging.
authored
101 (if *n
102 (then (set count (car *n)))
103 (else (set count 1)))
104 (if (> count len)
105 (then (set count len)))
106 (subseq l (- len count) len)))
afe72ee @itfrombit Split out CL functions. Started test cases.
authored
107
108
109 (function butlast (l *n)
110 (if (not (eq *n '()))
111 (then (set count (car *n)))
112 (else (set count 1)))
113 (let ((len (l length)))
114 (if (>= count len)
115 (then '())
116 (else (subseq l 0 (- len count))))))
117
118
119
120 (macro-1 let* (bindings *body)
121 (if (null? bindings)
122 (then
123 `(progn
124 ,@*body))
125 (else
126 (set __nextcall `(let* ,(cdr bindings) ,@*body))
127 `(let (,(car bindings))
128 ,__nextcall))))
129
130
131 ;; Not part of Common Lisp, but popular functions to have around...
132
133 ;; Glue up a string from various substrings.
134 (function mkstr (*rest)
135 (set s "")
136 (*rest each:
137 (do (a)
138 (set s (+ s a))))
139 s)
140
141 ;; Make a symbol name out of a list of substrings.
142 (function symb (*rest)
143 ((apply mkstr *rest) symbolValue))
144
145
146 ;; Group a flat list into lists of length n.
147 (function group (source n)
148 (function group-rec (source n acc)
149 (let ((rest (nthcdr n source)))
150 (if (pair? rest)
151 (then
152 (group-rec rest n (cons (subseq source 0 n) acc)))
153 (else
154 (reverse (cons source acc))))))
155 (if source
156 (then (group-rec source n nil))
157 (else nil)))
158
159
160 ;; Flatten a nested list.
161 (function flatten (x)
162 (function flatten-rec (x acc)
163 (cond
164 ((eq x nil) acc)
165 ((atom? x) (cons x acc))
166 (else (flatten-rec (car x) (flatten-rec (cdr x) acc)))))
167 (flatten-rec x nil))
168
169
170 ;; A few math functions
171 (function fact (x)
172 (if (<= x 0)
173 (then 1)
174 (else (* x (fact (- x 1))))))
175
176 (function choose (n r)
177 (/ (fact n)
178 (fact (- n r))
179 (fact r)))
180
181 (function perm (n r)
182 (/ (fact n)
183 (fact (- n r))))
184
185
186 ;; The rest of the functions in this file are not part of
187 ;; Common Lisp, but they are "Common Lispy" enough to include
188 ;; here. They are provided as a convenience functions that a
189 ;; multi-list mapcar could otherwise provide.
190
191 ;; returns the obvious on a list of lists.
192 (function cars (lists)
193 (mapcar-1 car lists))
194
195 (function cdrs (lists)
196 (mapcar-1 cdr lists))
197
198 ;; Nu's map provides similar functionality to weave,
199 ;; but doesn't work for quoted lists like this:
200 ;; (map list '(a b c) '(x y z))
201 ;; It tries to eval the list elements.
202 ;; ^ the internal apply is the guilty party in map.
203
204 ;; weave only works for two lists.
205 ;; ex: (weave '(a b c) '(x y z)) -> (a x) (b y) (c z)
206 (function weave (*lists)
207 (function weave-rec (lists)
208 (cond
209 ((null? lists) nil)
210 ((null? (car lists)) nil)
211 (else
212 (cons
213 (cars lists)
214 (weave-rec (cdrs lists))))))
215 (weave-rec *lists))
216
217
218 ; Nu adds a "list" method to NSArray.
219 ; This function turns a string into a list of characters.
220 (function listify (s)
221 (let ((i 0)
222 (len (s length))
223 (result '()))
224 (while (< i len)
225 (set result (append result (list (subseq s i (+ i 1)))))
226 (set i (+ i 1)))
227 result))
228
Something went wrong with that request. Please try again.