Add support for generators

diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index 78f7e34..e7d79d5 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,8 @@
+2015-03-02  Daniel Colascione  <dancol@dancol.org>
+
+	* control.texi (Generators): New section
+	* elisp.text: Reference new section.
+
 2015-02-28  Eli Zaretskii  <eliz@gnu.org>

 	* searching.texi (Char Classes): Update the documentation of
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 448c7f2..4e9c119 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,7 @@
+2015-03-02  Daniel Colascione  <dancol@dancol.org>
+
+	* cl.texi (Iteration Clauses): Mention iterator support.
+
 2015-02-25  Tassilo Horn  <tsdh@gnu.org>

 	* reftex.texi (Multifile Documents): Document
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7ce2e81..4ab4406 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,6 +1,8 @@
 2015-03-02  Daniel Colascione  <dancol@dancol.org>

-	* vc/vc.el (vc-responsible-backend): Add autoload cooking for
+	* emacs-lisp/generator.el: New file.
+
+	* vc/vc.el (vc-responsible-backend): Add autoload cookie for
 	`vc-responsible-backend'.

 2015-03-01  Michael Albinus  <michael.albinus@gmx.de>
diff --git a/test/ChangeLog b/test/ChangeLog
index 684e98f..64ad851 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,5 +1,7 @@
 2015-03-02  Daniel Colascione  <dancol@dancol.org>

+	* automated/generator-tests.el: New tests
+
 	* automated/finalizer-tests.el (finalizer-basic)
 	(finalizer-circular-reference, finalizer-cross-reference)
 	(finalizer-error): New tests.

10 files changed, 1215 insertions, 1 deletions

diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index 78f7e34ca01..e7d79d55c7e 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,8 @@
+2015-03-02  Daniel Colascione  <dancol@dancol.org>
+
+        * control.texi (Generators): New section
+        * elisp.text: Reference new section.
+
 2015-02-28  Eli Zaretskii  <eliz@gnu.org>
 
         * searching.texi (Char Classes): Update the documentation of
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index d21292348a4..bec2bc92ac4 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -39,6 +39,7 @@ structure constructs (@pxref{Macros}).
 * Conditionals::           @code{if}, @code{cond}, @code{when}, @code{unless}.
 * Combining Conditions::   @code{and}, @code{or}, @code{not}.
 * Iteration::              @code{while} loops.
+* Generators::             Generic sequences and coroutines.
 * Nonlocal Exits::         Jumping out of a sequence.
 @end menu
 
@@ -620,6 +621,121 @@ Here is an example of using @code{dotimes} to do something 100 times:
 @end example
 @end defmac
 
+@node Generators
+@section Generators
+@cindex generators
+
+  A @dfn{generator} is a function that produces a potentially-infinite
+stream of values.  Each time the function produces a value, it
+suspends itself and waits for a caller to request the next value.
+
+@defmac iter-defun name args [doc] [declare] [interactive] body@dots{}
+@code{iter-defun} defines a generator function.  A generator function
+has the same signature as a normal function, but works differently.
+Instead of executing @var{body} when called, a generator function
+returns an iterator object.  That iterator runs @var{body} to generate
+values, emitting a value and pausing where @code{iter-yield} or
+@code{iter-yield-from} appears.  When @var{body} returns normally,
+@code{iter-next} signals @code{iter-end-of-sequence} with @var{body}'s
+result as its condition data.
+
+Any kind of Lisp code is valid inside @var{body}, but
+@code{iter-yield} and @code{iter-yield-from} cannot appear inside
+@code{unwind-protect} forms.
+
+@end defmac
+
+@defmac iter-lambda args [doc] [interactive] body@dots{}
+@code{iter-lambda} produces an unnamed generator function that works
+just like a generator function produced with @code{iter-defun}.
+@end defmac
+
+@defmac iter-yield value
+When it appears inside a generator function, @code{iter-yield}
+indicates that the current iterator should pause and return
+@var{value} from @code{iter-next}.  @code{iter-yield} evaluates to the
+@code{value} parameter of next call to @code{iter-next}.
+@end defmac
+
+@defmac iter-yield-from iterator
+@code{iter-yield-from} yields all the values that @var{iterator}
+produces and evaluates to the value that @var{iterator}'s generator
+function returns normally.  While it has control, @var{iterator}
+receives sent to the iterator using @code{iter-next}.
+@end defmac
+
+  To use a generator function, first call it normally, producing a
+@dfn{iterator} object.  An iterator is a specific instance of a
+generator.  Then use @code{iter-next} to retrieve values from this
+iterator.  When there are no more values to pull from an iterator,
+@code{iter-next} raises an @code{iter-end-of-sequence} condition with
+the iterator's final value.
+
+It's important to note that generator function bodies only execute
+inside calls to @code{iter-next}.  A call to a function defined with
+@code{iter-defun} produces an iterator; you must ``drive'' this
+iterator with @code{iter-next} for anything interesting to happen.
+Each call to a generator function produces a @emph{different}
+iterator, each with its own state.
+
+@defun iter-next iterator value
+Retrieve the next value from @var{iterator}.  If there are no more
+values to be generated (because @var{iterator}'s generator function
+returned), @code{iter-next} signals the @code{iter-end-of-sequence}
+condition; the data value associated with this condition is the value
+with which @var{iterator}'s generator function returned.
+
+@var{value} is sent into the iterator and becomes the value to which
+@code{iter-yield} evaluates.  @var{value} is ignored for the first
+@code{iter-next} call to a given iterator, since at the start of
+@var{iterator}'s generator function, the generator function is not
+evaluating any @code{iter-yield} form.
+@end defun
+
+@defun iter-close iterator
+If @var{iterator} is suspended inside a @code{unwind-protect} and
+becomes unreachable, Emacs will eventually run unwind handlers after a
+garbage collection pass.  To ensure that these handlers are run before
+then, use @code{iter-close}.
+@end defun
+
+Some convenience functions are provided to make working with
+iterators easier:
+
+@defmac iter-do (var iterator) body @dots{}
+Run @var{body} with @var{var} bound to each value that
+@var{iterator} produces.
+@end defmac
+
+The Common Lisp loop facility also contains features for working with
+iterators.  See @xref{Loop Facility,,,cl,Common Lisp Extensions}.
+
+The following piece of code demonstrates some important principles of
+working with iterators.
+
+@example
+(iter-defun my-iter (x)
+  (iter-yield (1+ (iter-yield (1+ x))))
+  -1 ;; Return normally
+  )
+
+(let* ((iter (my-iter 5))
+       (iter2 (my-iter 0)))
+  ;; Prints 6
+  (print (iter-next iter))
+  ;; Prints 9
+  (print (iter-next iter 8))
+  ;; Prints 1; iter and iter2 have distinct states
+  (print (iter-next iter2 nil))
+
+  ;; We expect the iter sequence to end now
+  (condition-case x
+      (iter-next iter)
+    (iter-end-of-sequence
+      ;; Prints -1, which my-iter returned normally
+      (print (cdr x)))))
+@end example
+
 @node Nonlocal Exits
 @section Nonlocal Exits
 @cindex nonlocal exits
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index cdc443f07d5..3802e49ec3d 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -464,6 +464,7 @@ Control Structures
 * Conditionals::            @code{if}, @code{cond}, @code{when}, @code{unless}.
 * Combining Conditions::    @code{and}, @code{or}, @code{not}.
 * Iteration::               @code{while} loops.
+* Generators::              Generic sequences and coroutines.
 * Nonlocal Exits::          Jumping out of a sequence.
 
 Nonlocal Exits
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 448c7f26c1a..4e9c119379d 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,7 @@
+2015-03-02  Daniel Colascione  <dancol@dancol.org>
+
+        * cl.texi (Iteration Clauses): Mention iterator support.
+
 2015-02-25  Tassilo Horn  <tsdh@gnu.org>
 
         * reftex.texi (Multifile Documents): Document
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 66776029353..052ca6bd786 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -2237,6 +2237,11 @@ This clause is like @code{always}, except that the loop returns
 This clause stops the loop when the specified form is non-@code{nil};
 in this case, it returns that non-@code{nil} value.  If all the
 values were @code{nil}, the loop returns @code{nil}.
+
+@item iter-by @var{iterator}
+This clause iterates over the values from the specified form, an
+iterator object.  See (@pxref{Generators,,,elisp,GNU Emacs Lisp
+Reference Manual}).
 @end table
 
 @node Accumulation Clauses
diff --git a/etc/NEWS b/etc/NEWS
index 6c94a587ad5..ad8b6f27812 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -621,6 +621,8 @@ word syntax, use `\sw' instead.
 
 * Lisp Changes in Emacs 25.1
 
