procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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>
* 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.

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}
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
@code{bodyform} and becomes unreachable, Emacs will eventually run
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}.
@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)))

8
lisp/ChangeLog
View file

@ -1,7 +1,13 @@
2015-03-03 Daniel Colascione <dancol@dancol.org>
* 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>

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

@ -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)

4
test/ChangeLog
View file

@ -1,5 +1,9 @@
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)
(finalizer-circular-reference, finalizer-cross-reference)
(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))
(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)