[Emacs-diffs] master cecf4af: Address generator feedback

[Daniel Colascione]

branch: master
commit cecf4afebb394351a78c48d05e81a1e55af6da32
Author: Daniel Colascione <address@hidden>
Commit: Daniel Colascione <address@hidden>

    Address generator feedback
    
    * doc/lispref/control.texi (Generators): Correct missing word.  Clarify 
which
    forms are legal in which parts of `unwind-protect'.  Fix orphaned
    close parenthesis.
    
    * lisp/emacs-lisp/generator.el: Make globals conform to elisp
    style throughout.  Use more efficient font-lock patterns.
    (cps-inhibit-atomic-optimization): Rename from
    `cps-disable-atomic-optimization'.
    (cps--gensym): New macro; replaces `cl-gensym' throughout.
    (cps-generate-evaluator): Move the `iter-yield' local macro
    definition here
    (iter-defun, iter-lambda): from here.
    
    * test/automated/generator-tests.el (cps-test-iter-close-finalizer):
    Rename `gc-precise-p' to `gc-precise'.
    
    * test/automated/generator-tests.el (cps-testcase): Use
    `cps-inhibit-atomic-optimization' instead of
    `cps-disable-atomic-optimization'.
---
 doc/lispref/ChangeLog             |    4 ++
 doc/lispref/control.texi          |   14 ++++---
 lisp/ChangeLog                    |    8 +++-
 lisp/emacs-lisp/generator.el      |   77 +++++++++++++++++++------------------
 test/ChangeLog                    |    4 ++
 test/automated/generator-tests.el |    2 +-
 6 files changed, 64 insertions(+), 45 deletions(-)

diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index c27805b..f96cb26 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,5 +1,9 @@
 2015-03-03  Daniel Colascione  <address@hidden>
 
+       * control.texi (Generators): Correct missing word.  Clarify which
+       forms are legal in which parts of `unwind-protect'.  Fix orphaned
+       close parenthesis.
+
        * objects.texi (Finalizer Type): New section for finalizer objects.
        (Type Predicates): Mention finalizers in `type-of' documentation.
        * elisp.texi (Top): Link to finalizer type.
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index bec2bc9..f512ad9 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -661,7 +661,7 @@ indicates that the current iterator should pause and return
 @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}.
+receives values sent to the iterator using @code{iter-next}.
 @end defmac
 
   To use a generator function, first call it normally, producing a
@@ -693,9 +693,11 @@ 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
+If @var{iterator} is suspended inside an @code{unwind-protect}'s
address@hidden and becomes unreachable, Emacs will eventually run
+unwind handlers after a garbage collection pass.  (Note that
address@hidden is illegal inside an @code{unwind-protect}'s
address@hidden)  To ensure that these handlers are run before
 then, use @code{iter-close}.
 @end defun
 
