mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-09 07:40:39 -08:00
Code Issues Projects Releases Wiki Activity

Address generator feedback

Browse source 
* 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'.
This commit is contained in:
Daniel Colascione 2015-03-03 10:56:24 -08:00
parent 02eb227e81
commit cecf4afebb
6 changed files with 64 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

4
doc/lispref/ChangeLog
View file

@ -1,5 +1,9 @@
2015-03-03 Daniel Colascione <dancol@dancol.org> 2015-03-03 Daniel Colascione <dancol@dancol.org>
* 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. * objects.texi (Finalizer Type): New section for finalizer objects.
(Type Predicates): Mention finalizers in `type-of' documentation. (Type Predicates): Mention finalizers in `type-of' documentation.
* elisp.texi (Top): Link to finalizer type. * elisp.texi (Top): Link to finalizer type.

14
doc/lispref/control.texi
View file

@ -661,7 +661,7 @@ indicates that the current iterator should pause and return
@code{iter-yield-from} yields all the values that @var{iterator} @code{iter-yield-from} yields all the values that @var{iterator}
produces and evaluates to the value that @var{iterator}'s generator produces and evaluates to the value that @var{iterator}'s generator
function returns normally. While it has control, @var{iterator} 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 @end defmac
To use a generator function, first call it normally, producing a To use a generator function, first call it normally, producing a
@ -693,9 +693,11 @@ evaluating any @code{iter-yield} form.
@end defun @end defun
@defun iter-close iterator @defun iter-close iterator
If @var{iterator} is suspended inside a @code{unwind-protect} and If @var{iterator} is suspended inside an @code{unwind-protect}'s
becomes unreachable, Emacs will eventually run unwind handlers after a @code{bodyform} and becomes unreachable, Emacs will eventually run
garbage collection pass. To ensure that these handlers are run before unwind handlers after a garbage collection pass. (Note that
@code{iter-yield} is illegal inside an @code{unwind-protect}'s
@code{unwindforms}.) To ensure that these handlers are run before
then, use @code{iter-close}. then, use @code{iter-close}.
@end defun @end defun
@ -716,8 +718,8 @@ working with iterators.
@example @example
(iter-defun my-iter (x) (iter-defun my-iter (x)
(iter-yield (1+ (iter-yield (1+ x)))) (iter-yield (1+ (iter-yield (1+ x))))
-1 ;; Return normally ;; Return normally
) -1)
(let* ((iter (my-iter 5)) (let* ((iter (my-iter 5))
(iter2 (my-iter 0))) (iter2 (my-iter 0)))

8
lisp/ChangeLog
View file

@ -1,7 +1,13 @@
2015-03-03 Daniel Colascione <dancol@dancol.org> 2015-03-03 Daniel Colascione <dancol@dancol.org>
* emacs-lisp/generator.el: Make globals conform to elisp * 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 <bruce.connor.am@gmail.com> 2015-03-03 Artur Malabarba <bruce.connor.am@gmail.com>

77
lisp/emacs-lisp/generator.el
View file

@ -86,6 +86,12 @@
(defvar cps--cleanup-table-symbol nil) (defvar cps--cleanup-table-symbol nil)
(defvar cps--cleanup-function 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) (defvar cps--dynamic-wrappers '(identity)
"List of transformer functions to apply to atomic forms we "List of transformer functions to apply to atomic forms we
evaluate in CPS context.") evaluate in CPS context.")
@ -154,13 +160,13 @@ DYNAMIC-VAR bound to STATIC-VAR."
(defun cps--add-state (kind body) (defun cps--add-state (kind body)
"Create a new CPS state with body BODY and return the state's name." "Create a new CPS state with body BODY and return the state's name."
(declare (indent 1)) (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 (list state body cps--cleanup-function) cps--states)
(push state cps--bindings) (push state cps--bindings)
state)) state))
(defun cps--add-binding (original-name) (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))) cps--bindings)))
(defun cps--find-special-form-handler (form) (defun cps--find-special-form-handler (form)
@ -168,7 +174,7 @@ DYNAMIC-VAR bound to STATIC-VAR."
(handler (intern-soft handler-name))) (handler (intern-soft handler-name)))
(and (fboundp handler) handler))) (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 "When t, always rewrite forms into cps even when they
don't yield.") don't yield.")
@ -177,13 +183,14 @@ don't yield.")
(defun cps--atomic-p (form) (defun cps--atomic-p (form)
"Return whether the given form never yields." "Return whether the given form never yields."
(and (not cps-disable-atomic-optimization) (and (not cps-inhibit-atomic-optimization)
(let* ((cps--yield-seen)) (let* ((cps--yield-seen))
(ignore (macroexpand-all (ignore (macroexpand-all
`(cl-macrolet ((cps-internal-yield `(cl-macrolet ((cps-internal-yield
(_val) (_val)
(setf cps--yield-seen t))) (setf cps--yield-seen t)))
,form))) ,form)
macroexpand-all-environment))
(not cps--yield-seen)))) (not cps--yield-seen))))
(defun cps--make-atomic-state (form next-state) (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 ;; Signal the evaluator-generator that it needs to generate code
;; to handle cleanup forms. ;; to handle cleanup forms.
(unless cps--cleanup-table-symbol (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 (let* ((unwind-state
(cps--add-state (cps--add-state
"unwind" "unwind"
@ -431,7 +438,7 @@ don't yield.")
;; need our states to be self-referential. (That's what makes the ;; need our states to be self-referential. (That's what makes the
;; state a loop.) ;; state a loop.)
(let* ((loop-state (let* ((loop-state
(cl-gensym "cps-state-while-")) (cps--gensym "cps-state-while-"))
(eval-loop-condition-state (eval-loop-condition-state
(cps--transform-1 test loop-state)) (cps--transform-1 test loop-state))
(loop-state-body (loop-state-body
@ -489,7 +496,7 @@ don't yield.")
(cl-loop for argument in arguments (cl-loop for argument in arguments
collect (if (atom argument) collect (if (atom argument)
argument argument
(cl-gensym "cps-argument-"))))) (cps--gensym "cps-argument-")))))
(cps--transform-1 (cps--transform-1
`(let* ,(cl-loop for argument in arguments `(let* ,(cl-loop for argument in arguments
@ -505,7 +512,7 @@ don't yield.")
(defun cps--make-catch-wrapper (tag-binding next-state) (defun cps--make-catch-wrapper (tag-binding next-state)
(lambda (form) (lambda (form)
(let ((normal-exit-symbol (let ((normal-exit-symbol
(cl-gensym "cps-normal-exit-from-catch-"))) (cps--gensym "cps-normal-exit-from-catch-")))
`(let (,normal-exit-symbol) `(let (,normal-exit-symbol)
(prog1 (prog1
(catch ,tag-binding (catch ,tag-binding
@ -521,7 +528,7 @@ don't yield.")
;; encounter the given error. ;; encounter the given error.
(let* ((error-symbol (cps--add-binding "condition-case-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 (processed-handlers
(cl-loop for (condition . body) in handlers (cl-loop for (condition . body) in handlers
collect (cons condition collect (cons condition
@ -549,13 +556,14 @@ don't yield.")
This routine does not modify FORM. Instead, it returns a This routine does not modify FORM. Instead, it returns a
modified copy." modified copy."
(macroexpand-all (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) (defun cps--make-unwind-wrapper (unwind-forms)
(cl-assert lexical-binding) (cl-assert lexical-binding)
(lambda (form) (lambda (form)
(let ((normal-exit-symbol (let ((normal-exit-symbol
(cl-gensym "cps-normal-exit-from-unwind-"))) (cps--gensym "cps-normal-exit-from-unwind-")))
`(let (,normal-exit-symbol) `(let (,normal-exit-symbol)
(unwind-protect (unwind-protect
(prog1 (prog1
@ -576,12 +584,12 @@ modified copy."
`(setf ,cps--state-symbol ,terminal-state `(setf ,cps--state-symbol ,terminal-state
,cps--value-symbol nil))) ,cps--value-symbol nil)))
(defun cps-generate-evaluator (form) (defun cps-generate-evaluator (body)
(let* (cps--states (let* (cps--states
cps--bindings cps--bindings
cps--cleanup-function cps--cleanup-function
(cps--value-symbol (cl-gensym "cps-current-value-")) (cps--value-symbol (cps--gensym "cps-current-value-"))
(cps--state-symbol (cl-gensym "cps-current-state-")) (cps--state-symbol (cps--gensym "cps-current-state-"))
;; We make *cps-cleanup-table-symbol** non-nil when we notice ;; We make *cps-cleanup-table-symbol** non-nil when we notice
;; that we have cleanup processing to perform. ;; that we have cleanup processing to perform.
(cps--cleanup-table-symbol nil) (cps--cleanup-table-symbol nil)
@ -589,12 +597,17 @@ modified copy."
`(signal 'iter-end-of-sequence `(signal 'iter-end-of-sequence
,cps--value-symbol))) ,cps--value-symbol)))
(initial-state (cps--transform-1 (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)) terminal-state))
(finalizer-symbol (finalizer-symbol
(when cps--cleanup-table-symbol (when cps--cleanup-table-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) `(let ,(append (list cps--state-symbol cps--value-symbol)
(when cps--cleanup-table-symbol (when cps--cleanup-table-symbol
(list 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 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. `iter-yield-from' evaluates to the value that the
sub-iterator function returns via `iter-end-of-sequence'." sub-iterator function returns via `iter-end-of-sequence'."
(let ((errsym (cl-gensym "yield-from-result")) (let ((errsym (cps--gensym "yield-from-result"))
(valsym (cl-gensym "yield-from-value"))) (valsym (cps--gensym "yield-from-value")))
`(let ((,valsym ,value)) `(let ((,valsym ,value))
(unwind-protect (unwind-protect
(condition-case ,errsym (condition-case ,errsym
@ -681,9 +694,7 @@ of values. Callers can retrieve each value using `iter-next'."
(push (pop body) preamble)) (push (pop body) preamble))
`(defun ,name ,arglist `(defun ,name ,arglist
,@(nreverse preamble) ,@(nreverse preamble)
,(cps-generate-evaluator ,(cps-generate-evaluator body))))
`(cl-macrolet ((iter-yield (value) `(cps-internal-yield ,value)))
,@body)))))
(defmacro iter-lambda (arglist &rest body) (defmacro iter-lambda (arglist &rest body)
"Return a lambda generator. "Return a lambda generator.
@ -691,9 +702,7 @@ of values. Callers can retrieve each value using `iter-next'."
(declare (indent defun)) (declare (indent defun))
(cl-assert lexical-binding) (cl-assert lexical-binding)
`(lambda ,arglist `(lambda ,arglist
,(cps-generate-evaluator ,(cps-generate-evaluator body)))
`(cl-macrolet ((iter-yield (value) `(cps-internal-yield ,value)))
,@body))))
(defun iter-next (iterator &optional yield-result) (defun iter-next (iterator &optional yield-result)
"Extract a value from an iterator. "Extract a value from an iterator.
@ -715,10 +724,10 @@ is blocked."
Evaluate BODY with VAR bound to each value from ITERATOR. Evaluate BODY with VAR bound to each value from ITERATOR.
Return the value with which ITERATOR finished iteration." Return the value with which ITERATOR finished iteration."
(declare (indent 1)) (declare (indent 1))
(let ((done-symbol (cl-gensym "iter-do-iterator-done")) (let ((done-symbol (cps--gensym "iter-do-iterator-done"))
(condition-symbol (cl-gensym "iter-do-condition")) (condition-symbol (cps--gensym "iter-do-condition"))
(it-symbol (cl-gensym "iter-do-iterator")) (it-symbol (cps--gensym "iter-do-iterator"))
(result-symbol (cl-gensym "iter-do-result"))) (result-symbol (cps--gensym "iter-do-result")))
`(let (,var `(let (,var
,result-symbol ,result-symbol
(,done-symbol nil) (,done-symbol nil)
@ -745,7 +754,7 @@ Return the value with which ITERATOR finished iteration."
(defmacro cps--initialize-for (iterator) (defmacro cps--initialize-for (iterator)
;; See cps--handle-loop-for ;; See cps--handle-loop-for
(let ((cs (cl-gensym "cps--loop-temp"))) (let ((cs (cps--gensym "cps--loop-temp")))
`(let ((,cs (cons nil ,iterator))) `(let ((,cs (cons nil ,iterator)))
(cps--advance-for ,cs)))) (cps--advance-for ,cs))))
@ -781,13 +790,7 @@ Return the value with which ITERATOR finished iteration."
'(("(\\(iter-defun\\)\\_>\\s *\\(\\(?:\\sw\\|\\s_\\)+\\)?" '(("(\\(iter-defun\\)\\_>\\s *\\(\\(?:\\sw\\|\\s_\\)+\\)?"
(1 font-lock-keyword-face nil t) (1 font-lock-keyword-face nil t)
(2 font-lock-function-name-face nil t)) (2 font-lock-function-name-face nil t))
("(\\(iter-next\\)\\_>" ("(\\(iter-\\(?:next\\|lambda\\|yield\\|yield-from\\)\\)\\_>"
(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)))))) (1 font-lock-keyword-face nil t))))))
(provide 'generator) (provide 'generator)

4
test/ChangeLog
View file

@ -1,5 +1,9 @@
2015-03-03 Daniel Colascione <dancol@dancol.org> 2015-03-03 Daniel Colascione <dancol@dancol.org>
* automated/generator-tests.el (cps-testcase): Use
`cps-inhibit-atomic-optimization' instead of
`cps-disable-atomic-optimization'.
* automated/finalizer-tests.el (finalizer-basic) * automated/finalizer-tests.el (finalizer-basic)
(finalizer-circular-reference, finalizer-cross-reference) (finalizer-circular-reference, finalizer-cross-reference)
(finalizer-error): Rename `gc-precise-p' to `gc-precise'. (finalizer-error): Rename `gc-precise-p' to `gc-precise'.

2
test/automated/generator-tests.el
View file

@ -54,7 +54,7 @@ identical output.
(funcall (lambda () ,@body)) (funcall (lambda () ,@body))
(iter-next (iter-next
(funcall (funcall
(let ((cps-disable-atomic-optimization t)) (let ((cps-inhibit-atomic-optimization t))
(iter-lambda () (iter-yield (progn ,@body))))))))))) (iter-lambda () (iter-yield (progn ,@body)))))))))))
(put 'cps-testcase 'lisp-indent-function 1) (put 'cps-testcase 'lisp-indent-function 1)