/[clazy]/clazy/seq-funs.lisp
ViewVC logotype

Contents of /clazy/seq-funs.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (show annotations)
Fri Dec 17 13:13:01 2010 UTC (3 years, 4 months ago) by mantoniotti
Branch: MAIN
CVS Tags: HEAD
Changes since 1.5: +66 -2 lines
Minor changes.
1 ;;;; -*- Mode: Lisp -*-
2
3 ;;;; seq-funs.lisp --
4 ;;;;
5 ;;;; The function in this file are taken from:
6 ;;;; http://haskell.org/ghc/docs/latest/html/libraries/base-4.0.0.0/Data-List.html
7 ;;;;
8 ;;;; See the COPYING file for copyright and licensing information.
9 ;;;;
10 ;;;; Note that the list is incomplete. Some functions are not
11 ;;;; implemented and other may have a slightly differen semantics. Plus,
12 ;;;; many are CL-ified by adding the standard keywords a CLer expects.
13 ;;;; Also, many functions are not as "lazy" as they should be. The
14 ;;;; actual lazy implementation could be dropped in place without problems.
15 ;;;;
16 ;;;; Note 20090220:
17 ;;;; A note on the implementation style. I decided to use [E]TYPECASE
18 ;;;; in lieu of generic functions. In a way this was done to keep
19 ;;;; this initial design simple. Defining generic functions is better
20 ;;;; done in a general setting where *all* sequence functions are
21 ;;;; "genericified". It can be done later...
22
23 (in-package "CL.EXT.SEQUENCES.LAZY")
24
25
26 (deftype seq-index ()
27 "The type of the indices inside a sequence.
28
29 Although not necessarily right for lists, the upper bound is set to
30 ARRAY-DIMENSION-LIMIT."
31 `(integer 0 ,array-dimension-limit)) ; Is this right? Lists?
32
33
34 (deftype list-index ()
35 "The type of the indices inside a list.
36
37 Although not necessarily right for lists, the upper bound is set to
38 MOST-POSITIVE-FIXNUM."
39 `(integer 0 ,most-positive-fixnum))
40
41
42 #+full-lazy
43 (defun take (n seq)
44 "Takes the first N elements of the sequence SEQ.
45
46 The result is a fresh sequence of the first N elements. SEQ can be a
47 SEQUENCE or a LAZY-STREAM. The type of the result is the same as the
48 type of SEQ if this is a SEQUENCE, otherwise it is a LIST."
49 (declare (type seq-index n)
50 (type (or sequence lazy-stream) seq))
51 (etypecase seq
52 (sequence
53 (subseq seq 0 (max 0 (min n (length seq)))))
54 (lazy-stream
55 (if (minusp n)
56 ;; (head seq)
57 nil
58 (lazy:call 'cons
59 (head seq)
60 (take (1- n) (tail seq)))))
61 ))
62
63
64 (defun take (n seq)
65 "Takes the first N elements of the sequence SEQ.
66
67 The result is a fresh sequence of the first N elements. SEQ can be a
68 SEQUENCE or a LAZY-STREAM. The type of the result is the same as the
69 type of SEQ if this is a SEQUENCE, otherwise it is a LIST."
70 (declare (type seq-index n)
71 (type (or sequence lazy-stream) seq))
72 (etypecase seq
73 (sequence
74 (subseq seq 0 (max 0 (min n (length seq)))))
75 (lazy-stream
76 (if (minusp n)
77 ;; (head seq)
78 nil
79 (loop repeat n
80 for st = seq then (tail st)
81 collect (head st))))))
82
83
84 (defun drop (n seq)
85 "Drops the first N elements of the sequence SEQ.
86
87 The result is a fresh sequence of the last (- (length SEQ) N)
88 elements. SEQ can be a SEQUENCE or a LAZY-STREAM. The type of the
89 result is the same as the type of SEQ if this is a SEQUENCE, otherwise
90 it is a LAZY-STREAM or NIL (if dropping more items than the - finite -
91 length of the LAZY-STREAM)."
92 (declare (type seq-index n)
93 (type (or sequence lazy-stream) seq))
94 (etypecase seq
95 (sequence
96 (if (plusp n)
97 (subseq seq (min n (length seq)))
98 (copy-seq seq)))
99 (lazy-stream
100 (loop for st = seq then (tail st)
101 repeat n
102 finally (return st)))))
103
104
105 (defun split-at (n seq)
106 "Returns two subsequences of SEQ split at the N-th element."
107 (values (take n seq) (drop n seq)))
108
109
110 #+full-lazy
111 (defun take-while (p seq)
112 "Takes the first elements of the sequence SEQ that satisfy the predicate P.
113
114 SEQ can be a SEQUENCE or a LAZY-STREAM. The type of the result is the
115 same as the type of SEQ if this is a SEQUENCE, otherwise it is a
116 LIST."
117 (declare (ftype (function (t) t) p)
118 (type (or sequence lazy-stream)))
119 (etypecase seq
120 (sequence
121 (let ((n (position-if (complement p) seq)))
122 (declare (type (or null fixnum) n))
123 (if n
124 (take n seq)
125 (copy-seq seq))))
126 (lazy-stream
127 (let ((x (head seq)))
128 (when (funcall p x)
129 (lazy:call 'cons
130 x
131 (take-while p (tail seq))))))
132 ))
133
134
135 (defun take-while (p seq)
136 "Takes the first elements of the sequence SEQ that satisfy the predicate P.
137
138 SEQ can be a SEQUENCE or a LAZY-STREAM. The type of the result is the
139 same as the type of SEQ if this is a SEQUENCE, otherwise it is a
140 LIST."
141 (declare (type (function (t) t) p)
142 (type (or sequence lazy-stream)))
143 (etypecase seq
144 (sequence
145 (let ((n (position-if (complement p) seq)))
146 (declare (type (or null fixnum) n))
147 (if n
148 (take n seq)
149 (copy-seq seq))))
150 (lazy-stream
151 (loop for s = seq then (tail s)
152 for e = (head s)
153 while (funcall p e)
154 collect e))))
155
156
157 #+full-lazy
158 (defun drop-while (p seq)
159 "Drops the first elements of the sequence SEQ that satisfy the predicate P."
160 (etypecase seq
161 (null nil)
162 (sequence
163 (let ((n (position-if (complement p) seq)))
164 (if n
165 (drop n seq)
166 (subseq seq 0 0))))
167 (lazy-stream
168 (let ((x (head seq)))
169 (if (not (funcall p x))
170 seq
171 (drop-while p (tail seq)))))
172 ))
173
174
175 (defun drop-while (p seq)
176 "Drops the first elements of the sequence SEQ that satisfy the predicate P."
177 (etypecase seq
178 (null nil)
179 (sequence
180 (let ((n (position-if (complement p) seq)))
181 (if n
182 (drop n seq)
183 (subseq seq 0 0))))
184 (lazy-stream
185 (loop for s = seq then (tail s)
186 for e = (head s)
187 until (not (funcall p e))
188 finally (return s)))))
189
190
191 (defun span (p seq)
192 (etypecase seq
193 (sequence
194 (let ((n (position-if (complement p) seq)))
195 (if n
196 (values (take n seq) (drop n seq))
197 (values (copy-seq seq) (subseq seq 0 0)))))
198 (lazy-stream
199 (loop for s = seq then (tail s)
200 for e = (head s)
201 collect e into result-list
202 until (not (funcall p e))
203 finally (return (values result-list s))))))
204
205
206 (defun separate (p seq)
207 (span (complement p) seq))
208
209
210 ;;;; strip-prefix
211
212 ;;;; group
213
214 ;;;; tails
215
216 (defun tails (seq)
217 (etypecase seq
218 (list (loop for i on seq collect (copy-list i)))
219 (vector (loop for i from 0 below (length seq)
220 collect (subseq seq i)))
221 (lazy-stream
222 (lazy::lazily (cons (copy-lazy-stream seq) (tails (tail seq)))))
223 ))
224
225 ;;;; inits
226
227 #|
228 (defun inits (seq)
229 (loop for i from 1 upto (length seq)
230 collect (subseq seq 0 i)))
231 |#
232
233 #|
234 (defun prefixp (prefix seq
235 &key (test #'eql)
236 &aux
237 (lp (length prefix))
238 (ls (length seq)))
239 (declare (type seq-index lp ls)
240 (type sequence prefix seq))
241 (cond ((= lp ls) (every test prefix seq))
242 ((< (length prefix) (length seq))
243 (= lp (mismatch prefix seq :test test)))))
244
245
246 (defun suffixp (suffix seq
247 &key (test #'eql)
248 &aux
249 (lp (length suffix))
250 (ls (length seq)))
251 (declare (type seq-index lp ls)
252 (type sequence suffix seq))
253 (cond ((= lp ls) (every test suffix seq))
254 ((< (length suffix) (length seq))
255 (zerop (mismatch suffix seq
256 :test test
257 :from-end t)))))
258
259
260 (defun infixp (infix seq
261 &key (test #'eql))
262 (declare (type sequence infix seq))
263 (let ((il (length infix))
264 (sl (length seq))
265 (ip (search infix seq :test test))
266 )
267 (declare (type seq-index il sl)
268 (type (or null seq-index) ip))
269 (when (< il sl)
270 (and ip
271 (plusp ip)
272 (plusp (- (length seq) (length infix) ip))))))
273 |#
274
275
276 ;;; Not in Haskell Data.List
277
278 (defun take-nth (n seq)
279 (declare (type fixnum n)
280 (type (or sequence) seq))
281 (etypecase seq
282 (list (loop for es on seq by (lambda (l) (nthcdr n l))
283 collect (first es)))
284 (vector (loop for i = 0 then (+ i n)
285 while (< i (length seq))
286 collect (aref seq i) into res
287 finally (return
288 (loop with result = (make-array (list-length res))
289 for e in res
290 for i from 0
291 do (setf (aref result i) e)
292 finally (return result)))))
293 ))
294
295
296 (defun zip (cons-fun seq1 seq2 &rest seqs)
297 (if (and (not (lazy-stream-p seq1))
298 (not (lazy-stream-p seq2))
299 (notany 'lazy-stream-p seqs))
300 (apply #'mapcar cons-fun seq1 seq2 seqs)
301 (lazily (cons (apply cons-fun
302 (head seq1)
303 (head seq2)
304 (mapcar #'head seqs))
305 (apply #'zip cons-fun
306 (tail seq1)
307 (tail seq2)
308 (mapcar #'tail seqs))))))
309
310
311 (defun distinct (seq &rest keys
312 &key
313 (test #'eql)
314 (key #'identity)
315 ((distincts-table dst)
316 (make-hash-table :test test))
317 &allow-other-keys)
318 "Returns a generalized sequence of distinct elements.
319
320 If SEQ is a SEQUENCE then REMOVE-DUPLICATES is called. If it is a
321 LAZY-STREAM then a new LAZY-STREAM is returned, with repeated elements
322 removed. Key arguments are only TEST and KEY."
323 (etypecase seq
324 (null ())
325 (sequence (apply #'cl:remove-duplicates seq keys))
326 (lazy-stream
327 (let ((e (head seq)))
328 (cond ((gethash e dst)
329 (distinct (tail seq)
330 :test test
331 :key key
332 'distincts-table dst))
333 (t (setf (gethash e dst) t)
334 (cons-stream e
335 (distinct (tail seq)
336 :test test
337 :key key
338 'distincts-table dst)))
339 )))
340 ))
341
342
343 ;;;; end of file -- seq-funs.lisp --

  ViewVC Help
Powered by ViewVC 1.1.5