@@ -716,8 +718,8 @@ working with iterators.
 @example
 (iter-defun my-iter (x)
   (iter-yield (1+ (iter-yield (1+ x))))
-  -1 ;; Return normally
-  )
+   ;; Return normally
+  -1)
 
 (let* ((iter (my-iter 5))
        (iter2 (my-iter 0)))
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e08263d..6307173 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,7 +1,13 @@
 2015-03-03  Daniel Colascione  <address@hidden>
 
        * emacs-lisp/generator.el: Make globals conform to elisp
-       style throughout.
+       style throughout.  Use more efficient font-lock patterns.
+       (cps-inhibit-atomic-optimization): Rename from
+       `cps-disable-atomic-optimization'.
+       (cps--gensym): New macro; replaces `cl-gensym' throughout.
+       (cps-generate-evaluator): Move the `iter-yield' local macro
+       definition here
+       (iter-defun, iter-lambda): from here.
 
 2015-03-03  Artur Malabarba  <address@hidden>
 
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
index d41f13e..77b1fab 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -86,6 +86,12 @@
 (defvar cps--cleanup-table-symbol nil)
 (defvar cps--cleanup-function nil)
 
+(defmacro cps--gensym (fmt &rest args)
+  ;; Change this function to use `cl-gensym' if you want the generated
+  ;; code to be easier to read and debug.
+  ;; (cl-gensym (apply #'format fmt args))
+  `(make-symbol ,fmt))
+
 (defvar cps--dynamic-wrappers '(identity)
   "List of transformer functions to apply to atomic forms we
 evaluate in CPS context.")
@@ -154,13 +160,13 @@ DYNAMIC-VAR bound to STATIC-VAR."
 (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))))
+  (let* ((state (cps--gensym "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))
+  (car (push (cps--gensym (format "cps-binding-%s-" original-name))
              cps--bindings)))
 
 (defun cps--find-special-form-handler (form)
@@ -168,7 +174,7 @@ DYNAMIC-VAR bound to STATIC-VAR."
          (handler (intern-soft handler-name)))
     (and (fboundp handler) handler)))
 
-(defvar cps-disable-atomic-optimization nil
+(defvar cps-inhibit-atomic-optimization nil
   "When t, always rewrite forms into cps even when they
 don't yield.")
 
@@ -177,13 +183,14 @@ don't yield.")
 (defun cps--atomic-p (form)
   "Return whether the given form never yields."
 
-  (and (not cps-disable-atomic-optimization)
+  (and (not cps-inhibit-atomic-optimization)
        (let* ((cps--yield-seen))
          (ignore (macroexpand-all
                   `(cl-macrolet ((cps-internal-yield
                                      (_val)
                                    (setf cps--yield-seen t)))
-                     ,form)))
+                     ,form)
+                  macroexpand-all-environment))
          (not cps--yield-seen))))
 
 (defun cps--make-atomic-state (form next-state)
@@ -403,7 +410,7 @@ don't yield.")
       ;; 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-")))
+        (setf cps--cleanup-table-symbol (cps--gensym "cps-cleanup-table-")))
       (let* ((unwind-state
               (cps--add-state
                   "unwind"
@@ -431,7 +438,7 @@ don't yield.")
       ;; need our states to be self-referential. (That's what makes the
       ;; state a loop.)
       (let* ((loop-state
-                (cl-gensym "cps-state-while-"))
+                (cps--gensym "cps-state-while-"))
              (eval-loop-condition-state
               (cps--transform-1 test loop-state))
              (loop-state-body
@@ -489,7 +496,7 @@ don't yield.")
             (cl-loop for argument in arguments
                collect (if (atom argument)
                            argument
-                         (cl-gensym "cps-argument-")))))
+                         (cps--gensym "cps-argument-")))))
 
        (cps--transform-1
         `(let* ,(cl-loop for argument in arguments
@@ -505,7 +512,7 @@ don't yield.")
 (defun cps--make-catch-wrapper (tag-binding next-state)
   (lambda (form)
     (let ((normal-exit-symbol
-           (cl-gensym "cps-normal-exit-from-catch-")))
+           (cps--gensym "cps-normal-exit-from-catch-")))
       `(let (,normal-exit-symbol)
          (prog1
              (catch ,tag-binding
@@ -521,7 +528,7 @@ don't yield.")
   ;; encounter the given error.
 
   (let* ((error-symbol (cps--add-binding "condition-case-error"))
-         (lexical-error-symbol (cl-gensym "cps-lexical-error-"))
+         (lexical-error-symbol (cps--gensym "cps-lexical-error-"))
          (processed-handlers
           (cl-loop for (condition . body) in handlers
              collect (cons condition
@@ -549,13 +556,14 @@ don't yield.")
 This routine does not modify FORM. Instead, it returns a
 modified copy."
   (macroexpand-all
-   `(cl-symbol-macrolet ((,var ,new-var)) ,form)))
+   `(cl-symbol-macrolet ((,var ,new-var)) ,form)
+   macroexpand-all-environment))
 
 (defun cps--make-unwind-wrapper (unwind-forms)
   (cl-assert lexical-binding)
   (lambda (form)
     (let ((normal-exit-symbol
-           (cl-gensym "cps-normal-exit-from-unwind-")))
+           (cps--gensym "cps-normal-exit-from-unwind-")))
       `(let (,normal-exit-symbol)
          (unwind-protect
               (prog1
@@ -576,12 +584,12 @@ modified copy."
     `(setf ,cps--state-symbol ,terminal-state
            ,cps--value-symbol nil)))
 
-(defun cps-generate-evaluator (form)
+(defun cps-generate-evaluator (body)
   (let* (cps--states
          cps--bindings
          cps--cleanup-function
-         (cps--value-symbol (cl-gensym "cps-current-value-"))
-         (cps--state-symbol (cl-gensym "cps-current-state-"))
+         (cps--value-symbol (cps--gensym "cps-current-value-"))
+         (cps--state-symbol (cps--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)
@@ -589,12 +597,17 @@ modified copy."
                            `(signal 'iter-end-of-sequence
                                     ,cps--value-symbol)))
          (initial-state (cps--transform-1
-                         (macroexpand-all form)
+                         (macroexpand-all
+                          `(cl-macrolet
+                               ((iter-yield (value)
+                                  `(cps-internal-yield ,value)))
+                             ,@body)
+                          macroexpand-all-environment)
                          terminal-state))
          (finalizer-symbol
           (when cps--cleanup-table-symbol
             (when cps--cleanup-table-symbol
-              (cl-gensym "cps-iterator-finalizer-")))))
+              (cps--gensym "cps-iterator-finalizer-")))))
     `(let ,(append (list cps--state-symbol cps--value-symbol)
                    (when cps--cleanup-table-symbol
                      (list cps--cleanup-table-symbol))
@@ -656,8 +669,8 @@ 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 ((errsym (cps--gensym "yield-from-result"))
+        (valsym (cps--gensym "yield-from-value")))
     `(let ((,valsym ,value))
        (unwind-protect
             (condition-case ,errsym
@@ -681,9 +694,7 @@ of values.  Callers can retrieve each value using 
`iter-next'."
       (push (pop body) preamble))
     `(defun ,name ,arglist
        ,@(nreverse preamble)
-       ,(cps-generate-evaluator
-         `(cl-macrolet ((iter-yield (value) `(cps-internal-yield ,value)))
-            ,@body)))))
+       ,(cps-generate-evaluator body))))
 
 (defmacro iter-lambda (arglist &rest body)
   "Return a lambda generator.
@@ -691,9 +702,7 @@ of values.  Callers can retrieve each value using 
`iter-next'."
   (declare (indent defun))
   (cl-assert lexical-binding)
   `(lambda ,arglist
-     ,(cps-generate-evaluator
-       `(cl-macrolet ((iter-yield (value) `(cps-internal-yield ,value)))
-          ,@body))))
+     ,(cps-generate-evaluator body)))
 
 (defun iter-next (iterator &optional yield-result)
   "Extract a value from an iterator.
@@ -715,10 +724,10 @@ is blocked."
 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 ((done-symbol (cps--gensym "iter-do-iterator-done"))
+        (condition-symbol (cps--gensym "iter-do-condition"))
+        (it-symbol (cps--gensym "iter-do-iterator"))
+        (result-symbol (cps--gensym "iter-do-result")))
     `(let (,var
            ,result-symbol
            (,done-symbol nil)
@@ -745,7 +754,7 @@ Return the value with which ITERATOR finished iteration."
 
 (defmacro cps--initialize-for (iterator)
   ;; See cps--handle-loop-for
-  (let ((cs (cl-gensym "cps--loop-temp")))
+  (let ((cs (cps--gensym "cps--loop-temp")))
     `(let ((,cs (cons nil ,iterator)))
        (cps--advance-for ,cs))))
 
@@ -781,13 +790,7 @@ Return the value with which ITERATOR finished iteration."
      '(("(\\(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\\)\\_>"
+       ("(\\(iter-\\(?:next\\|lambda\\|yield\\|yield-from\\)\\)\\_>"
         (1 font-lock-keyword-face nil t))))))
 
 (provide 'generator)
diff --git a/test/ChangeLog b/test/ChangeLog
index ea2e0ee..55f8c6c 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,5 +1,9 @@
 2015-03-03  Daniel Colascione  <address@hidden>
 
+       * automated/generator-tests.el (cps-testcase): Use
+       `cps-inhibit-atomic-optimization' instead of
+       `cps-disable-atomic-optimization'.
+
        * automated/finalizer-tests.el (finalizer-basic)
        (finalizer-circular-reference, finalizer-cross-reference)
        (finalizer-error): Rename `gc-precise-p' to `gc-precise'.
diff --git a/test/automated/generator-tests.el 
b/test/automated/generator-tests.el
index 893c0d2..3ee6510 100644
--- a/test/automated/generator-tests.el
+++ b/test/automated/generator-tests.el
@@ -54,7 +54,7 @@ identical output.
          (funcall (lambda () ,@body))
          (iter-next
           (funcall
-           (let ((cps-disable-atomic-optimization t))
+           (let ((cps-inhibit-atomic-optimization t))
              (iter-lambda () (iter-yield (progn ,@body)))))))))))
 
 (put 'cps-testcase 'lisp-indent-function 1)