Download code
From LiteratePrograms
Back to List_comprehension_(Lisp)
Download for Windows: single file, zip
Download for UNIX: single file, zip, tar.gz, tar.bz2
comprehension.lisp
1 ; Copyright (c) 2008 the authors listed at the following URL, and/or 2 ; the authors of referenced articles or incorporated external code: 3 ; http://en.literateprograms.org/List_comprehension_(Lisp)?action=history&offset=20060908174651 4 ; 5 ; Permission is hereby granted, free of charge, to any person obtaining 6 ; a copy of this software and associated documentation files (the 7 ; "Software"), to deal in the Software without restriction, including 8 ; without limitation the rights to use, copy, modify, merge, publish, 9 ; distribute, sublicense, and/or sell copies of the Software, and to 10 ; permit persons to whom the Software is furnished to do so, subject to 11 ; the following conditions: 12 ; 13 ; The above copyright notice and this permission notice shall be 14 ; included in all copies or substantial portions of the Software. 15 ; 16 ; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 ; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 ; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 19 ; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 20 ; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 21 ; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 22 ; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 23 ; 24 ; Retrieved from: http://en.literateprograms.org/List_comprehension_(Lisp)?oldid=7599 25 26 27 (defun make-loops (var-list-pairs last-loop-body) 28 (if (endp var-list-pairs) 29 last-loop-body 30 (destructuring-bind ((var list) . therest) var-list-pairs 31 `(loop for ,var in ,list do ,(make-loops therest last-loop-body))))) 32 33 34 (defmacro make-comprehension (expr vars-in-lists guards) 35 (let ((accum (gensym))) 36 `(let ((,accum (list))) 37 (progn 38 ,(make-loops vars-in-lists 39 `(if (and ,@guards) 40 (push ,expr ,accum))) 41 (nreverse ,accum))))) 42
