Lispのくせに

ただのお遊び。
Common Lispのくせにリスト内包表記!

CL-USER> [ x | x <- '(1 2 3 4) ]
=> (1 2 3 4)

CL-USER> [ x | x <- '(1 2 3 4 5 6 7 8 9) (evenp x) ]
=> (2 4 6 8)

;; 条件を複数
CL-USER> [ x | x <- '(1 2 3 4 5 6 7 8 9) (evenp x) (< x 5) ]
=> (2 4)

;; 変数を複数
CL-USER> [ (+ x y) | x <- '(1 2 3) y <- '(10 20 30) ]
=> (11 22 33)

CL-USER> (setq seq (loop for x from 1 to 10 collect x))
=> (1 2 3 4 5 6 7 8 9 10)
;; 入れ子も大丈夫
CL-USER> [(1- x) | x <- [(expt 2 x) | x <- seq]]
=> (1 3 7 15 31 63 127 255 511 1023)


;; Haskell でおなじみ quick sort
CL-USER> (defun qsort (seq)
           (if seq
               (nconc
                (qsort [x | x <- (cdr seq) (<= x (car seq))])
                (list (car seq))
                (qsort [x | x <- (cdr seq) (> x (car seq))]) )))

CL-USER> (qsort '(9 5 4 8 7 3 2 1 6))
=> (1 2 3 4 5 6 7 8 9)

条件部分が見分けづらいので、
x <- xs if (evenp x) (< x 5)
のような形式にしようかと思ったけど、今回はHaskell風ということでとりあえず無しにしました。 Pythonだと条件部分にifを書きます*1


以下はこれを実現するリードマクロ。(結構適当・・・)
要素にランダムアクセスする時の効率を考えてvectorに変換してみたけど、この規模のリストなら恩恵は皆無だと思われる・・・。(というかvectorのランダムアクセスも思いのほか速くない。。。)

CL-USER> (defmacro list-comprehension (exp-left exp-right)
           (let* ((exp-vec (coerce exp-right 'vector))
                  (len (length exp-vec)) )
             (labels ((elt2 (i)
                        (svref exp-vec i))
                      (get-var/seq ()
                        (do ((i 0 (1+ i)) acc)
                            ((>= i len) (nreverse acc))
                          (if (eq '<- (elt2 i))
                              (prog1
                                  (push (cons (elt2 (1- i)) (elt2 (1+ i))) acc)
                                (incf i 2) ))))
                      (get-pred ()
                        (let ((pos (position '<- exp-vec :from-end t)))
                          (if pos
                              (nthcdr (+ 2 pos) exp-right) ))))
               `(loop
                 ,@(mapcan #'(lambda (p) `(for ,(car p) in ,(cdr p))) (get-var/seq))
                 ,@(mapcan #'(lambda (pred) `(if ,pred)) (get-pred))
                 collect ,@exp-left))))


CL-USER> (progn
           (set-macro-character #\] (get-macro-character #\) ))
           (set-macro-character
            #\[
            #'(lambda (stream c)
                (let ((left (read-delimited-list #\| stream t))
                      (right (read-delimited-list #\] stream t)) )
                  `(list-comprehension ,left ,right) ))))


ちなみにClojureってリードマクロ無いっぽい・・・?

*1:Pythonの例 : [ x for x in range(10) if x%2==0 ]