Common LispでPythonのgeneratorを実装する

結局Lisp書かないとダメだということで本格的にPythonから移行しようと思ってます。
まず、今使ってるツールなどをLispに置き換えようと思ったらまあgeneratorが無くてめんどいことに。
というわけでgeneratorを実装しておく。
この手はみんな実装してるので珍しくもなんともない。
定番のcl-contを使う。

(require 'cl-cont)

(defun mkstr (&rest args)
  (with-output-to-string (s)
    (dolist (a args) (princ a s))))

(defun symb (&rest args)
  (values (intern (apply #'mkstr args))))

(defun flatten (x)
  (labels ((rec (x acc)
             (cond ((null x) acc)
                   ((atom x) (cons x acc))
                   (t (rec
                       (car x)
                       (rec (cdr x) acc))))))
    (rec x nil)))

(defun g!-symbol-p (s)
  (if (symbolp s)
      (let ((str (symbol-name s)))
        (string= str "#" :start1 (1- (length str))))))

(defun o!-symbol-p (s)
  (if (symbolp s)
      (let ((str (symbol-name s)))
        (string= str "%" :start1 (1- (length str))))))

(defun o!-symbol-to-g!-symbol (s)
  (let ((str (symbol-name s)))
    (symb (subseq str 0 (1- (length str)))
          "#")))

(defmacro defmacro/g! (name args &body body)
  (let ((symbs (remove-duplicates
                (remove-if-not #'g!-symbol-p
                               (flatten body)))))
    `(defmacro ,name ,args
       (let ,(mapcar
              (lambda (s)
                `(,s (gensym ,(subseq
                               (symbol-name s)
                               2))))
              symbs)
         ,@body))))

(defmacro defmacro* (name args &body body)
  (let* ((os (remove-if-not #'o!-symbol-p args))
         (gs (mapcar #'o!-symbol-to-g!-symbol os)))
    `(defmacro/g! ,name ,args
       `(let ,(mapcar #'list (list ,@gs) (list ,@os))
          ,(progn ,@body)))))

(defmacro* make-generator (&body body)
  `(let (,cont#)
     (cl-cont:with-call/cc
       (labels ((,(intern "YIELD") (&rest values)
                  (cl-cont:let/cc k
                    (setf ,cont# k)
                    (apply #'values values)
                    )))
         (,(intern "YIELD") (lambda () (cl-cont:call/cc ,cont#)))
         ,@body
         (loop (,(intern "YIELD") :done))))))

(defmacro* defgenerator (name args &body body)
  `(defun ,name ,args
     (make-generator ,@body)))

(declaim (inline next))
(defun next (g)
  (funcall g))

(defmacro* nif (expr pos zero neg)
  `(let ((,g# ,expr))
       (cond ((plusp ,g#) ,pos)
             ((zerop ,g#) ,zero)
             (t ,neg))))

(defmacro* alambda (args &body body)
  `(labels ((self ,args ,@body))
     #'self))

まあよく使うutilとかもまるっと書いてあるけど。 make-generatorだけみればOK。
generatorが作れたのでPythonのitertoolsも多分実装できます。
itertools.countはこんな感じ。

(defgenerator counter (n)
  (funcall (alambda (n)
             (yield n)
             (self (incf n))) n))


(setf foo (counter 10))
(loop repeat 50 collect (next foo))

結果

(10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
  34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57
   58 59)

足りない機能を実装できるのでLispはやはり強力だなあと思う