+** Emacs Lisp now supports generators.
+
 ** New finalizer facility for running code when objects
    become unreachable.
 
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7ce2e816d45..4ab4406dba1 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,6 +1,8 @@
 2015-03-02  Daniel Colascione  <dancol@dancol.org>
 
-        * vc/vc.el (vc-responsible-backend): Add autoload cooking for
+        * emacs-lisp/generator.el: New file.
+
+        * vc/vc.el (vc-responsible-backend): Add autoload cookie for
         `vc-responsible-backend'.
 
 2015-03-01  Michael Albinus  <michael.albinus@gmx.de>
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
new file mode 100644
index 00000000000..4e21e792406
--- /dev/null
+++ b/lisp/emacs-lisp/generator.el
@@ -0,0 +1,789 @@
+;;; generator.el --- generators  -*- lexical-binding: t -*-
+
+;;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Daniel Colascione <dancol@dancol.org>
+;; Keywords: extensions, elisp
+;; Package: emacs
+
+;; Copyright (C) Daniel Colascione
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package implements generators for Emacs Lisp through a
+;; continuation-passing transformation.  It provides essentially the
+;; same generator API and iterator facilties that Python and
+;; JavaScript ES6 provide.
+;;
+;; `iter-lambda' and `iter-defun' work like `lambda' and `defun',
+;; except that they evaluate to or define, respectively, generator
+;; functions.  These functions, when called, return an iterator.
+;; An iterator is an opaque object that generates a sequence of
+;; values.  Callers use `iter-next' to retrieve the next value from
+;; the sequence; when the sequence is exhausted, `iter-next' will
+;; raise the `iter-end-of-sequence' condition.
+;;
+;; Generator functions are written like normal functions, except that
+;; they can invoke `iter-yield' to suspend themselves and return a
+;; value to callers; this value becomes the return value of
+;; `iter-next'.  On the next call to `iter-next', execution of the
+;; generator function resumes where it left off.  When a generator
+;; function returns normally, the `iter-next' raises
+;; `iter-end-of-sequence' with the value the function returned.
+;;
+;; `iter-yield-from' yields all the values from another iterator; it
+;; then evaluates to the value the sub-iterator returned normally.
+;; This facility is useful for functional composition of generators
+;; and for implementing coroutines.
+;;
+;; `iter-yield' is illegal inside the UNWINDFORMS of an
+;; `unwind-protect' for various sordid internal reasons documented in
+;; the code.
+;;
+;; N.B. Each call to a generator function generates a *new* iterator,
+;; and each iterator maintains its own internal state.
+;;
+;; This raw form of iteration is general, but a bit awkward to use, so
+;; this library also provides soem convenience functions:
+;;
+;; `iter-do' is like `cl-do', except that instead of walking a list,
+;; it walks an iterator.  `cl-loop' is also extended with a new
+;; keyword, `iter-by', that iterates over an iterator.
+;;
+
+;;; Implementation:
+
+;;
+;; The internal cps transformation code uses the cps- namespace.
+;; Iteration functions use the `iter-' namespace.  Generator functions
+;; are somewhat less efficient than conventional elisp routines,
+;; although we try to avoid CPS transformation on forms that do not
+;; invoke `iter-yield'.
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'pcase)
+
+(defvar *cps-bindings* nil)
+(defvar *cps-states* nil)
+(defvar *cps-value-symbol* nil)
+(defvar *cps-state-symbol* nil)
+(defvar *cps-cleanup-table-symbol* nil)
+(defvar *cps-cleanup-function* nil)
+
+(defvar *cps-dynamic-wrappers* '(identity)
+  "List of transformer functions to apply to atomic forms we
+evaluate in CPS context.")
+
+(defconst cps-standard-special-forms
+  '(setq setq-default throw interactive)
+  "List of special forms that we treat just like ordinary
+  function applications." )
+
+(defun cps--trace-funcall (func &rest args)
+  (message "%S: args=%S" func args)
+  (let ((result (apply func args)))
+    (message "%S: result=%S" func result)
+    result))
+
+(defun cps--trace (fmt &rest args)
+  (princ (apply #'format (concat fmt "\n") args)))
+
+(defun cps--special-form-p (definition)
+  "Non-nil if and only if DEFINITION is a special form."
+  ;; Copied from ad-special-form-p
+  (if (and (symbolp definition) (fboundp definition))
+      (setf definition (indirect-function definition)))
+  (and (subrp definition) (eq (cdr (subr-arity definition)) 'unevalled)))
+
+(defmacro cps--define-unsupported (function)
+  `(defun ,(intern (format "cps--transform-%s" function))
+       (error "%s not supported in generators" ,function)))
+
+(defmacro cps--with-value-wrapper (wrapper &rest body)
+  "Continue generating CPS code with an atomic-form wrapper
+to the current stack of such wrappers.  WRAPPER is a function that
+takes a form and returns a wrapped form.
+
+Whenever we generate an atomic form (i.e., a form that can't
+iter-yield), we first (before actually inserting that form in our
+generated code) pass that form through all the transformer
+functions.  We use this facility to wrap forms that can transfer
+control flow non-locally in goo that diverts this control flow to
+the CPS state machinery.
+"
+  (declare (indent 1))
+  `(let ((*cps-dynamic-wrappers*
+          (cons
+           ,wrapper
+           *cps-dynamic-wrappers*)))
+     ,@body))
+
+(defun cps--make-dynamic-binding-wrapper (dynamic-var static-var)
+  (cl-assert lexical-binding)
+  (lambda (form)
+    `(let ((,dynamic-var ,static-var))
+       (unwind-protect ; Update the static shadow after evaluation is done
+            ,form
+         (setf ,static-var ,dynamic-var))
+       ,form)))
+
+(defmacro cps--with-dynamic-binding (dynamic-var static-var &rest body)
+  "Evaluate BODY such that generated atomic evaluations run with
+DYNAMIC-VAR bound to STATIC-VAR."
+  (declare (indent 2))
+  `(cps--with-value-wrapper
+       (cps--make-dynamic-binding-wrapper ,dynamic-var ,static-var)
+     ,@body))
+
+(defun cps--add-state (kind body)
+  "Create a new CPS state with body BODY and return the state's name."
+  (declare (indent 1))
+  (let* ((state (cl-gensym (format "cps-state-%s-" kind))))
+    (push (list state body *cps-cleanup-function*) *cps-states*)
+    (push state *cps-bindings*)
+    state))
+
+(defun cps--add-binding (original-name)
+  (car (push (cl-gensym (format "cps-binding-%s-" original-name))
+             *cps-bindings*)))
+
+(defun cps--find-special-form-handler (form)
+  (let* ((handler-name (format "cps--transform-%s" (car-safe form)))
+         (handler (intern-soft handler-name)))
+    (and (fboundp handler) handler)))
+
+(defvar cps-disable-atomic-optimization nil
+  "When t, always rewrite forms into cps even when they
+don't yield.")
+
+(defvar cps--yield-seen)
+
+(defun cps--atomic-p (form)
+  "Return whether the given form never yields."
+
+  (and (not cps-disable-atomic-optimization)
+       (let* ((cps--yield-seen))
+         (ignore (macroexpand-all
+                  `(cl-macrolet ((cps-internal-yield
+                                     (_val)
+                                   (setf cps--yield-seen t)))
+                     ,form)))
+         (not cps--yield-seen))))
+
+(defun cps--make-atomic-state (form next-state)
+  (let ((tform `(prog1 ,form (setf ,*cps-state-symbol* ,next-state))))
+    (cl-loop for wrapper in *cps-dynamic-wrappers*
+       do (setf tform (funcall wrapper tform)))
+    ;; Bind *cps-cleanup-function* to nil here because the wrapper
+    ;; function mechanism is responsible for cleanup here, not the
+    ;; generic cleanup mechanism.  If we didn't make this binding,
+    ;; we'd run cleanup handlers twice on anything that made it out
+    ;; to toplevel.
+    (let ((*cps-cleanup-function* nil))
+      (cps--add-state "atom"
+        `(setf ,*cps-value-symbol* ,tform)))))
+
+(defun cps--transform-1 (form next-state)
+  (pcase form
+
+    ;; If we're looking at an "atomic" form (i.e., one that does not
+    ;; iter-yield), just evaluate the form as a whole instead of rewriting
+    ;; it into CPS.
+
+    ((guard (cps--atomic-p form))
+     (cps--make-atomic-state form next-state))
+
+    ;; Process `and'.
+
+    (`(and)                             ; (and) -> t
+      (cps--transform-1 t next-state))
+    (`(and ,condition)                  ; (and CONDITION) -> CONDITION
+      (cps--transform-1 condition next-state))
+    (`(and ,condition . ,rest)
+      ;; Evaluate CONDITION; if it's true, go on to evaluate the rest
+      ;; of the `and'.
+      (cps--transform-1
+       condition
+       (cps--add-state "and"
+         `(setf ,*cps-state-symbol*
+                (if ,*cps-value-symbol*
+                    ,(cps--transform-1 `(and ,@rest)
+                                       next-state)
+                  ,next-state)))))
+
+    ;; Process `catch'.
+
+    (`(catch ,tag . ,body)
+      (let ((tag-binding (cps--add-binding "catch-tag")))
+        (cps--transform-1 tag
+                          (cps--add-state "cps-update-tag"
+                            `(setf ,tag-binding ,*cps-value-symbol*
+                                   ,*cps-state-symbol*
+                                   ,(cps--with-value-wrapper
+                                     (cps--make-catch-wrapper
+                                      tag-binding next-state)
+                                     (cps--transform-1 `(progn ,@body)
+                                                       next-state)))))))
+
+    ;; Process `cond': transform into `if' or `or' depending on the
+    ;; precise kind of the condition we're looking at.
+
+    (`(cond)                            ; (cond) -> nil
+      (cps--transform-1 nil next-state))
+    (`(cond (,condition) . ,rest)
+      (cps--transform-1 `(or ,condition (cond ,@rest))
+                        next-state))
+    (`(cond (,condition . ,body) . ,rest)
+      (cps--transform-1 `(if ,condition
+                             (progn ,@body)
+                           (cond ,@rest))
+                        next-state))
+
+    ;; Process `condition-case': do the heavy lifting in a helper
+    ;; function.
+
+    (`(condition-case ,var ,bodyform . ,handlers)
+      (cps--with-value-wrapper
+          (cps--make-condition-wrapper var next-state handlers)
+        (cps--transform-1 bodyform
+                          next-state)))
+
+    ;; Process `if'.
+
+    (`(if ,cond ,then . ,else)
+      (cps--transform-1 cond
+                        (cps--add-state "if"
+                          `(setf ,*cps-state-symbol*
+                                 (if ,*cps-value-symbol*
+                                     ,(cps--transform-1 then
+                                                        next-state)
+                                   ,(cps--transform-1 `(progn ,@else)
+                                                      next-state))))))
+
+    ;; Process `progn' and `inline': they are identical except for the
+    ;; name, which has some significance to the byte compiler.
+
+    (`(inline) (cps--transform-1 nil next-state))
+    (`(inline ,form) (cps--transform-1 form next-state))
+    (`(inline ,form . ,rest)
+      (cps--transform-1 form
+                        (cps--transform-1 `(inline ,@rest)
+                                          next-state)))
+
+    (`(progn) (cps--transform-1 nil next-state))
+    (`(progn ,form) (cps--transform-1 form next-state))
+    (`(progn ,form . ,rest)
+      (cps--transform-1 form
+                        (cps--transform-1 `(progn ,@rest)
+                                          next-state)))
+
+    ;; Process `let' in a helper function that transforms it into a
+    ;; let* with temporaries.
+
+    (`(let ,bindings . ,body)
+      (let* ((bindings (cl-loop for binding in bindings
+                          collect (if (symbolp binding)
+                                      (list binding nil)
+                                    binding)))
+             (temps (cl-loop for (var value-form) in bindings
+                       collect (cps--add-binding var))))
+        (cps--transform-1
+         `(let* ,(append
+                  (cl-loop for (var value-form) in bindings
+                     for temp in temps
+                     collect (list temp value-form))
+                  (cl-loop for (var binding) in bindings
+                     for temp in temps
+                     collect (list var temp)))
+            ,@body)
+         next-state)))
+
+    ;; Process `let*' binding: process one binding at a time.  Flatten
+    ;; lexical bindings.
+
+    (`(let* () . ,body)
+      (cps--transform-1 `(progn ,@body) next-state))
+
+    (`(let* (,binding . ,more-bindings) . ,body)
+      (let* ((var (if (symbolp binding) binding (car binding)))
+             (value-form (car (cdr-safe binding)))
+             (new-var (cps--add-binding var)))
+
+        (cps--transform-1
+         value-form
+         (cps--add-state "let*"
+           `(setf ,new-var ,*cps-value-symbol*
+                  ,*cps-state-symbol*
+                  ,(if (or (not lexical-binding) (special-variable-p var))
+                       (cps--with-dynamic-binding var new-var
+                         (cps--transform-1
+                          `(let* ,more-bindings ,@body)
+                          next-state))
+                       (cps--transform-1
+                        (cps--replace-variable-references
+                         var new-var
+                         `(let* ,more-bindings ,@body))
+                        next-state)))))))
+
+    ;; Process `or'.
+
+    (`(or) (cps--transform-1 nil next-state))
+    (`(or ,condition) (cps--transform-1 condition next-state))
+    (`(or ,condition . ,rest)
+      (cps--transform-1
+       condition
+       (cps--add-state "or"
+         `(setf ,*cps-state-symbol*
+                (if ,*cps-value-symbol*
+                    ,next-state
+                  ,(cps--transform-1
+                    `(or ,@rest) next-state))))))
+
+    ;; Process `prog1'.
+
+    (`(prog1 ,first) (cps--transform-1 first next-state))
+    (`(prog1 ,first . ,body)
+      (cps--transform-1
+       first
+       (let ((temp-var-symbol (cps--add-binding "prog1-temp")))
+         (cps--add-state "prog1"
+           `(setf ,temp-var-symbol
+                  ,*cps-value-symbol*
+                  ,*cps-state-symbol*
+                  ,(cps--transform-1
+                    `(progn ,@body)
+                    (cps--add-state "prog1inner"
+                      `(setf ,*cps-value-symbol* ,temp-var-symbol
+                             ,*cps-state-symbol* ,next-state))))))))
+
+    ;; Process `prog2'.
+
+    (`(prog2 ,form1 ,form2 . ,body)
+      (cps--transform-1
+       `(progn ,form1 (prog1 ,form2 ,@body))
+       next-state))
+
+    ;; Process `unwind-protect': If we're inside an unwind-protect, we
+    ;; have a block of code UNWINDFORMS which we would like to run
+    ;; whenever control flows away from the main piece of code,
+    ;; BODYFORM.  We deal with the local control flow case by
+    ;; generating BODYFORM such that it yields to a continuation that
+    ;; executes UNWINDFORMS, which then yields to NEXT-STATE.
+    ;;
+    ;; Non-local control flow is trickier: we need to ensure that we
+    ;; execute UNWINDFORMS even when control bypasses our normal
+    ;; continuation.  To make this guarantee, we wrap every external
+    ;; application (i.e., every piece of elisp that can transfer
+    ;; control non-locally) in an unwind-protect that runs UNWINDFORMS
+    ;; before allowing the non-local control transfer to proceed.
+    ;;
+    ;; Unfortunately, because elisp lacks a mechanism for generically
+    ;; capturing the reason for an arbitrary non-local control
+    ;; transfer and restarting the transfer at a later point, we
+    ;; cannot reify non-local transfers and cannot allow
+    ;; continuation-passing code inside UNWINDFORMS.
+
+    (`(unwind-protect ,bodyform . ,unwindforms)
+      ;; Signal the evaluator-generator that it needs to generate code
+      ;; to handle cleanup forms.
+      (unless *cps-cleanup-table-symbol*
+        (setf *cps-cleanup-table-symbol* (cl-gensym "cps-cleanup-table-")))
+      (let* ((unwind-state
+              (cps--add-state
+                  "unwind"
+                ;; N.B. It's safe to just substitute unwindforms by
+                ;; sexp-splicing: we've already replaced all variable
+                ;; references inside it with lifted equivalents.
+                `(progn
+                   ,@unwindforms
+                   (setf ,*cps-state-symbol* ,next-state))))
+             (old-cleanup *cps-cleanup-function*)
+             (*cps-cleanup-function*
+              (let ((*cps-cleanup-function* nil))
+                (cps--add-state "cleanup"
+                  `(progn
+                     ,(when old-cleanup `(funcall ,old-cleanup))
+                     ,@unwindforms)))))
+        (cps--with-value-wrapper
+            (cps--make-unwind-wrapper unwindforms)
+          (cps--transform-1 bodyform unwind-state))))
+
+    ;; Process `while'.
+
+    (`(while ,test . ,body)
+      ;; Open-code state addition instead of using cps--add-state: we
+      ;; need our states to be self-referential. (That's what makes the
+      ;; state a loop.)
+      (let* ((loop-state
+                (cl-gensym "cps-state-while-"))
+             (eval-loop-condition-state
+              (cps--transform-1 test loop-state))
+             (loop-state-body
+                `(progn
+                   (setf ,*cps-state-symbol*
+                         (if ,*cps-value-symbol*
+                             ,(cps--transform-1
+                               `(progn ,@body)
+                               eval-loop-condition-state)
+                           ,next-state)))))
+        (push (list loop-state loop-state-body *cps-cleanup-function*)
+              *cps-states*)
+        (push loop-state *cps-bindings*)
+        eval-loop-condition-state))
+
+    ;; Process various kinds of `quote'.
+
+    (`(quote ,arg) (cps--add-state "quote"
+                     `(setf ,*cps-value-symbol* (quote ,arg)
+                            ,*cps-state-symbol* ,next-state)))
+    (`(function ,arg) (cps--add-state "function"
+                        `(setf ,*cps-value-symbol* (function ,arg)
+                               ,*cps-state-symbol* ,next-state)))
+
+    ;; Deal with `iter-yield'.
+
+    (`(cps-internal-yield ,value)
+      (cps--transform-1
+       value
+       (cps--add-state "iter-yield"
+         `(progn
+            (setf ,*cps-state-symbol*
+                  ,(if *cps-cleanup-function*
+                       (cps--add-state "after-yield"
+                         `(setf ,*cps-state-symbol* ,next-state))
+                       next-state))
+            (throw 'cps--yield ,*cps-value-symbol*)))))
+
+    ;; Catch any unhandled special forms.
+
+    ((and `(,name . ,_)
+          (guard (cps--special-form-p name))
+          (guard (not (memq name cps-standard-special-forms))))
+     name                               ; Shut up byte compiler
+     (error "special form %S incorrect or not supported" form))
+
+    ;; Process regular function applications with nontrivial
+    ;; parameters, converting them to applications of trivial
+    ;; let-bound parameters.
+
+    ((and `(,function . ,arguments)
+          (guard (not (cl-loop for argument in arguments
+                         always (atom argument)))))
+     (let ((argument-symbols
+            (cl-loop for argument in arguments
+               collect (if (atom argument)
+                           argument
+                         (cl-gensym "cps-argument-")))))
+
+       (cps--transform-1
+        `(let* ,(cl-loop for argument in arguments
+                   for argument-symbol in argument-symbols
+                   unless (eq argument argument-symbol)
+                   collect (list argument-symbol argument))
+           ,(cons function argument-symbols))
+        next-state)))
+
+    ;; Process everything else by just evaluating the form normally.
+    (t (cps--make-atomic-state form next-state))))
+
+(defun cps--make-catch-wrapper (tag-binding next-state)
+  (lambda (form)
+    (let ((normal-exit-symbol
+           (cl-gensym "cps-normal-exit-from-catch-")))
+      `(let (,normal-exit-symbol)
+         (prog1
+             (catch ,tag-binding
+               (prog1
+                   ,form
+                 (setf ,normal-exit-symbol t)))
+           (unless ,normal-exit-symbol
+             (setf ,*cps-state-symbol* ,next-state)))))))
+
+(defun cps--make-condition-wrapper (var next-state handlers)
+  ;; Each handler is both one of the transformers with which we wrap
+  ;; evaluated atomic forms and a state to which we jump when we
+  ;; encounter the given error.
+
+  (let* ((error-symbol (cps--add-binding "condition-case-error"))
+         (lexical-error-symbol (cl-gensym "cps-lexical-error-"))
+         (processed-handlers
+          (cl-loop for (condition . body) in handlers
+             collect (cons condition
+                           (cps--transform-1
+                            (cps--replace-variable-references
+                             var error-symbol
+                             `(progn ,@body))
+                            next-state)))))
+
+    (lambda (form)
+      `(condition-case
+           ,lexical-error-symbol
+           ,form
+         ,@(cl-loop
+              for (condition . error-state) in processed-handlers
+              collect
+                `(,condition
+                  (setf ,error-symbol
+                        ,lexical-error-symbol
+                        ,*cps-state-symbol*
+                        ,error-state)))))))
+
+(defun cps--replace-variable-references (var new-var form)
+  "Replace all non-shadowed references to VAR with NEW-VAR in FORM.
+This routine does not modify FORM. Instead, it returns a
+modified copy."
+  (macroexpand-all
+   `(cl-symbol-macrolet ((,var ,new-var)) ,form)))
+
+(defun cps--make-unwind-wrapper (unwind-forms)
+  (cl-assert lexical-binding)
+  (lambda (form)
+    (let ((normal-exit-symbol
+           (cl-gensym "cps-normal-exit-from-unwind-")))
+      `(let (,normal-exit-symbol)
+         (unwind-protect
+              (prog1
+                  ,form
+                (setf ,normal-exit-symbol t))
+           (unless ,normal-exit-symbol
+             ,@unwind-forms))))))
+
+(put 'iter-end-of-sequence 'error-conditions '(iter-end-of-sequence))
+(put 'iter-end-of-sequence 'error-message "iteration terminated")
+
+(defun cps--make-close-iterator-form (terminal-state)
+  (if *cps-cleanup-table-symbol*
+      `(let ((cleanup (cdr (assq ,*cps-state-symbol* ,*cps-cleanup-table-symbol*))))
+         (setf ,*cps-state-symbol* ,terminal-state
+               ,*cps-value-symbol* nil)
+         (when cleanup (funcall cleanup)))
+    `(setf ,*cps-state-symbol* ,terminal-state
+           ,*cps-value-symbol* nil)))
+
+(defun cps-generate-evaluator (form)
+  (let* (*cps-states*
+         *cps-bindings*
+         *cps-cleanup-function*
+         (*cps-value-symbol* (cl-gensym "cps-current-value-"))
+         (*cps-state-symbol* (cl-gensym "cps-current-state-"))
+         ;; We make *cps-cleanup-table-symbol** non-nil when we notice
+         ;; that we have cleanup processing to perform.
+         (*cps-cleanup-table-symbol* nil)
+         (terminal-state (cps--add-state "terminal"
+                           `(signal 'iter-end-of-sequence
+                                    ,*cps-value-symbol*)))
+         (initial-state (cps--transform-1
+                         (macroexpand-all form)
+                         terminal-state))
+         (finalizer-symbol
+          (when *cps-cleanup-table-symbol*
+            (when *cps-cleanup-table-symbol*
+              (cl-gensym "cps-iterator-finalizer-")))))
+    `(let ,(append (list *cps-state-symbol* *cps-value-symbol*)
+                   (when *cps-cleanup-table-symbol*
+                     (list *cps-cleanup-table-symbol*))
+                   (when finalizer-symbol
+                     (list finalizer-symbol))
+                   (nreverse *cps-bindings*))
+       ;; Order state list so that cleanup states are always defined
+       ;; before they're referenced.
+       ,@(cl-loop for (state body cleanup) in (nreverse *cps-states*)
+            collect `(setf ,state (lambda () ,body))
+            when cleanup
+            do (cl-assert *cps-cleanup-table-symbol*)
+            and collect `(push (cons ,state ,cleanup) ,*cps-cleanup-table-symbol*))
+       (setf ,*cps-state-symbol* ,initial-state)
+
+       (let ((iterator
+              (lambda (op value)
+                (cond
+                  ,@(when finalizer-symbol
+                          `(((eq op :stash-finalizer)
+                             (setf ,finalizer-symbol value))
+                            ((eq op :get-finalizer)
+                             ,finalizer-symbol)))
+                  ((eq op :close)
+                   ,(cps--make-close-iterator-form terminal-state))
+                  ((eq op :next)
+                   (setf ,*cps-value-symbol* value)
+                   (let ((yielded nil))
+                     (unwind-protect
+                          (prog1
+                              (catch 'cps--yield
+                                (while t
+                                  (funcall ,*cps-state-symbol*)))
+                            (setf yielded t))
+                       (unless yielded
+                         ;; If we're exiting non-locally (error, quit,
+                         ;; etc.)  close the iterator.
+                         ,(cps--make-close-iterator-form terminal-state)))))
+                  (t (error "unknown iterator operation %S" op))))))
+         ,(when finalizer-symbol
+                `(funcall iterator
+                          :stash-finalizer
+                          (make-finalizer
+                           (lambda ()
+                             (iter-close iterator)))))
+         iterator))))
+
+(defun iter-yield (value)
+  "When used inside a generator, yield control to caller.
+The caller of `iter-next' receives VALUE, and the next call to
+`iter-next' resumes execution at the previous
+`iter-yield' point."
+  (identity value)
+  (error "`iter-yield' used outside a generator"))
+
+(defmacro iter-yield-from (value)
+  "When used inside a generator function, delegate to a sub-iterator.
+The values that the sub-iterator yields are passed directly to
+the caller, and values supplied to `iter-next' are sent to the
+sub-iterator.  `iter-yield-from' evaluates to the value that the
+sub-iterator function returns via `iter-end-of-sequence'."
+  (let ((errsym (cl-gensym "yield-from-result"))
+        (valsym (cl-gensym "yield-from-value")))
+    `(let ((,valsym ,value))
+       (unwind-protect
+            (condition-case ,errsym
+                (let ((vs nil))
+                  (while t
+                    (setf vs (iter-yield (iter-next ,valsym vs)))))
+              (iter-end-of-sequence (cdr ,errsym)))
+         (iter-close ,valsym)))))
+
+(defmacro iter-defun (name arglist &rest body)
+  "Creates a generator NAME.
+When called as a function, NAME returns an iterator value that
+encapsulates the state of a computation that produces a sequence
+of values.  Callers can retrieve each value using `iter-next'."
+  (declare (indent defun))
+  (cl-assert lexical-binding)
+  `(defun ,name ,arglist
+     ,(cps-generate-evaluator
+       `(cl-macrolet ((iter-yield (value) `(cps-internal-yield ,value)))
+          ,@body))))
+
+(defmacro iter-lambda (arglist &rest body)
+  "Return a lambda generator.
+`iter-lambda' is to `iter-defun' as `lambda' is to `defun'."
+  (declare (indent defun))
+  (cl-assert lexical-binding)
+  `(lambda ,arglist
+     ,(cps-generate-evaluator
+       `(cl-macrolet ((iter-yield (value) `(cps-internal-yield ,value)))
+          ,@body))))
+
+(defun iter-next (iterator &optional yield-result)
+  "Extract a value from an iterator.
+YIELD-RESULT becomes the return value of `iter-yield` in the
+context of the generator.
+
+This routine raises the `iter-end-of-sequence' condition if the
+iterator cannot supply more values."
+  (funcall iterator :next yield-result))
+
+(defun iter-close (iterator)
+  "Terminate an iterator early.
+Run any unwind-protect handlers in scope at the point  ITERATOR
+is blocked."
+  (funcall iterator :close nil))
+
+(cl-defmacro iter-do ((var iterator) &rest body)
+  "Loop over values from an iterator.
+Evaluate BODY with VAR bound to each value from ITERATOR.
+Return the value with which ITERATOR finished iteration."
+  (declare (indent 1))
+  (let ((done-symbol (cl-gensym "iter-do-iterator-done"))
+        (condition-symbol (cl-gensym "iter-do-condition"))
+        (it-symbol (cl-gensym "iter-do-iterator"))
+        (result-symbol (cl-gensym "iter-do-result")))
+    `(let (,var
+           ,result-symbol
+           (,done-symbol nil)
+           (,it-symbol ,iterator))
+       (while (not ,done-symbol)
+         (condition-case ,condition-symbol
+             (setf ,var (iter-next ,it-symbol))
+           (iter-end-of-sequence
+            (setf ,result-symbol (cdr ,condition-symbol))
+            (setf ,done-symbol t)))
+         (unless ,done-symbol ,@body))
+       ,result-symbol)))
+
+(defvar cl--loop-args)
+
+(defmacro cps--advance-for (conscell)
+  ;; See cps--handle-loop-for
+  `(condition-case nil
+       (progn
+         (setcar ,conscell (iter-next (cdr ,conscell)))
+         ,conscell)
+     (iter-end-of-sequence
+      nil)))
+
+(defmacro cps--initialize-for (iterator)
+  ;; See cps--handle-loop-for
+  (let ((cs (cl-gensym "cps--loop-temp")))
+    `(let ((,cs (cons nil ,iterator)))
+       (cps--advance-for ,cs))))
+
+(defun cps--handle-loop-for (var)
+  "Support `iter-by' in `loop'.  "
+  ;; N.B. While the cl-loop-for-handler is a documented interface,
+  ;; there's no documented way for cl-loop-for-handler callbacks to do
+  ;; anything useful!  Additionally, cl-loop currently lexbinds useful
+  ;; internal variables, so our only option is to modify
+  ;; cl--loop-args.  If we substitute a general-purpose for-clause for
+  ;; our iterating clause, however, we can't preserve the
+  ;; parallel-versus-sequential `loop' semantics for for clauses ---
+  ;; we need a terminating condition as well, which requires us to use
+  ;; while, and inserting a while would break and-sequencing.
+  ;;
+  ;; To work around this problem, we actually use the "for var in LIST
+  ;; by FUNCTION" syntax, creating a new fake list each time through
+  ;; the loop, this "list" being a cons cell (val . it).
+  (let ((it-form (pop cl--loop-args)))
+    (setf cl--loop-args
+          (append
+           `(for ,var
+                 in (cps--initialize-for ,it-form)
+                 by 'cps--advance-for)
+           cl--loop-args))))
+
+(put 'iter-by 'cl-loop-for-handler 'cps--handle-loop-for)
+
+(eval-after-load 'elisp-mode
+  (lambda ()
+    (font-lock-add-keywords
+     'emacs-lisp-mode
+     '(("(\\(iter-defun\\)\\_>\\s *\\(\\(?:\\sw\\|\\s_\\)+\\)?"
+        (1 font-lock-keyword-face nil t)
+        (2 font-lock-function-name-face nil t))
+       ("(\\(iter-next\\)\\_>"
+        (1 font-lock-keyword-face nil t))
+       ("(\\(iter-lambda\\)\\_>"
+        (1 font-lock-keyword-face nil t))
+       ("(\\(iter-yield\\)\\_>"
+        (1 font-lock-keyword-face nil t))
+       ("(\\(iter-yield-from\\)\\_>"
+        (1 font-lock-keyword-face nil t))))))
+
+(provide 'generator)
+
+;;; generator.el ends here
diff --git a/test/ChangeLog b/test/ChangeLog
index 684e98f880e..64ad85198af 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,5 +1,7 @@
 2015-03-02  Daniel Colascione  <dancol@dancol.org>
 
+        * automated/generator-tests.el: New tests
+
         * automated/finalizer-tests.el (finalizer-basic)
         (finalizer-circular-reference, finalizer-cross-reference)
         (finalizer-error): New tests.
diff --git a/test/automated/generator-tests.el b/test/automated/generator-tests.el
new file mode 100644
index 00000000000..2c5de31b40b
--- /dev/null
+++ b/test/automated/generator-tests.el
@@ -0,0 +1,288 @@
+;;; generator-tests.el --- Testing generators -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Daniel Colascione <dancol@dancol.org>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+(require 'generator)
+(require 'ert)
+(require 'cl-lib)
+
+(defun generator-list-subrs ()
+  (cl-loop for x being the symbols
+        when (and (fboundp x)
+                  (cps--special-form-p (symbol-function x)))
+        collect x))
+
+(defmacro cps-testcase (name &rest body)
+  "Perform a simple test of the continuation-transforming code.
+
+`cps-testcase' defines an ERT testcase called NAME that evaluates
+BODY twice: once using ordinary `eval' and once using
+lambda-generators.  The test ensures that the two forms produce
+identical output.
+"
+  `(progn
+     (ert-deftest ,name ()
+       (should
+        (equal
+         (funcall (lambda () ,@body))
+         (iter-next
+          (funcall
+           (iter-lambda () (iter-yield (progn ,@body))))))))
+     (ert-deftest ,(intern (format "%s-noopt" name)) ()
+       (should
+        (equal
+         (funcall (lambda () ,@body))
+         (iter-next
+          (funcall
+           (let ((cps-disable-atomic-optimization t))
+             (iter-lambda () (iter-yield (progn ,@body)))))))))))
+
+(put 'cps-testcase 'lisp-indent-function 1)
+
+(defvar *cps-test-i* nil)
+(defun cps-get-test-i ()
+  *cps-test-i*)
+
+(cps-testcase cps-simple-1 (progn 1 2 3))
+(cps-testcase cps-empty-progn (progn))
+(cps-testcase cps-inline-not-progn (inline 1 2 3))
+(cps-testcase cps-prog1-a (prog1 1 2 3))
+(cps-testcase cps-prog1-b (prog1 1))
+(cps-testcase cps-prog1-c (prog2 1 2 3))
+(cps-testcase cps-quote (progn 'hello))
+(cps-testcase cps-function (progn #'hello))
+
+(cps-testcase cps-and-fail (and 1 nil 2))
+(cps-testcase cps-and-succeed (and 1 2 3))
+(cps-testcase cps-and-empty (and))
+
+(cps-testcase cps-or-fallthrough (or nil 1 2))
+(cps-testcase cps-or-alltrue (or 1 2 3))
+(cps-testcase cps-or-empty (or))
+
+(cps-testcase cps-let* (let* ((i 10)) i))
+(cps-testcase cps-let*-shadow-empty (let* ((i 10)) (let (i) i)))
+(cps-testcase cps-let (let ((i 10)) i))
+(cps-testcase cps-let-shadow-empty (let ((i 10)) (let (i) i)))
+(cps-testcase cps-let-novars (let nil 42))
+(cps-testcase cps-let*-novars (let* nil 42))
+
+(cps-testcase cps-let-parallel
+  (let ((a 5) (b 6)) (let ((a b) (b a)) (list a b))))
+
+(cps-testcase cps-let*-parallel
+  (let* ((a 5) (b 6)) (let* ((a b) (b a)) (list a b))))
+
+(cps-testcase cps-while-dynamic
+  (setq *cps-test-i* 0)
+  (while (< *cps-test-i* 10)
+    (setf *cps-test-i* (+ *cps-test-i* 1)))
+  *cps-test-i*)
+
+(cps-testcase cps-while-lexical
+ (let* ((i 0) (j 10))
+   (while (< i 10)
+     (setf i (+ i 1))
+     (setf j (+ j (* i 10))))
+   j))
+
+(cps-testcase cps-while-incf
+ (let* ((i 0) (j 10))
+   (while (< i 10)
+     (incf i)
+     (setf j (+ j (* i 10))))
+   j))
+
+(cps-testcase cps-dynbind
+ (setf *cps-test-i* 0)
+ (let* ((*cps-test-i* 5))
+   (cps-get-test-i)))
+
+(cps-testcase cps-nested-application
+ (+ (+ 3 5) 1))
+
+(cps-testcase cps-unwind-protect
+ (setf *cps-test-i* 0)
+ (unwind-protect
+     (setf *cps-test-i* 1)
+   (setf *cps-test-i* 2))
+ *cps-test-i*)
+
+(cps-testcase cps-catch-unused
+ (catch 'mytag 42))
+
+(cps-testcase cps-catch-thrown
+ (1+ (catch 'mytag
+       (throw 'mytag (+ 2 2)))))
+
+(cps-testcase cps-loop
+ (cl-loop for x from 1 to 10 collect x))
+
+(cps-testcase cps-loop-backquote
+ `(a b ,(cl-loop for x from 1 to 10 collect x) -1))
+
+(cps-testcase cps-if-branch-a
+ (if t 'abc))
+
+(cps-testcase cps-if-branch-b
+ (if t 'abc 'def))
+
+(cps-testcase cps-if-condition-fail
+ (if nil 'abc 'def))
+
+(cps-testcase cps-cond-empty
+ (cond))
+
+(cps-testcase cps-cond-atomi
+ (cond (42)))
+
+(cps-testcase cps-cond-complex
+ (cond (nil 22) ((1+ 1) 42) (t 'bad)))
+
+(put 'cps-test-error 'error-conditions '(cps-test-condition))
+
+(cps-testcase cps-condition-case
+  (condition-case
+      condvar
+      (signal 'cps-test-error 'test-data)
+    (cps-test-condition condvar)))
+
+(cps-testcase cps-condition-case-no-error
+  (condition-case
+      condvar
+      42
+    (cps-test-condition condvar)))
+
+(ert-deftest cps-generator-basic ()
+  (let* ((gen (iter-lambda ()
+                (iter-yield 1)
+                (iter-yield 2)
+                (iter-yield 3)
+                4))
+         (gen-inst (funcall gen)))
+    (should (eql (iter-next gen-inst) 1))
+    (should (eql (iter-next gen-inst) 2))
+    (should (eql (iter-next gen-inst) 3))
+
+    ;; should-error doesn't catch the generator-end condition (which
+    ;; isn't an error), so we write our own.
+    (let (errored)
+      (condition-case x
+          (iter-next gen-inst)
+        (iter-end-of-sequence
+         (setf errored (cdr x))))
+      (should (eql errored 4)))))
+
+(iter-defun mygenerator (i)
+  (iter-yield 1)
+  (iter-yield i)
+  (iter-yield 2))
+
+(ert-deftest cps-test-iter-do ()
+  (let (mylist)
+    (iter-do (x (mygenerator 4))
+      (push x mylist))
+
+    (assert (equal mylist '(2 4 1)))))
+
+(iter-defun gen-using-yield-value ()
+  (let (f)
+    (setf f (iter-yield 42))
+    (iter-yield f)
+    -8))
+
+(ert-deftest cps-yield-value ()
+  (let ((it (gen-using-yield-value)))
+    (should (eql (iter-next it -1) 42))
+    (should (eql (iter-next it -1) -1))))
+
+(ert-deftest cps-loop ()
+  (should
+   (equal (cl-loop for x iter-by (mygenerator 42)
+             collect x)
+          '(1 42 2))))
+
+(iter-defun gen-using-yield-from ()
+  (let ((sub-iter (gen-using-yield-value)))
+    (iter-yield (1+ (iter-yield-from sub-iter)))))
+
+(ert-deftest cps-test-yield-from-works ()
+  (let ((it (gen-using-yield-from)))
+    (should (eql (iter-next it -1) 42))
+    (should (eql (iter-next it -1) -1))
+    (should (eql (iter-next it -1) -7))))
+
+(defvar cps-test-closed-flag nil)
+
+(ert-deftest cps-test-iter-close ()
+  (garbage-collect)
+  (let ((cps-test-closed-flag nil))
+    (let ((iter (funcall
+                 (iter-lambda ()
+                   (unwind-protect (iter-yield 1)
+                     (setf cps-test-closed-flag t))))))
+      (should (equal (iter-next iter) 1))
+      (should (not cps-test-closed-flag))
+      (iter-close iter)
+      (should cps-test-closed-flag))))
+
+(ert-deftest cps-test-iter-close-idempotent ()
+  (garbage-collect)
+  (let ((cps-test-closed-flag nil))
+    (let ((iter (funcall
+                 (iter-lambda ()
+                   (unwind-protect (iter-yield 1)
+                     (setf cps-test-closed-flag t))))))
+      (should (equal (iter-next iter) 1))
+      (should (not cps-test-closed-flag))
+      (iter-close iter)
+      (should cps-test-closed-flag)
+      (setf cps-test-closed-flag nil)
+      (iter-close iter)
+      (should (not cps-test-closed-flag)))))
+
+(ert-deftest cps-test-iter-close-finalizer ()
+  (skip-unless gc-precise-p)
+  (garbage-collect)
+  (let ((cps-test-closed-flag nil))
+    (let ((iter (funcall
+                 (iter-lambda ()
+                   (unwind-protect (iter-yield 1)
+                     (setf cps-test-closed-flag t))))))
+      (should (equal (iter-next iter) 1))
+      (should (not cps-test-closed-flag))
+      (setf iter nil)
+      (garbage-collect)
+      (should cps-test-closed-flag))))
+
+(ert-deftest cps-test-iter-cleanup-once-only ()
+  (let* ((nr-unwound 0)
+         (iter
+          (funcall (iter-lambda ()
+                     (unwind-protect
+                          (progn
+                            (iter-yield 1)
+                            (error "test")
+                            (iter-yield 2))
+                       (incf nr-unwound))))))
+    (should (equal (iter-next iter) 1))
+    (should-error (iter-next iter))
+    (should (equal nr-unwound 1))))