From: Frédéric Jolliton
Subject: Python generators in Common Lisp using Arnesi's CPS transformer
Date: 
Message-ID: <86y7w5og8b.fsf@mau.intra.tuxee.net>
Here is an *attempt* to simulate generators of the Python language
using Arnesi CPS transformer.

The macro defgenerator allow to define new generators. A 'yield'
function is implictly available in the body of the generator.

In the Python language, the generators looks like functions and use
the 'yield' keyword to return value to the caller. But unlike when
returning with the 'return' keyword, the function call can continue by
iterating the generator. This construction is very convenient to build
various iterators over structures.

It's the first time I use CPS. It works, but I don't know why, because
all of the CPS thing is pure magic to me. I don't know if this is
really a good way to use it for such purpose. Any comments welcome.

Tested with SBCL 0.9.12, and Arnesi 1.4.0, on Linux x86-32.

Some examples using the code below:

(defgenerator some-numbers ()
  (loop for i from 1 upto 3 do (yield i))
  (print 'some-message)
  (loop for i from 8 upto 9 do (yield i)))

(defgenerator flatten (list)
  (when list
    (cond
      ((atom list)
       (yield list))
      (t
       (yield (flatten (car list)))
       (yield (flatten (cdr list)))))))

Note how 'yield' can take either a value, or another generator (in
which case, it will returns each of its values.)

An example session:

> (mapc-generator #'print (some-numbers))
1
2
SOME-MESSAGE 
3
8
9
; No value

> (mapc-generator #'print (flatten '((a (b c) d) (e) f (g h))))
A 
B 
C 
D 
E 
F 
G 
H 
; No value

> (mapcar-generator #'identity (flatten '((a (b c) d) (e) f (g h))))
(A B C D E F G H)

;;-----------------------------------------------------------------------------

(defpackage #:generators
  (:use #:cl #:arnesi))

(in-package #:generators)

(defstruct generator iterator)

(defmacro defgenerator (name arguments &body body)
  (let ((point (gensym))
        (current (gensym))
        (iterate (gensym))
        (invalidate (gensym))
        (invalid (gensym)))
    `(defun ,name ,arguments
       (let (,point ,current)
         (labels ((,iterate ()
                    "Return the next value from the generator."
                    (cond ((eq ,current ',invalid)
                           (cons nil nil))
                          (t
                           (let ((current ,current))
                             (funcall ,point nil)
                             (cons current t)))))
                  (,invalidate ()
                    (setf ,current ',invalid)))
           (with-call/cc
             (labels ((yield (value)
                        "If value is itself a generator
                        then yield each of its values."
                        (cond ((generator-p value)
                               (do-generator (item value)
                                 (yield item)))
                              (t
                               (setf ,current value)
                               (let/cc k
                                 (setf ,point k))))))
               ,@body
               (,invalidate)))
           (make-generator :iterator #',iterate))))))

(defmacro do-generator ((var generator) &body body)
  (let ((gen (gensym))
        (not-finished-p (gensym)))
    `(let ((,gen ,generator))
       (loop for (,var . ,not-finished-p) = (funcall (generator-iterator ,gen))
          while ,not-finished-p
          do (progn ,@body)))))

(defun mapc-generator (function generator)
  (do-generator (item generator)
    (funcall function item))
  (values))

(defun mapcar-generator (function generator)
  (let ((result ()))
    (do-generator (item generator)
      (push (funcall function item) result))
    (nreverse result)))

-- 
Fr�d�ric Jolliton