aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDaniel Colascione2015-03-03 10:56:24 -0800
committerDaniel Colascione2015-03-03 10:56:24 -0800
commitcecf4afebb394351a78c48d05e81a1e55af6da32 (patch)
tree983591013d5ea7c5375546948044b519dff1680d
parent02eb227e8163c6212e814b5b7e191b4d34306872 (diff)
downloademacs-cecf4afebb394351a78c48d05e81a1e55af6da32.tar.gz
emacs-cecf4afebb394351a78c48d05e81a1e55af6da32.zip
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'.
-rw-r--r--doc/lispref/ChangeLog4
-rw-r--r--doc/lispref/control.texi14
-rw-r--r--lisp/ChangeLog8
-rw-r--r--lisp/emacs-lisp/generator.el77
-rw-r--r--test/ChangeLog4
-rw-r--r--test/automated/generator-tests.el2
6 files changed, 64 insertions, 45 deletions
diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index c27805b3d6e..f96cb26a5e1 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,5 +1,9 @@
12015-03-03 Daniel Colascione <dancol@dancol.org> 12015-03-03 Daniel Colascione <dancol@dancol.org>
2 2
3 * control.texi (Generators): Correct missing word. Clarify which
4 forms are legal in which parts of `unwind-protect'. Fix orphaned
5 close parenthesis.
6
3 * objects.texi (Finalizer Type): New section for finalizer objects. 7 * objects.texi (Finalizer Type): New section for finalizer objects.
4 (Type Predicates): Mention finalizers in `type-of' documentation. 8 (Type Predicates): Mention finalizers in `type-of' documentation.
5 * elisp.texi (Top): Link to finalizer type. 9 * elisp.texi (Top): Link to finalizer type.
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index bec2bc92ac4..f512ad990bd 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -661,7 +661,7 @@ indicates that the current iterator should pause and return
661@code{iter-yield-from} yields all the values that @var{iterator} 661@code{iter-yield-from} yields all the values that @var{iterator}
662produces and evaluates to the value that @var{iterator}'s generator 662produces and evaluates to the value that @var{iterator}'s generator
663function returns normally. While it has control, @var{iterator} 663function returns normally. While it has control, @var{iterator}
664receives sent to the iterator using @code{iter-next}. 664receives values sent to the iterator using @code{iter-next}.
665@end defmac 665@end defmac
666 666
667 To use a generator function, first call it normally, producing a 667 To use a generator function, first call it normally, producing a
@@ -693,9 +693,11 @@ evaluating any @code{iter-yield} form.
693@end defun 693@end defun
694 694
695@defun iter-close iterator 695@defun iter-close iterator
696If @var{iterator} is suspended inside a @code{unwind-protect} and 696If @var{iterator} is suspended inside an @code{unwind-protect}'s
697becomes unreachable, Emacs will eventually run unwind handlers after a 697@code{bodyform} and becomes unreachable, Emacs will eventually run
698garbage collection pass. To ensure that these handlers are run before 698unwind handlers after a garbage collection pass. (Note that
699@code{iter-yield} is illegal inside an @code{unwind-protect}'s
700@code{unwindforms}.) To ensure that these handlers are run before
699then, use @code{iter-close}. 701then, use @code{iter-close}.
700@end defun 702@end defun
701 703
@@ -716,8 +718,8 @@ working with iterators.
716@example 718@example
717(iter-defun my-iter (x) 719(iter-defun my-iter (x)
718 (iter-yield (1+ (iter-yield (1+ x)))) 720 (iter-yield (1+ (iter-yield (1+ x))))
719 -1 ;; Return normally 721 ;; Return normally
720 ) 722 -1)
721 723
722(let* ((iter (my-iter 5)) 724(let* ((iter (my-iter 5))
723 (iter2 (my-iter 0))) 725 (iter2 (my-iter 0)))
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e08263d4ab7..63071734cf8 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,7 +1,13 @@
12015-03-03 Daniel Colascione <dancol@dancol.org> 12015-03-03 Daniel Colascione <dancol@dancol.org>
2 2
3 * emacs-lisp/generator.el: Make globals conform to elisp 3 * emacs-lisp/generator.el: Make globals conform to elisp
4 style throughout. 4 style throughout. Use more efficient font-lock patterns.
5 (cps-inhibit-atomic-optimization): Rename from
6 `cps-disable-atomic-optimization'.
7 (cps--gensym): New macro; replaces `cl-gensym' throughout.
8 (cps-generate-evaluator): Move the `iter-yield' local macro
9 definition here
10 (iter-defun, iter-lambda): from here.
5 11
62015-03-03 Artur Malabarba <bruce.connor.am@gmail.com> 122015-03-03 Artur Malabarba <bruce.connor.am@gmail.com>
7 13
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
index d41f13e29ca..77b1fab9b09 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -86,6 +86,12 @@
86(defvar cps--cleanup-table-symbol nil) 86(defvar cps--cleanup-table-symbol nil)
87(defvar cps--cleanup-function nil) 87(defvar cps--cleanup-function nil)
88 88
89(defmacro cps--gensym (fmt &rest args)
90 ;; Change this function to use `cl-gensym' if you want the generated
91 ;; code to be easier to read and debug.
92 ;; (cl-gensym (apply #'format fmt args))
93 `(make-symbol ,fmt))
94
89(defvar cps--dynamic-wrappers '(identity) 95(defvar cps--dynamic-wrappers '(identity)
90 "List of transformer functions to apply to atomic forms we 96 "List of transformer functions to apply to atomic forms we
91evaluate in CPS context.") 97evaluate in CPS context.")
@@ -154,13 +160,13 @@ DYNAMIC-VAR bound to STATIC-VAR."
154(defun cps--add-state (kind body) 160(defun cps--add-state (kind body)
155 "Create a new CPS state with body BODY and return the state's name." 161 "Create a new CPS state with body BODY and return the state's name."
156 (declare (indent 1)) 162 (declare (indent 1))
157 (let* ((state (cl-gensym (format "cps-state-%s-" kind)))) 163 (let* ((state (cps--gensym "cps-state-%s-" kind)))
158 (push (list state body cps--cleanup-function) cps--states) 164 (push (list state body cps--cleanup-function) cps--states)
159 (push state cps--bindings) 165 (push state cps--bindings)
160 state)) 166 state))
161 167
162(defun cps--add-binding (original-name) 168(defun cps--add-binding (original-name)
163 (car (push (cl-gensym (format "cps-binding-%s-" original-name)) 169 (car (push (cps--gensym (format "cps-binding-%s-" original-name))
164 cps--bindings))) 170 cps--bindings)))
165 171
166(defun cps--find-special-form-handler (form) 172(defun cps--find-special-form-handler (form)
@@ -168,7 +174,7 @@ DYNAMIC-VAR bound to STATIC-VAR."
168 (handler (intern-soft handler-name))) 174 (handler (intern-soft handler-name)))
169 (and (fboundp handler) handler))) 175 (and (fboundp handler) handler)))
170 176
171(defvar cps-disable-atomic-optimization nil 177(defvar cps-inhibit-atomic-optimization nil
172 "When t, always rewrite forms into cps even when they 178 "When t, always rewrite forms into cps even when they
173don't yield.") 179don't yield.")
174 180
@@ -177,13 +183,14 @@ don't yield.")
177(defun cps--atomic-p (form) 183(defun cps--atomic-p (form)
178 "Return whether the given form never yields." 184 "Return whether the given form never yields."
179 185
180 (and (not cps-disable-atomic-optimization) 186 (and (not cps-inhibit-atomic-optimization)
181 (let* ((cps--yield-seen)) 187 (let* ((cps--yield-seen))
182 (ignore (macroexpand-all 188 (ignore (macroexpand-all
183 `(cl-macrolet ((cps-internal-yield 189 `(cl-macrolet ((cps-internal-yield
184 (_val) 190 (_val)
185 (setf cps--yield-seen t))) 191 (setf cps--yield-seen t)))
186 ,form))) 192 ,form)
193 macroexpand-all-environment))
187 (not cps--yield-seen)))) 194 (not cps--yield-seen))))
188 195
189(defun cps--make-atomic-state (form next-state) 196(defun cps--make-atomic-state (form next-state)
@@ -403,7 +410,7 @@ don't yield.")
403 ;; Signal the evaluator-generator that it needs to generate code 410 ;; Signal the evaluator-generator that it needs to generate code
404 ;; to handle cleanup forms. 411 ;; to handle cleanup forms.
405 (unless cps--cleanup-table-symbol 412 (unless cps--cleanup-table-symbol
406 (setf cps--cleanup-table-symbol (cl-gensym "cps-cleanup-table-"))) 413 (setf cps--cleanup-table-symbol (cps--gensym "cps-cleanup-table-")))
407 (let* ((unwind-state 414 (let* ((unwind-state
408 (cps--add-state 415 (cps--add-state
409 "unwind" 416 "unwind"
@@ -431,7 +438,7 @@ don't yield.")
431 ;; need our states to be self-referential. (That's what makes the 438 ;; need our states to be self-referential. (That's what makes the
432 ;; state a loop.) 439 ;; state a loop.)
433 (let* ((loop-state 440 (let* ((loop-state
434 (cl-gensym "cps-state-while-")) 441 (cps--gensym "cps-state-while-"))
435 (eval-loop-condition-state 442 (eval-loop-condition-state
436 (cps--transform-1 test loop-state)) 443 (cps--transform-1 test loop-state))
437 (loop-state-body 444 (loop-state-body
@@ -489,7 +496,7 @@ don't yield.")
489 (cl-loop for argument in arguments 496 (cl-loop for argument in arguments
490 collect (if (atom argument) 497 collect (if (atom argument)
491 argument 498 argument
492 (cl-gensym "cps-argument-"))))) 499 (cps--gensym "cps-argument-")))))
493 500
494 (cps--transform-1 501 (cps--transform-1
495 `(let* ,(cl-loop for argument in arguments 502 `(let* ,(cl-loop for argument in arguments
@@ -505,7 +512,7 @@ don't yield.")
505(defun cps--make-catch-wrapper (tag-binding next-state) 512(defun cps--make-catch-wrapper (tag-binding next-state)
506 (lambda (form) 513 (lambda (form)
507 (let ((normal-exit-symbol 514 (let ((normal-exit-symbol
508 (cl-gensym "cps-normal-exit-from-catch-"))) 515 (cps--gensym "cps-normal-exit-from-catch-")))
509 `(let (,normal-exit-symbol) 516 `(let (,normal-exit-symbol)
510 (prog1 517 (prog1
511 (catch ,tag-binding 518 (catch ,tag-binding
@@ -521,7 +528,7 @@ don't yield.")
521 ;; encounter the given error. 528 ;; encounter the given error.
522 529
523 (let* ((error-symbol (cps--add-binding "condition-case-error")) 530 (let* ((error-symbol (cps--add-binding "condition-case-error"))
524 (lexical-error-symbol (cl-gensym "cps-lexical-error-")) 531 (lexical-error-symbol (cps--gensym "cps-lexical-error-"))
525 (processed-handlers 532 (processed-handlers
526 (cl-loop for (condition . body) in handlers 533 (cl-loop for (condition . body) in handlers
527 collect (cons condition 534 collect (cons condition
@@ -549,13 +556,14 @@ don't yield.")
549This routine does not modify FORM. Instead, it returns a 556This routine does not modify FORM. Instead, it returns a
550modified copy." 557modified copy."
551 (macroexpand-all 558 (macroexpand-all
552 `(cl-symbol-macrolet ((,var ,new-var)) ,form))) 559 `(cl-symbol-macrolet ((,var ,new-var)) ,form)
560 macroexpand-all-environment))
553 561
554(defun cps--make-unwind-wrapper (unwind-forms) 562(defun cps--make-unwind-wrapper (unwind-forms)
555 (cl-assert lexical-binding) 563 (cl-assert lexical-binding)
556 (lambda (form) 564 (lambda (form)
557 (let ((normal-exit-symbol 565 (let ((normal-exit-symbol
558 (cl-gensym "cps-normal-exit-from-unwind-"))) 566 (cps--gensym "cps-normal-exit-from-unwind-")))
559 `(let (,normal-exit-symbol) 567 `(let (,normal-exit-symbol)
560 (unwind-protect 568 (unwind-protect
561 (prog1 569 (prog1
@@ -576,12 +584,12 @@ modified copy."
576 `(setf ,cps--state-symbol ,terminal-state 584 `(setf ,cps--state-symbol ,terminal-state
577 ,cps--value-symbol nil))) 585 ,cps--value-symbol nil)))
578 586
579(defun cps-generate-evaluator (form) 587(defun cps-generate-evaluator (body)
580 (let* (cps--states 588 (let* (cps--states
581 cps--bindings 589 cps--bindings
582 cps--cleanup-function 590 cps--cleanup-function
583 (cps--value-symbol (cl-gensym "cps-current-value-")) 591 (cps--value-symbol (cps--gensym "cps-current-value-"))
584 (cps--state-symbol (cl-gensym "cps-current-state-")) 592 (cps--state-symbol (cps--gensym "cps-current-state-"))
585 ;; We make *cps-cleanup-table-symbol** non-nil when we notice 593 ;; We make *cps-cleanup-table-symbol** non-nil when we notice
586 ;; that we have cleanup processing to perform. 594 ;; that we have cleanup processing to perform.
587 (cps--cleanup-table-symbol nil) 595 (cps--cleanup-table-symbol nil)
@@ -589,12 +597,17 @@ modified copy."
589 `(signal 'iter-end-of-sequence 597 `(signal 'iter-end-of-sequence
590 ,cps--value-symbol))) 598 ,cps--value-symbol)))
591 (initial-state (cps--transform-1 599 (initial-state (cps--transform-1
592 (macroexpand-all form) 600 (macroexpand-all
601 `(cl-macrolet
602 ((iter-yield (value)
603 `(cps-internal-yield ,value)))
604 ,@body)
605 macroexpand-all-environment)
593 terminal-state)) 606 terminal-state))
594 (finalizer-symbol 607 (finalizer-symbol
595 (when cps--cleanup-table-symbol 608 (when cps--cleanup-table-symbol
596 (when cps--cleanup-table-symbol 609 (when cps--cleanup-table-symbol
597 (cl-gensym "cps-iterator-finalizer-"))))) 610 (cps--gensym "cps-iterator-finalizer-")))))
598 `(let ,(append (list cps--state-symbol cps--value-symbol) 611 `(let ,(append (list cps--state-symbol cps--value-symbol)
599 (when cps--cleanup-table-symbol 612 (when cps--cleanup-table-symbol
600 (list cps--cleanup-table-symbol)) 613 (list cps--cleanup-table-symbol))
@@ -656,8 +669,8 @@ The values that the sub-iterator yields are passed directly to
656the caller, and values supplied to `iter-next' are sent to the 669the caller, and values supplied to `iter-next' are sent to the
657sub-iterator. `iter-yield-from' evaluates to the value that the 670sub-iterator. `iter-yield-from' evaluates to the value that the
658sub-iterator function returns via `iter-end-of-sequence'." 671sub-iterator function returns via `iter-end-of-sequence'."
659 (let ((errsym (cl-gensym "yield-from-result")) 672 (let ((errsym (cps--gensym "yield-from-result"))
660 (valsym (cl-gensym "yield-from-value"))) 673 (valsym (cps--gensym "yield-from-value")))
661 `(let ((,valsym ,value)) 674 `(let ((,valsym ,value))
662 (unwind-protect 675 (unwind-protect
663 (condition-case ,errsym 676 (condition-case ,errsym
@@ -681,9 +694,7 @@ of values. Callers can retrieve each value using `iter-next'."
681 (push (pop body) preamble)) 694 (push (pop body) preamble))
682 `(defun ,name ,arglist 695 `(defun ,name ,arglist
683 ,@(nreverse preamble) 696 ,@(nreverse preamble)
684 ,(cps-generate-evaluator 697 ,(cps-generate-evaluator body))))
685 `(cl-macrolet ((iter-yield (value) `(cps-internal-yield ,value)))
686 ,@body)))))
687 698
688(defmacro iter-lambda (arglist &rest body) 699(defmacro iter-lambda (arglist &rest body)
689 "Return a lambda generator. 700 "Return a lambda generator.
@@ -691,9 +702,7 @@ of values. Callers can retrieve each value using `iter-next'."
691 (declare (indent defun)) 702 (declare (indent defun))
692 (cl-assert lexical-binding) 703 (cl-assert lexical-binding)
693 `(lambda ,arglist 704 `(lambda ,arglist
694 ,(cps-generate-evaluator 705 ,(cps-generate-evaluator body)))
695 `(cl-macrolet ((iter-yield (value) `(cps-internal-yield ,value)))
696 ,@body))))
697 706
698(defun iter-next (iterator &optional yield-result) 707(defun iter-next (iterator &optional yield-result)
699 "Extract a value from an iterator. 708 "Extract a value from an iterator.
@@ -715,10 +724,10 @@ is blocked."
715Evaluate BODY with VAR bound to each value from ITERATOR. 724Evaluate BODY with VAR bound to each value from ITERATOR.
716Return the value with which ITERATOR finished iteration." 725Return the value with which ITERATOR finished iteration."
717 (declare (indent 1)) 726 (declare (indent 1))
718 (let ((done-symbol (cl-gensym "iter-do-iterator-done")) 727 (let ((done-symbol (cps--gensym "iter-do-iterator-done"))
719 (condition-symbol (cl-gensym "iter-do-condition")) 728 (condition-symbol (cps--gensym "iter-do-condition"))
720 (it-symbol (cl-gensym "iter-do-iterator")) 729 (it-symbol (cps--gensym "iter-do-iterator"))
721 (result-symbol (cl-gensym "iter-do-result"))) 730 (result-symbol (cps--gensym "iter-do-result")))
722 `(let (,var 731 `(let (,var
723 ,result-symbol 732 ,result-symbol
724 (,done-symbol nil) 733 (,done-symbol nil)
@@ -745,7 +754,7 @@ Return the value with which ITERATOR finished iteration."
745 754
746(defmacro cps--initialize-for (iterator) 755(defmacro cps--initialize-for (iterator)
747 ;; See cps--handle-loop-for 756 ;; See cps--handle-loop-for
748 (let ((cs (cl-gensym "cps--loop-temp"))) 757 (let ((cs (cps--gensym "cps--loop-temp")))
749 `(let ((,cs (cons nil ,iterator))) 758 `(let ((,cs (cons nil ,iterator)))
750 (cps--advance-for ,cs)))) 759 (cps--advance-for ,cs))))
751 760
@@ -781,13 +790,7 @@ Return the value with which ITERATOR finished iteration."
781 '(("(\\(iter-defun\\)\\_>\\s *\\(\\(?:\\sw\\|\\s_\\)+\\)?" 790 '(("(\\(iter-defun\\)\\_>\\s *\\(\\(?:\\sw\\|\\s_\\)+\\)?"
782 (1 font-lock-keyword-face nil t) 791 (1 font-lock-keyword-face nil t)
783 (2 font-lock-function-name-face nil t)) 792 (2 font-lock-function-name-face nil t))
784 ("(\\(iter-next\\)\\_>" 793 ("(\\(iter-\\(?:next\\|lambda\\|yield\\|yield-from\\)\\)\\_>"
785 (1 font-lock-keyword-face nil t))
786 ("(\\(iter-lambda\\)\\_>"
787 (1 font-lock-keyword-face nil t))
788 ("(\\(iter-yield\\)\\_>"
789 (1 font-lock-keyword-face nil t))
790 ("(\\(iter-yield-from\\)\\_>"
791 (1 font-lock-keyword-face nil t)))))) 794 (1 font-lock-keyword-face nil t))))))
792 795
793(provide 'generator) 796(provide 'generator)
diff --git a/test/ChangeLog b/test/ChangeLog
index ea2e0eef179..55f8c6c8eb8 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,5 +1,9 @@
12015-03-03 Daniel Colascione <dancol@dancol.org> 12015-03-03 Daniel Colascione <dancol@dancol.org>
2 2
3 * automated/generator-tests.el (cps-testcase): Use
4 `cps-inhibit-atomic-optimization' instead of
5 `cps-disable-atomic-optimization'.
6
3 * automated/finalizer-tests.el (finalizer-basic) 7 * automated/finalizer-tests.el (finalizer-basic)
4 (finalizer-circular-reference, finalizer-cross-reference) 8 (finalizer-circular-reference, finalizer-cross-reference)
5 (finalizer-error): Rename `gc-precise-p' to `gc-precise'. 9 (finalizer-error): Rename `gc-precise-p' to `gc-precise'.
diff --git a/test/automated/generator-tests.el b/test/automated/generator-tests.el
index 893c0d2e724..3ee65105597 100644
--- a/test/automated/generator-tests.el
+++ b/test/automated/generator-tests.el
@@ -54,7 +54,7 @@ identical output.
54 (funcall (lambda () ,@body)) 54 (funcall (lambda () ,@body))
55 (iter-next 55 (iter-next
56 (funcall 56 (funcall
57 (let ((cps-disable-atomic-optimization t)) 57 (let ((cps-inhibit-atomic-optimization t))
58 (iter-lambda () (iter-yield (progn ,@body))))))))))) 58 (iter-lambda () (iter-yield (progn ,@body)))))))))))
59 59
60(put 'cps-testcase 'lisp-indent-function 1) 60(put 'cps-testcase 'lisp-indent-function 1)