diff options
Diffstat (limited to 'lisp/emacs-lisp/generator.el')
| -rw-r--r-- | lisp/emacs-lisp/generator.el | 56 |
1 files changed, 30 insertions, 26 deletions
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el index 0f4149eacd5..9dba87eaeb4 100644 --- a/lisp/emacs-lisp/generator.el +++ b/lisp/emacs-lisp/generator.el @@ -123,7 +123,7 @@ to the current stack of such wrappers. WRAPPER is a function that takes a form and returns a wrapped form. Whenever we generate an atomic form (i.e., a form that can't -iter-yield), we first (before actually inserting that form in our +`iter-yield'), we first (before actually inserting that form in our generated code) pass that form through all the transformer functions. We use this facility to wrap forms that can transfer control flow non-locally in goo that diverts this control flow to @@ -170,7 +170,7 @@ DYNAMIC-VAR bound to STATIC-VAR." (and (fboundp handler) handler))) (defvar cps-inhibit-atomic-optimization nil - "When t, always rewrite forms into cps even when they + "When non-nil, always rewrite forms into cps even when they don't yield.") (defvar cps--yield-seen) @@ -213,8 +213,8 @@ don't yield.") ;; Process `and'. - (`(and) ; (and) -> t - (cps--transform-1 t next-state)) + ('(and) ; (and) -> t + (cps--transform-1 t next-state)) (`(and ,condition) ; (and CONDITION) -> CONDITION (cps--transform-1 condition next-state)) (`(and ,condition . ,rest) @@ -246,8 +246,8 @@ don't yield.") ;; Process `cond': transform into `if' or `or' depending on the ;; precise kind of the condition we're looking at. - (`(cond) ; (cond) -> nil - (cps--transform-1 nil next-state)) + ('(cond) ; (cond) -> nil + (cps--transform-1 nil next-state)) (`(cond (,condition) . ,rest) (cps--transform-1 `(or ,condition (cond ,@rest)) next-state)) @@ -281,14 +281,14 @@ don't yield.") ;; Process `progn' and `inline': they are identical except for the ;; name, which has some significance to the byte compiler. - (`(inline) (cps--transform-1 nil next-state)) + ('(inline) (cps--transform-1 nil next-state)) (`(inline ,form) (cps--transform-1 form next-state)) (`(inline ,form . ,rest) (cps--transform-1 form (cps--transform-1 `(inline ,@rest) next-state))) - (`(progn) (cps--transform-1 nil next-state)) + ('(progn) (cps--transform-1 nil next-state)) (`(progn ,form) (cps--transform-1 form next-state)) (`(progn ,form . ,rest) (cps--transform-1 form @@ -345,7 +345,7 @@ don't yield.") ;; Process `or'. - (`(or) (cps--transform-1 nil next-state)) + ('(or) (cps--transform-1 nil next-state)) (`(or ,condition) (cps--transform-1 condition next-state)) (`(or ,condition . ,rest) (cps--transform-1 @@ -374,13 +374,6 @@ don't yield.") `(setf ,cps--value-symbol ,temp-var-symbol ,cps--state-symbol ,next-state)))))))) - ;; Process `prog2'. - - (`(prog2 ,form1 ,form2 . ,body) - (cps--transform-1 - `(progn ,form1 (prog1 ,form2 ,@body)) - next-state)) - ;; Process `unwind-protect': If we're inside an unwind-protect, we ;; have a block of code UNWINDFORMS which we would like to run ;; whenever control flows away from the main piece of code, @@ -548,7 +541,7 @@ don't yield.") (defun cps--replace-variable-references (var new-var form) "Replace all non-shadowed references to VAR with NEW-VAR in FORM. -This routine does not modify FORM. Instead, it returns a +This routine does not modify FORM. Instead, it returns a modified copy." (macroexpand-all `(cl-symbol-macrolet ((,var ,new-var)) ,form) @@ -567,8 +560,11 @@ modified copy." (unless ,normal-exit-symbol ,@unwind-forms)))))) -(put 'iter-end-of-sequence 'error-conditions '(iter-end-of-sequence)) -(put 'iter-end-of-sequence 'error-message "iteration terminated") +(define-error 'iter-end-of-sequence "Iteration terminated" + ;; FIXME: This was not defined originally as an `error' condition, so + ;; we reproduce this by passing itself as the parent, which avoids the + ;; default `error' parent. Maybe it *should* be in the `error' category? + 'iter-end-of-sequence) (defun cps--make-close-iterator-form (terminal-state) (if cps--cleanup-table-symbol @@ -643,11 +639,11 @@ modified copy." ,(cps--make-close-iterator-form terminal-state))))) (t (error "unknown iterator operation %S" op)))))) ,(when finalizer-symbol - `(funcall iterator - :stash-finalizer - (make-finalizer - (lambda () - (iter-close iterator))))) + '(funcall iterator + :stash-finalizer + (make-finalizer + (lambda () + (iter-close iterator))))) iterator)))) (defun iter-yield (value) @@ -700,6 +696,14 @@ of values. Callers can retrieve each value using `iter-next'." `(lambda ,arglist ,(cps-generate-evaluator body))) +(defmacro iter-make (&rest body) + "Return a new iterator." + (declare (debug t)) + (cps-generate-evaluator body)) + +(defconst iter-empty (lambda (_op _val) (signal 'iter-end-of-sequence nil)) + "Trivial iterator that always signals the end of sequence.") + (defun iter-next (iterator &optional yield-result) "Extract a value from an iterator. YIELD-RESULT becomes the return value of `iter-yield' in the @@ -711,7 +715,7 @@ iterator cannot supply more values." (defun iter-close (iterator) "Terminate an iterator early. -Run any unwind-protect handlers in scope at the point ITERATOR +Run any unwind-protect handlers in scope at the point ITERATOR is blocked." (funcall iterator :close nil)) @@ -756,7 +760,7 @@ Return the value with which ITERATOR finished iteration." (cps--advance-for ,cs)))) (defun cps--handle-loop-for (var) - "Support `iter-by' in `loop'. " + "Support `iter-by' in `loop'." ;; N.B. While the cl-loop-for-handler is a documented interface, ;; there's no documented way for cl-loop-for-handler callbacks to do ;; anything useful! Additionally, cl-loop currently lexbinds useful |