├── package.lisp ├── cl-lc.asd ├── .github └── workflows │ └── ci.yml ├── LICENSE.txt ├── test.lisp ├── README.md └── cl-lc.lisp /package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; package.lisp 2 | 3 | (uiop:define-package #:cl-lc 4 | (:use #:cl #:alexandria #:optima #:iterate) 5 | (:use-reexport :iterate) 6 | (:export #:list-of 7 | #:sum-of #:product-of 8 | #:max-of #:min-of 9 | #:any-of #:all-of #:none-of 10 | #:count-of 11 | #:over 12 | #:do-for 13 | #:dict-of 14 | #:vect-of)) 15 | -------------------------------------------------------------------------------- /cl-lc.asd: -------------------------------------------------------------------------------- 1 | ;;;; cl-lc.asd 2 | 3 | (asdf:defsystem "cl-lc" 4 | :serial t 5 | :description "List comprehensions" 6 | :author "Paul M. Rodriguez " 7 | :license "MIT" 8 | :depends-on ("alexandria" "optima" "iterate") 9 | :in-order-to ((test-op (test-op "cl-lc/test"))) 10 | :components ((:file "package") 11 | (:file "cl-lc"))) 12 | 13 | (asdf:defsystem "cl-lc/test" 14 | :serial t 15 | :description "Test list comprehensions" 16 | :author "Paul M. Rodriguez " 17 | :license "MIT" 18 | :depends-on ("cl-lc" "fiveam") 19 | :components ((:file "test")) 20 | :perform (test-op (o c) (symbol-call :cl-lc.test :run-tests))) 21 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: [push, pull_request] 4 | 5 | env: 6 | GITHUB_WORKSPACE: $HOME/common-lisp/cl-lc 7 | 8 | jobs: 9 | test: 10 | name: ${{ matrix.lisp }} on ${{ matrix.os }} 11 | runs-on: ${{ matrix.os }} 12 | strategy: 13 | matrix: 14 | lisp: [sbcl-bin, ccl-bin/1.12.1] 15 | os: [ubuntu-latest, macOS-latest] 16 | 17 | steps: 18 | - uses: actions/checkout@v1 19 | - name: Install Roswell 20 | env: 21 | LISP: ${{ matrix.lisp }} 22 | run: | 23 | curl -L https://raw.githubusercontent.com/roswell/roswell/master/scripts/install-for-ci.sh | sh 24 | - name: Install ci-utils 25 | run: ros install ci-utils 26 | - name: Run tests 27 | run: | 28 | PATH="~/.roswell/bin:$PATH" 29 | run-fiveam -l cl-lc/test 'cl-lc.test::run-tests' 30 | - name: Run compile-bundle-op 31 | run: | 32 | ros run 33 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014 Paul M. Rodriguez 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be 12 | included in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /test.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :cl-lc.test 2 | (:use :cl :alexandria :cl-lc :fiveam :iterate) 3 | (:shadowing-import-from :iterate :for)) 4 | (in-package :cl-lc.test) 5 | 6 | (def-suite cl-lc) 7 | (in-suite cl-lc) 8 | 9 | (defun run-tests () 10 | (run! 'cl-lc)) 11 | 12 | (def-test paper-example () 13 | (let ((i50000 (iota 50000))) 14 | (is (equal 15 | (loop repeat 1 16 | nconc (loop for x in i50000 17 | nconc 18 | (loop for y in '(a b c) 19 | if (> 0 x) collect x))) 20 | (list-of x (for x in i50000) (for y in '(a b c)) (> 0 x)))))) 21 | 22 | (def-test identity-lc () 23 | (let ((xs (iota 10))) 24 | (is (equal 25 | (list-of x (for x in xs)) 26 | (iter (for x in xs) (collect x)))))) 27 | 28 | (def-test destructuring-lc () 29 | (is (equal '(1 2 3) 30 | (list-of 31 | key 32 | (for (key . nil) in '((1 . a) (2 . b) (3 . c))))))) 33 | 34 | (def-test parallel-lc () 35 | (let ((xs (iota 10)) 36 | (ys (reverse (iota 10)))) 37 | (is (equal 38 | (list-of (list x y) 39 | ((for x in xs) 40 | (for y in ys))) 41 | (mapcar #'list xs ys))))) 42 | 43 | (def-test simple-filter () 44 | (is (equal 45 | (remove-if-not #'evenp (iota 10)) 46 | (list-of x (for x in (iota 10)) (evenp x))))) 47 | 48 | (def-test filter-with-if-sugar () 49 | (is (equal 50 | (remove-if-not #'evenp (iota 10)) 51 | (list-of x (for x in (iota 10)) if (evenp x))))) 52 | 53 | (def-test filter-with-when-sugar () 54 | (is (equal 55 | (remove-if-not #'evenp (iota 10)) 56 | (list-of x (for x in (iota 10)) when (evenp x))))) 57 | 58 | (def-test filter-with-unless-sugar () 59 | (is (equal 60 | (remove-if #'evenp (iota 10)) 61 | (list-of x (for x in (iota 10)) unless (evenp x))))) 62 | 63 | (def-test test-do-for () 64 | (is (equal 65 | (let ((pairs '())) 66 | (do-for ((for x in '(a b c)) 67 | (for y in '(1 2 3)) 68 | (<= y 2)) 69 | (push (cons x y) pairs)) 70 | (nreverse pairs)) 71 | '((A . 1) (A . 2) (B . 1) (B . 2) (C . 1) (C . 2))))) 72 | 73 | (def-test test-dict-of () 74 | (is (set-equal '((a . 1) (b . 2)) 75 | (hash-table-alist 76 | (dict-of (values k v) 77 | (for (k . v) in '((a . 1) (b . 2))))) 78 | :test #'equal))) 79 | 80 | (def-test test-vect-of () 81 | (let ((vect (vect-of x (for x below 6)))) 82 | (is (typep vect 'vector)) 83 | (is (equalp #(0 1 2 3 4 5) vect)))) 84 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | CL-LC provides list comprehensions (and other “comprehensions”, like 2 | dictionary comprehensions) using the technique presented in Mario 3 | Latendresse, “[Simple and Efficient Compilation of List Comprehensions 4 | in Common Lisp][list-comp].” 5 | 6 | CL-LC comprehensions expand into [Iterate][] rather than `loop`. One 7 | way to think of CL-LC is as an alternative front-end syntax for 8 | Iterate preserving Iterate’s extensibility. 9 | 10 | # Syntax 11 | 12 | A list comprehension consists of an expression, whose results will be 13 | collected into a list, followed by a list of filters and generators. 14 | 15 | Generators are expressions that start with `iterate:for`. 16 | 17 | (list-of x (for x in xs)) 18 | ≡ (mapcar #'identity xs) 19 | 20 | The binding of a generator can use destructuring: 21 | 22 | (list-of key (for (key . value) in alist)) 23 | 24 | Generators can be made parallel simply by enclosing them in a list. 25 | 26 | (list-of (list x y) 27 | ((for x in xs) 28 | (for y in ys))) 29 | ≡ (list-of (list x y) 30 | (for (x y) in (mapcar #'list xs ys))) 31 | 32 | Filters are ordinary expressions that filter the results of each 33 | generator: 34 | 35 | (list-of x (for x in (iota 10)) (evenp x)) 36 | => (2 4 6 8 10) 37 | 38 | You may use `if`, `when`, and `unless` as syntactic sugar: 39 | 40 | (list-of x (for x in (iota 10)) if (evenp x)) 41 | => (2 4 6 8 10) 42 | 43 | (list-of x (for x in (iota 10)) unless (evenp x)) 44 | => (1 3 5 7 9) 45 | 46 | Generators can be any `for` clause understood by Iterate, including 47 | user-defined ones. We also provide an additional driver, `(for .. over 48 | ...)`, which allow iterating over any sequence. 49 | 50 | # Other macros 51 | 52 | count-of 53 | ≡ (count-if #'identity (list-of ...)) 54 | 55 | any-of 56 | ≡ (some #'identity (list-of ...)) 57 | 58 | all-of 59 | ≡ (every #'identity (list-of ...)) 60 | 61 | none-of 62 | ≡ (notany #'identity (list-of ...)) 63 | 64 | sum-of 65 | ≡ (reduce #'+ (list-of ...)) 66 | 67 | product-of 68 | ≡ (reduce #'* (list-of ...)) 69 | 70 | max-of 71 | ≡ (reduce #'max (list-of ...)) 72 | 73 | min-of 74 | ≡ (reduce #min (list-of ...)) 75 | 76 | # `do-for` 77 | 78 | `do-for` is a cross between a list comprehension and `do`. It does no 79 | accumulating or reducing; it just binds variables. 80 | 81 | (let ((pairs '())) 82 | (do-for ((for x in '(a b c)) 83 | (for y in '(1 2 3)) 84 | (<= y 2)) 85 | (push (cons x y) pairs)) 86 | (nreverse pairs)) 87 | => ‘((A . 1) (A . 2) (B . 1) (B . 2) (C . 1) (C . 2)) 88 | 89 | # `dict-of` 90 | 91 | Using `dict-of` construct an `equal` hash table from pairs of (multiple) values. 92 | 93 | ``` common-lisp 94 | (hash-table-alist 95 | (dict-of (values k v) 96 | (for (k . v) in '((a . 1) (b . 2))))) 97 | => '((b . 2) (a . 1)) 98 | ``` 99 | 100 | [Iterate]: https://common-lisp.net/project/iterate/doc/index.html 101 | [list-comp]: https://www.iro.umontreal.ca/~latendre/publications/listCompFinal.pdf 102 | -------------------------------------------------------------------------------- /cl-lc.lisp: -------------------------------------------------------------------------------- 1 | ;;;; cl-lc.lisp 2 | 3 | (in-package #:cl-lc) 4 | 5 | ;;; "cl-lc" goes here. Hacks and glory await! 6 | 7 | (defun parse-generator (exp) 8 | (match exp 9 | ((list* (eql 'for) _) 10 | (list exp)) 11 | ((list* (list* (eql 'for) _) _) 12 | exp) 13 | (otherwise nil))) 14 | 15 | (defun generator? (exp) 16 | (parse-generator exp)) 17 | 18 | (defun ensure-head (qs) 19 | (if (generator? (car qs)) 20 | (values (caar qs) qs) 21 | (values (car qs) (cdr qs)))) 22 | 23 | (defmacro lc (qs &optional (accumulator 'collect)) 24 | (let ((qs (handle-inline-conditions qs))) 25 | (with-gensyms (outer) 26 | (multiple-value-bind (head qualifiers) 27 | (ensure-head qs) 28 | `(iterate ,outer (repeat 1) 29 | ,(lcrec head qualifiers accumulator outer)))))) 30 | 31 | (defun lcrec (head qualifiers accumulator outer) 32 | (if (null qualifiers) 33 | (if (listp accumulator) 34 | `(in ,outer ,(substitute head '_ accumulator)) 35 | `(in ,outer (,accumulator ,head))) 36 | (destructuring-bind (q &rest qs) 37 | qualifiers 38 | (if (generator? q) 39 | `(iterate ,@(parse-generator q) 40 | ,(lcrec head qs accumulator outer)) 41 | `(if ,q ,(lcrec head qs accumulator outer)))))) 42 | 43 | (defun handle-inline-conditions (qs &optional acc) 44 | (match qs 45 | ((list* 'for gen qs) 46 | (handle-inline-conditions qs (cons gen acc))) 47 | ((list* (or 'when 'if) test qs) 48 | (handle-inline-conditions qs (cons test acc))) 49 | ((list* 'unless test qs) 50 | (handle-inline-conditions qs (cons `(not ,test) acc))) 51 | ((list* q qs) 52 | (handle-inline-conditions qs (cons q acc))) 53 | ((list) 54 | (nreverse acc)))) 55 | 56 | (defmacro defcomp (name &rest (accumulator &optional documentation)) 57 | `(defmacro ,name (exp &body exps) 58 | ,@(and documentation (list documentation)) 59 | `(lc ,(cons exp exps) ,',accumulator))) 60 | 61 | (defmacro seq-dispatch (seq &body (list vector sequence)) 62 | (declare (ignorable sequence)) 63 | #+(or sbcl acbl) 64 | (once-only (seq) 65 | `(cond ((listp ,seq) ,list) 66 | ((arrayp ,seq) ,vector) 67 | (t ,sequence))) 68 | #-(or sbcl abcl) 69 | `(if (listp ,seq) 70 | ,list 71 | ,vector)) 72 | 73 | (defmacro-driver (for var over seq) 74 | (with-gensyms (gseq idx) 75 | (let ((for (if generate 'generate 'for))) 76 | `(progn 77 | (with ,gseq = ,seq) 78 | (with ,idx = 0) 79 | (declare (type alexandria:array-length ,idx)) 80 | (,for ,var next 81 | (seq-dispatch ,gseq 82 | (if ,gseq 83 | (pop ,gseq) 84 | (terminate)) 85 | (progn 86 | (unless (< ,idx (length ,gseq)) 87 | (terminate)) 88 | (aref ,gseq 89 | (prog1 ,idx 90 | (incf ,idx)))) 91 | (progn 92 | (unless (< ,idx (length ,gseq)) 93 | (terminate)) 94 | (elt ,gseq 95 | (prog1 ,idx 96 | (incf ,idx)))))))))) 97 | 98 | (defcomp list-of collect 99 | "A list comprehension. 100 | 101 | A list comprehension consists of an expression, whose results will be 102 | collected, followed by a list of filters and generators. 103 | 104 | Generators are expressions with a keyword as their second argument. 105 | (list-of x (for x in xs)) 106 | ≡ (mapcar #'identity xs) 107 | 108 | The binding of a generator can use destructuring: 109 | 110 | (list-of key ((key . value) :in alist)) 111 | 112 | Generators can be made parallel simply by enclosing them in a list. 113 | 114 | (list-of (list x y) 115 | ((for x in xs) (for y in ys))) 116 | ≡ (list-of (list x y) 117 | (for (x y) in (mapcar #'list xs ys))) 118 | 119 | Filters are ordinary expressions that filter the results of each 120 | generator: 121 | 122 | (list-of x (for x in (iota 10)) (evenp x)) 123 | => (2, 4, 6, 8, 10) 124 | 125 | You may use `if', `when', and `unless' as syntactic sugar: 126 | 127 | (list-of x (for x in (iota 10)) if (evenp x)) 128 | => (2 4 6 8 10) 129 | 130 | (list-of x (for x in (iota 10)) unless (evenp x)) 131 | => (1 3 5 7 9) 132 | 133 | Generators can be any `for' clause understood by Iterate, including 134 | user-defined ones. We also provide an additional driver, `(for .. over 135 | ...)', which allow iterating over any sequence.") 136 | 137 | (defcomp count-of count 138 | "Like a list comprehension but, instead of collecting the results, 139 | count them if they are non-nil.") 140 | 141 | (defcomp any-of thereis 142 | "Like a list comprehension but, as soon as any result is non-nil, 143 | stop evaluating and return it from the whole form.") 144 | 145 | (defcomp all-of always 146 | "Like a list comprehension but, as soon as any result is nil, stop 147 | evaluating and return `nil' from the whole form.") 148 | 149 | (defcomp none-of never 150 | "Like a list comprehension but, as soon as any result is non-nil, 151 | stop evaluating and return `nil' from the whole form.") 152 | 153 | (defcomp sum-of sum 154 | "Like a list comprehension but, instead of collecting the results, 155 | sum them.") 156 | 157 | (defcomp max-of maximize 158 | "Like a list comprehension but, instead of collecting the results, 159 | track and return the maximum.") 160 | 161 | (defcomp min-of minimize 162 | "Like a list comprehension but, instead of collecting the results, 163 | track and return the minimum.") 164 | 165 | (defcomp product-of multiply 166 | "Like a list comprehension but, instead of collecting the results 167 | into a list, multiply them together.") 168 | 169 | (defmacro reduction (fn expr &body exprs) 170 | "Like a list comprehension, but reduce the results using FN." 171 | `(lc ,(cons (gensym) exprs) (reducing ,expr by ,fn))) 172 | 173 | (defmacro do-for ((&rest qs) &body head) 174 | "Imperative macro for list comprehension–like iteration. 175 | 176 | QS are like the filters and generators of a list comprehension; BODY 177 | is like its expression. No reducing or accumulating is done." 178 | `(block nil 179 | (lc ,(cons `(block nil (tagbody (return (progn ,@head)))) qs) progn))) 180 | 181 | (defmacro dict-of (exp &rest exps) 182 | "Like a list comprehension, but collect the results into a new 'equal 183 | hash table instead. Each key and value should be returned as separate 184 | values." 185 | (with-unique-names (dict k v) 186 | `(let ((,dict (make-hash-table :test 'equal))) 187 | (do-for ,exps 188 | ;; Use multiple-value-call instead of multiple-value-bind to 189 | ;; ensure two values are returned. 190 | (multiple-value-call 191 | (lambda (,k ,v) 192 | (setf (gethash ,k ,dict) ,v)) 193 | ,exp)) 194 | ,dict))) 195 | 196 | (defmacro vect-of (exp &rest exps) 197 | "Like a list comprehension, but collect the results into a new 198 | adjustable vector instead." 199 | (with-unique-names (vect) 200 | `(let ((,vect (make-array 10 :adjustable t :fill-pointer 0))) 201 | (do-for ,exps 202 | (vector-push-extend ,exp ,vect)) 203 | ,vect))) 204 | --------------------------------------------------------------------------------