Commit f6b5db6c authored by Daniel Colascione's avatar Daniel Colascione

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.
parent 9d8d0658
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
......
......@@ -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
......
......@@ -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
......
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
......
......@@ -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
......
......@@ -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.
......
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>
......
This diff is collapsed.
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.
......
;;; 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))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment