list comprehension

listi.lisp

(defun append-1 (val var) (append var (list val)))

(defmacro collect (constructor &rest def)
  (let ((result (gensym))
        (syms   (loop for i from 1 upto (1- (length def)) collect (gensym))))
    `(let ((,result nil))
       (progn 
         ,(labels 
            ((main (constr def syms)
               (if (= (length def) 1)
                `(when ,(car def) 
                   (setf ,result (append-1 ,constr ,result)))
                `(dolist  (,(car syms) ,(second (car def)))
                   ;; リストで渡されたやつがまたリストだったら
                   ;; destructuring-bind でパターンマッチしてやるんだけど
                   ;; リストの中身がアトムの時にコンパイラが騒ぐ
                   ;; 逆にリストの中身がリストだとlet が騒ぐ
                   (if (listp ,(car syms))
                        (destructuring-bind ,(caar def) ,(car syms)
                             ;; これもっかい下でも実行してるから
                             ;; マクロ展開に若干時間かかる要因になるかも
                            ,(main constr (cdr def) (cdr syms))) 
                        (let ((,(caar def) ,(car syms)))
                          ,(main constr (cdr def) (cdr syms))))))))
            (main constructor def syms)),result))))


;; ((var1 lst1) (var2 lst2) ... test) の対を作る
(defun make-bind (lst)
  (cond 
    ((null lst) '(t))
    ((= (length lst) 1) lst)
    (t 
     (destructuring-bind (var <- lst . tail) lst
      (declare (ignore <-))
      (cons (list var lst) (make-bind tail))))))

(defmacro intensive (factor def)
  `(collect ,(car factor) ,@(make-bind def)))


(set-macro-character #\] 
 (get-macro-character #\)))

;;; [ から始まる括弧は間に 
;;; バーティカルバー | を含むことを要求
(set-macro-character #\[
  (lambda (stream char) 
    (declare (ignore char)) 
    `(intensive
      ,(read-delimited-list #\| stream t)     
      ,(read-delimited-list #\] stream t))))