original-message.txt - clic - Clic is an command line interactive client for go… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
original-message.txt (4492B) | |
--- | |
1 From ... | |
2 Path: supernews.google.com!sn-xit-02!sn-xit-03!supernews.com!news.tele.d… | |
3 news.belnet.be!skynet.be!newsfeed2.news.nl.uu.net!sun4nl!not-for-mail | |
4 From: Arthur Lemmens <[email protected]> | |
5 Newsgroups: comp.lang.lisp | |
6 Subject: Re: Q: on hashes and counting | |
7 Date: Mon, 23 Oct 2000 00:50:02 +0200 | |
8 Organization: Kikashi Software | |
9 Lines: 129 | |
10 Message-ID: <[email protected]> | |
11 References: <[email protected]> <[email protected]… | |
12 Mime-Version: 1.0 | |
13 Content-Type: text/plain; charset=us-ascii | |
14 Content-Transfer-Encoding: 7bit | |
15 X-Trace: porthos.nl.uu.net 972255051 2606 193.78.46.221 (22 Oct 2000 22:… | |
16 X-Complaints-To: [email protected] | |
17 NNTP-Posting-Date: 22 Oct 2000 22:50:51 GMT | |
18 X-Mailer: Mozilla 4.5 [en] (Win98; I) | |
19 X-Accept-Language: en | |
20 Xref: supernews.google.com comp.lang.lisp:2515 | |
21 | |
22 | |
23 Pierre R. Mai wrote: | |
24 | |
25 > ;;; The following functions are based on the versions by Arthur | |
26 > ;;; Lemmens of the original code by Bernard Pfahringer posted to | |
27 > ;;; comp.lang.lisp. I only renamed and diddled them a bit. | |
28 > | |
29 > (defun partition | |
30 | |
31 [snip] | |
32 | |
33 > ;; DO: Find a more efficient way to take care of :from-end T. | |
34 > (when from-end | |
35 > (setf seq (reverse seq)) | |
36 > (psetf start (- len end) | |
37 > end (- len start))) | |
38 | |
39 I've written a different version now for dealing with :FROM-END T. | |
40 It doesn't call REVERSE anymore, which makes it more efficient. | |
41 Also, I prefer the new semantics. Stuff like | |
42 (split #\space "one two three " :from-end t) | |
43 now returns | |
44 ("three" "two" "one") | |
45 which I find a lot more useful than | |
46 ("eerht" "owt" "eno") | |
47 If you prefer the latter, it's easy enough to use | |
48 (split #\space (reverse "one two three ")) | |
49 | |
50 | |
51 Here it is (feel free to use this code any way you like): | |
52 | |
53 (defun SPLIT (delimiter seq | |
54 &key (maximum nil) | |
55 (keep-empty-subseqs nil) | |
56 (from-end nil) | |
57 (start 0) | |
58 (end nil) | |
59 (test nil test-supplied) | |
60 (test-not nil test-not-supplied) | |
61 (key nil key-supplied)) | |
62 | |
63 "Return a list of subsequences in <seq> delimited by <delimiter>. | |
64 If :keep-empty-subseqs is true, empty subsequences will be included | |
65 in the result; otherwise they will be discarded. | |
66 If :maximum is supplied, the result will contain no more than :maximum | |
67 (possibly empty) subsequences. The second result value contains the | |
68 unsplit rest of the sequence. | |
69 All other keywords work analogously to those for CL:POSITION." | |
70 | |
71 ;; DO: Make ":keep-delimiters t" include the delimiters in the result (?… | |
72 | |
73 (let ((len (length seq)) | |
74 (other-keys (nconc (when test-supplied | |
75 (list :test test)) | |
76 (when test-not-supplied | |
77 (list :test-not test-not)) | |
78 (when key-supplied | |
79 (list :key key))))) | |
80 | |
81 (unless end (setq end len)) | |
82 (if from-end | |
83 (loop for right = end then left | |
84 for left = (max (or (apply #'position delimiter seq | |
85 :end right | |
86 :from-end t | |
87 other-keys) | |
88 -1) | |
89 (1- start)) | |
90 unless (and (= right (1+ left) ) | |
91 (not keep-empty-subseqs)) ; empty subseq we don't … | |
92 if (and maximum (>= nr-elts maximum)) | |
93 ;; We can't take any more. Return now. | |
94 return (values subseqs (subseq seq start right)) | |
95 else | |
96 collect (subseq seq (1+ left) right) into subseqs | |
97 and sum 1 into nr-elts | |
98 until (<= left start) | |
99 finally return (values subseqs (subseq seq start (1+ left)))) | |
100 (loop for left = start then (+ right 1) | |
101 for right = (min (or (apply #'position delimiter seq | |
102 :start left | |
103 other-keys) | |
104 len) | |
105 end) | |
106 unless (and (= right left) | |
107 (not keep-empty-subseqs)) ; empty subseq we don't wa… | |
108 if (and maximum (>= nr-elts maximum)) | |
109 ;; We can't take any more. Return now. | |
110 return (values subseqs (subseq seq left end)) | |
111 else | |
112 collect (subseq seq left right) into subseqs | |
113 and sum 1 into nr-elts | |
114 until (= right end) | |
115 finally return (values subseqs (subseq seq right end)))))) | |
116 | |
117 | |
118 | |
119 Here are some examples of how you can use this: | |
120 | |
121 | |
122 CL-USER 2 > (split #\space "word1 word2 word3") | |
123 ("word1" "word2" "word3") | |
124 "" | |
125 | |
126 CL-USER 3 > (split #\space "word1 word2 word3" :from-end t) | |
127 ("word3" "word2" "word1") | |
128 "" | |
129 | |
130 CL-USER 4 > (split nil '(a b nil c d e nil nil nil nil f) :maximum 2) | |
131 ((A B) (C D E)) | |
132 (F) | |
133 | |
134 CL-USER 5 > (split #\space "Nospaceshere.") | |
135 ("Nospaceshere.") | |
136 "" | |
137 | |
138 CL-USER 6 > (split #\; "12;13;;14" :keep-empty-subseqs t) | |
139 | |
140 ("12" "13" "" "14") | |
141 "" | |
142 | |
143 CL-USER 7 > (split #\; "12;13;;14" :keep-empty-subseqs t :from-end t) | |
144 | |
145 ("14" "" "13" "12") | |
146 "" | |
147 | |
148 CL-USER 8 > (split #\space "Nospaceshere. ") | |
149 ("Nospaceshere.") | |
150 "" |